mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 01:19:29 +02:00
removed fpc 2.0.0 compatibility workarounds
git-svn-id: trunk@8761 -
This commit is contained in:
parent
ed75b8050b
commit
323b83d861
@ -22,7 +22,7 @@
|
||||
unit FPCAdds;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$if defined(VER2_0_0) or defined(VER2_0_1) or defined(VER2_0_2)}
|
||||
{$IFDEF VER2_0_2}
|
||||
{$DEFINE FPC_HAS_NO_STRTOQWORD}
|
||||
{$ENDIF}
|
||||
|
||||
@ -43,13 +43,6 @@ type
|
||||
PHandle = ^THandle;
|
||||
|
||||
function StrToWord(const s: string): word;
|
||||
|
||||
{$IFDEF VER2_0_0}
|
||||
// These functions were introduced after fpc 2.0.0
|
||||
function ExceptFrameCount: Longint;
|
||||
function ExceptFrames: PPointer;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF FPC_HAS_NO_STRTOQWORD}
|
||||
function StrToQWord(const s: string): QWord;
|
||||
{$ENDIF}
|
||||
@ -68,66 +61,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF VER2_0_0}
|
||||
function ExceptFrameCount: Longint;
|
||||
begin
|
||||
If RaiseList=Nil then
|
||||
Result:=0
|
||||
else
|
||||
Result:=RaiseList^.Framecount;
|
||||
end;
|
||||
|
||||
function ExceptFrames: PPointer;
|
||||
begin
|
||||
If RaiseList=Nil then
|
||||
Result:=Nil
|
||||
else
|
||||
Result:=RaiseList^.Frames;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
// fpc 2.0.0 widestringmanager is incomplete for win32
|
||||
{$IFDEF VER2_0_0}{$IFDEF win32}
|
||||
//copied from rtl/win32/system.pp
|
||||
type
|
||||
UINT=cardinal;
|
||||
const
|
||||
{ MultiByteToWideChar }
|
||||
MB_PRECOMPOSED = 1;
|
||||
CP_ACP = 0;
|
||||
|
||||
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
|
||||
stdcall; external 'kernel32' name 'MultiByteToWideChar';
|
||||
function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint;
|
||||
stdcall; external 'kernel32' name 'WideCharToMultiByte';
|
||||
|
||||
procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
|
||||
var
|
||||
destlen: SizeInt;
|
||||
begin
|
||||
// retrieve length including trailing #0
|
||||
destlen:=WideCharToMultiByte(CP_ACP, 0, source, len+1, nil, 0, nil, nil);
|
||||
setlength(dest, destlen-1);
|
||||
WideCharToMultiByte(CP_ACP, 0, source, len+1, @dest[1], destlen, nil, nil);
|
||||
end;
|
||||
|
||||
procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
|
||||
var
|
||||
destlen: SizeInt;
|
||||
begin
|
||||
// retrieve length including trailing #0
|
||||
destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len+1, nil, 0);
|
||||
setlength(dest, destlen-1);
|
||||
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len+1, @dest[1], destlen);
|
||||
end;
|
||||
|
||||
procedure InitWin32Widestrings;
|
||||
begin
|
||||
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
|
||||
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
|
||||
end;
|
||||
{$ENDIF}{$ENDIF}
|
||||
|
||||
{$IFDEF FPC_HAS_NO_STRTOQWORD}
|
||||
function StrToQWord(const s: string): QWord;
|
||||
var Error: word;
|
||||
@ -137,10 +70,5 @@ begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER2_0_0}{$IFDEF win32}
|
||||
initialization
|
||||
InitWin32Widestrings;
|
||||
{$ENDIF}{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
|
@ -6087,17 +6087,10 @@ begin
|
||||
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
|
||||
gdk_gc_set_line_attributes(GC,GDIPenWidth,GDK_LINE_ON_OFF_DASH,GDK_CAP_NOT_LAST,GDK_JOIN_MITER);
|
||||
case GDIPenStyle of
|
||||
{$If defined(GTK2) and defined(VER2_0_0)}
|
||||
PS_DASH: SetDashes([#4,#4]);
|
||||
PS_DOT: SetDashes([#2,#2]);
|
||||
PS_DASHDOT: SetDashes([#4,#2,#2,#2]);
|
||||
PS_DASHDOTDOT: SetDashes([#4,#2,#2,#2,#2,#2]);
|
||||
{$Else}
|
||||
PS_DASH: SetDashes([4,4]);
|
||||
PS_DOT: SetDashes([2,2]);
|
||||
PS_DASHDOT: SetDashes([4,2,2,2]);
|
||||
PS_DASHDOTDOT: SetDashes([4,2,2,2,2,2]);
|
||||
{$EndIf}
|
||||
//This is DEADLY!!!
|
||||
//PS_NULL: gdk_gc_set_dashes(GC, 0, [0,4], 2);
|
||||
end;
|
||||
|
@ -2107,7 +2107,7 @@ var
|
||||
CharLen: integer;
|
||||
|
||||
// Copies from SourceStart to Source to Dest and updates Dest
|
||||
procedure CopyPart; {$IFNDEF VER2_0_0}inline;{$ENDIF}
|
||||
procedure CopyPart; inline;
|
||||
var
|
||||
CopyLength: SizeInt;
|
||||
begin
|
||||
|
@ -488,7 +488,6 @@ type
|
||||
property Canvas: TCanvas read FCanvas;
|
||||
property ClickOnSelChange: boolean read FClickOnSelChange
|
||||
write FClickOnSelChange default true; // true is Delphi behaviour
|
||||
property Color;
|
||||
property Constraints;
|
||||
property ExtendedSelect: boolean read FExtendedSelect write SetExtendedSelect default true;
|
||||
property Font;
|
||||
|
@ -88,60 +88,8 @@ type
|
||||
procedure TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
|
||||
Lang, FallbackLang: string);
|
||||
|
||||
// GetLanguageIDs is part of the fcl in 2.0.1 and later
|
||||
{$ifdef ver2_0_0}
|
||||
procedure GetLanguageIDs(var Lang, FallbackLang: string);
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
// GetLanguageIDs is part of the fcl in 2.0.1 and later
|
||||
{$ifdef ver2_0_0}
|
||||
{$ifdef WINDOWS}
|
||||
uses
|
||||
windows;
|
||||
procedure GetLanguageIDs(var Lang, FallbackLang: string);
|
||||
var
|
||||
Buffer: array[1..4] of char;
|
||||
Country: string;
|
||||
UserLCID: LCID;
|
||||
begin
|
||||
//defaults
|
||||
Lang := '';
|
||||
FallbackLang:='';
|
||||
UserLCID := GetUserDefaultLCID;
|
||||
if GetLocaleInfo(UserLCID, LOCALE_SABBREVLANGNAME, @Buffer, 4)<>0 then
|
||||
FallbackLang := lowercase(copy(Buffer,1,2));
|
||||
if GetLocaleInfo(UserLCID, LOCALE_SABBREVCTRYNAME, @Buffer, 4)<>0 then begin
|
||||
Country := copy(Buffer,1,2);
|
||||
|
||||
// some 2 letter codes are not the first two letters of the 3 letter code
|
||||
// there are probably more, but first let us see if there are translations
|
||||
if (Buffer='PRT') then Country:='PT';
|
||||
|
||||
Lang := FallbackLang+'_'+Country;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
procedure GetLanguageIDs(var Lang, FallbackLang: string);
|
||||
begin
|
||||
lang := GetEnvironmentVariable('LC_ALL');
|
||||
if Length(lang) = 0 then
|
||||
begin
|
||||
lang := GetEnvironmentVariable('LC_MESSAGES');
|
||||
if Length(lang) = 0 then
|
||||
begin
|
||||
lang := GetEnvironmentVariable('LANG');
|
||||
if Length(lang) = 0 then
|
||||
exit; // no language defined via environment variables
|
||||
end;
|
||||
end;
|
||||
FallbackLang := Copy(lang, 1, 2);
|
||||
end;
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
function UTF8ToSystemCharSet(const s: string): string; inline;
|
||||
begin
|
||||
|
Loading…
Reference in New Issue
Block a user