removed fpc 2.0.0 compatibility workarounds

git-svn-id: trunk@8761 -
This commit is contained in:
vincents 2006-02-17 15:19:01 +00:00
parent ed75b8050b
commit 323b83d861
5 changed files with 2 additions and 134 deletions

View File

@ -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.

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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