diff options
Diffstat (limited to '')
8 files changed, 280 insertions, 49 deletions
diff --git a/unicode/src/lib/TntUnicodeControls/TntClasses.pas b/unicode/src/lib/TntUnicodeControls/TntClasses.pas index 5b455c3b..be043421 100644 --- a/unicode/src/lib/TntUnicodeControls/TntClasses.pas +++ b/unicode/src/lib/TntUnicodeControls/TntClasses.pas @@ -11,6 +11,10 @@ unit TntClasses; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface @@ -502,7 +506,11 @@ var begin Temp := WideChar(GetOrdProp(FInstance, FPropInfo)); + {$IFNDEF FPC} TAccessWriter(Writer).WriteValue(vaWString); + {$ELSE} + TAccessWriter(Writer).Write(vaWString, SizeOf(vaWString)); + {$ENDIF} L := Length(Temp); Writer.Write(L, SizeOf(Integer)); Writer.Write(Pointer(@Temp[1])^, L * 2); @@ -592,10 +600,17 @@ end; { TTntFileStream } +{$IFDEF FPC} + {$DEFINE HAS_SFCREATEERROREX} +{$ENDIF} +{$IFDEF DELPHI_7_UP} + {$DEFINE HAS_SFCREATEERROREX} +{$ENDIF} + constructor TTntFileStream.Create(const FileName: WideString; Mode: Word); var CreateHandle: Integer; - {$IFDEF DELPHI_7_UP} + {$IFDEF HAS_SFCREATEERROREX} ErrorMessage: WideString; {$ENDIF} begin @@ -603,7 +618,7 @@ begin begin CreateHandle := WideFileCreate(FileName); if CreateHandle < 0 then begin - {$IFDEF DELPHI_7_UP} + {$IFDEF HAS_SFCREATEERROREX} ErrorMessage := WideSysErrorMessage(GetLastError); raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]); {$ELSE} @@ -614,7 +629,7 @@ begin begin CreateHandle := WideFileOpen(FileName, Mode); if CreateHandle < 0 then begin - {$IFDEF DELPHI_7_UP} + {$IFDEF HAS_SFCREATEERROREX} ErrorMessage := WideSysErrorMessage(GetLastError); raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]); {$ELSE} @@ -752,11 +767,15 @@ end; procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal); var Stream: TStream; + Utf8BomPtr: PAnsiChar; begin Stream := TTntFileStream.Create(FileName, fmCreate); try if (CodePage = CP_UTF8) then - Stream.WriteBuffer(PAnsiChar(UTF8_BOM)^, Length(UTF8_BOM)); + begin + Utf8BomPtr := PAnsiChar(UTF8_BOM); + Stream.WriteBuffer(Utf8BomPtr^, Length(UTF8_BOM)); + end; SaveToStreamEx(Stream, CodePage); finally Stream.Free; @@ -1721,9 +1740,9 @@ end; function CompareComponentHelperToTarget(Item, Target: Pointer): Integer; begin - if Integer(TWideComponentHelper(Item).FComponent) < Integer(Target) then + if PtrUInt(TWideComponentHelper(Item).FComponent) < PtrUInt(Target) then Result := -1 - else if Integer(TWideComponentHelper(Item).FComponent) > Integer(Target) then + else if PtrUInt(TWideComponentHelper(Item).FComponent) > PtrUInt(Target) then Result := 1 else Result := 0; diff --git a/unicode/src/lib/TntUnicodeControls/TntCompilers.inc b/unicode/src/lib/TntUnicodeControls/TntCompilers.inc index 39eb95e9..06f4d9ab 100644 --- a/unicode/src/lib/TntUnicodeControls/TntCompilers.inc +++ b/unicode/src/lib/TntUnicodeControls/TntCompilers.inc @@ -147,6 +147,10 @@ {$define DELPHI_1} {$endif} + {$ifdef FPC} + {.$define DELPHI} + {$endif} + {$ifdef DELPHI_2} {$define DELPHI_2_UP} {$endif} @@ -350,7 +354,25 @@ {$ENDIF} {$IFDEF COMPILER_7_UP} +{$IFDEF FPC} + {$DEFINE UNSAFE_WARNINGS_OFF} +{$ENDIF} +{$ENDIF} + +{$IFDEF UNSAFE_WARNINGS_OFF} {$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! } {$WARN UNSAFE_TYPE OFF} {$WARN UNSAFE_CAST OFF} -{$ENDIF}
\ No newline at end of file +{$ENDIF} + +{$IFDEF FPC} +{$HINTS OFF} +{$ENDIF} + +{$IFNDEF FPC} + // Delphi system function overrides might (not tested) cause problems on + // CPUs with code protection (NX-bit). So disable by default. + {.$DEFINE USE_SYSTEM_OVERRIDES} +{$ENDIF} + + diff --git a/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas b/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas index 2b409e4e..c6b65082 100644 --- a/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas +++ b/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas @@ -11,6 +11,10 @@ unit TntFormatStrUtils; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface @@ -21,11 +25,14 @@ uses TntSysUtils; function GetCanonicalFormatStr(const _FormatString: WideString): WideString; + +{$IFNDEF FPC} {$IFNDEF COMPILER_9_UP} function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString; const Args: array of const {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString; {$ENDIF} +{$ENDIF} procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString); function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean; @@ -268,6 +275,7 @@ begin end; end; +{$IFNDEF FPC} {$IFNDEF COMPILER_9_UP} function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString; const Args: array of const @@ -318,6 +326,7 @@ begin end; end; {$ENDIF} +{$ENDIF} procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings); var @@ -376,6 +385,15 @@ begin end; end; +function FormatSpecToObject(SpecType: TFormatSpecifierType): TObject; +begin + {$IFNDEF FPC} + Result := TObject(SpecType); + {$ELSE} + Result := Pointer(SpecType); + {$ENDIF} +end; + procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings); var i: integer; @@ -406,13 +424,13 @@ begin if TypeList[RunningIndex] <> '' then begin // already exists in list, check for compatibility - if TypeList.Objects[RunningIndex] <> TObject(SpecType) then + if TypeList.Objects[RunningIndex] <> FormatSpecToObject(SpecType) then raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes, [RunningIndex, TypeList[RunningIndex], f]); end else begin // not in list so update it TypeList[RunningIndex] := f; - TypeList.Objects[RunningIndex] := TObject(SpecType); + TypeList.Objects[RunningIndex] := FormatSpecToObject(SpecType); end; end; end; diff --git a/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas b/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas index 317f0f12..17084f35 100644 --- a/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas +++ b/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas @@ -11,6 +11,10 @@ unit TntSysUtils; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface @@ -19,7 +23,7 @@ interface { TODO: Consider: string functions from StrUtils. } uses - Types, SysUtils, Windows; + Types, SysUtils, Windows, TntWindows; //--------------------------------------------------------------------------------------------- // Tnt - Types @@ -34,6 +38,12 @@ type // Like Assert(). An error occured that should never have happened, send me a bug report now! ETntInternalError = class(Exception); +{$IFNDEF FPC} +type + PtrInt = LongInt; + PtrUInt = LongWord; +{$ENDIF} + //--------------------------------------------------------------------------------------------- // Tnt - SysUtils //--------------------------------------------------------------------------------------------- @@ -106,6 +116,7 @@ type // ........ string functions ......... +{$IFNDEF FPC} {$IFNDEF COMPILER_9_UP} // // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat @@ -148,6 +159,7 @@ type {$ENDIF} {$ENDIF} +{$ENDIF} {TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9. function Tnt_WideUpperCase(const S: WideString): WideString; @@ -241,7 +253,7 @@ function WideRenameFile(const OldName, NewName: WideString): Boolean; {TNT-WARN DeleteFile} function WideDeleteFile(const FileName: WideString): Boolean; {TNT-WARN CopyFile} -function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean; +function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean; {TNT-WARN TFileName} @@ -333,9 +345,11 @@ var Win32PlatformIs2003: Boolean; Win32PlatformIsVista: Boolean; +{$IFNDEF FPC} {$IFNDEF COMPILER_7_UP} function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean; {$ENDIF} +{$ENDIF} function WinCheckH(RetVal: Cardinal): Cardinal; function WinCheckFileH(RetVal: Cardinal): Cardinal; function WinCheckP(RetVal: Pointer): Pointer; @@ -343,7 +357,9 @@ function WinCheckP(RetVal: Pointer): Pointer; function WideGetModuleFileName(Instance: HModule): WideString; function WideSafeLoadLibrary(const Filename: Widestring; ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE; +{$IFNDEF FPC} function WideLoadPackage(const Name: Widestring): HMODULE; +{$ENDIF} function IsWideCharUpper(WC: WideChar): Boolean; function IsWideCharLower(WC: WideChar): Boolean; @@ -385,12 +401,13 @@ implementation uses ActiveX, ComObj, SysConst, {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils, - TntSystem, TntWindows, TntFormatStrUtils; + TntSystem;//, TntFormatStrUtils; //--------------------------------------------------------------------------------------------- // Tnt - SysUtils //--------------------------------------------------------------------------------------------- +{$IFNDEF FPC} {$IFNDEF COMPILER_9_UP} function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr; @@ -492,10 +509,16 @@ uses {$ENDIF} {$ENDIF} +{$ENDIF FPC} function Tnt_WideUpperCase(const S: WideString): WideString; begin + {$IFNDEF FPC} {$IFNDEF COMPILER_10_UP} + {$DEFINE WIDEUPPERCASE_BROKEN} + {$ENDIF} + {$ENDIF} + {$IFDEF WIDEUPPERCASE_BROKEN} { SysUtils.WideUpperCase is broken for Win9x. } Result := S; if Length(Result) > 0 then @@ -507,7 +530,12 @@ end; function Tnt_WideLowerCase(const S: WideString): WideString; begin + {$IFNDEF FPC} {$IFNDEF COMPILER_10_UP} + {$DEFINE WIDELOWERCASE_BROKEN} + {$ENDIF} + {$ENDIF} + {$IFDEF WIDELOWERCASE_BROKEN} { SysUtils.WideLowerCase is broken for Win9x. } Result := S; if Length(Result) > 0 then @@ -1064,7 +1092,8 @@ function WideForceDirectories(Dir: WideString): Boolean; begin Result := True; if Length(Dir) = 0 then - raise ETntGeneralError.Create(SCannotCreateDir); + raise ETntGeneralError.Create( + {$IFNDEF FPC} SCannotCreateDir {$ELSE} SCannotCreateEmptyDir {$ENDIF}); Dir := WideExcludeTrailingBackslash(Dir); if (Length(Dir) < 3) or WideDirectoryExists(Dir) or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem. @@ -1108,7 +1137,7 @@ begin Result := Tnt_DeleteFileW(PWideChar(FileName)) end; -function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean; +function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean; begin Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists) end; @@ -1190,9 +1219,17 @@ end; //== DATE/TIME STRING PARSING ================================================================ //============================================================================================= +{$IFDEF FPC} +const + VAR_TIMEVALUEONLY = 1; + VAR_DATEVALUEONLY = 2; +{$ENDIF} + function _IntTryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): HResult; begin - Result := VarDateFromStr(Str, GetThreadLocale, Flags, Double(DateTime)); + Result := VarDateFromStr( + {$IFDEF FPC} POLECHAR(Str) {$ELSE} Str {$ENDIF}, + GetThreadLocale, Flags, Double(DateTime)); if (not Succeeded(Result)) then begin if (Flags = VAR_TIMEVALUEONLY) and SysUtils.TryStrToTime{TNT-ALLOW TryStrToTime}(Str, DateTime) then @@ -1279,12 +1316,14 @@ end; function TntStrToDate(Str: WideString): TDateTime; begin - Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY, SInvalidDate); + Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY, + {$IFNDEF FPC} SInvalidDate {$ELSE} SInvalidDateTime {$ENDIF}); end; function TntStrToTime(Str: WideString): TDateTime; begin - Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY, SInvalidTime); + Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY, + {$IFNDEF FPC} SInvalidTime {$ELSE} SInvalidDateTime {$ENDIF}); end; //============================================================================================= @@ -1312,7 +1351,9 @@ end; function TntStrToCurr(const S: WideString): Currency; begin try - OleCheck(VarCyFromStr(S, GetThreadLocale, 0, Result)); + OleCheck(VarCyFromStr( + {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF}, + GetThreadLocale, 0, Result)); except on E: Exception do begin E.Message := E.Message + CRLF + WideFormat(SInvalidCurrency, [S]); @@ -1325,12 +1366,16 @@ function ValidCurrencyStr(const S: WideString): Boolean; var Dummy: Currency; begin - Result := Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Dummy)); + Result := Succeeded(VarCyFromStr( + {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF}, + GetThreadLocale, 0, Dummy)); end; function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency; begin - if not Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Result)) then + if not Succeeded(VarCyFromStr( + {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF}, + GetThreadLocale, 0, Result)) then Result := Default; end; @@ -1346,17 +1391,31 @@ begin Result.LeadingZero := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ILZERO, '1'), 1); Result.Grouping := StrToIntDef(Copy(WideGetLocaleStr(GetThreadLocale, LOCALE_SMONGROUPING, '3;0'), 1, 1), 3); Currency_DecimalSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONDECIMALSEP, '.'); - Result.lpDecimalSep := PWideChar(Currency_DecimalSep); + Result.lpDecimalSep := {$IFNDEF FPC} PWideChar(Currency_DecimalSep) + {$ELSE} LPTSTR(PWideChar(Currency_DecimalSep)) {$ENDIF}; Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ','); - Result.lpThousandSep := PWideChar(Currency_ThousandSep); + Result.lpThousandSep := {$IFNDEF FPC} PWideChar(Currency_ThousandSep) + {$ELSE} LPTSTR(PWideChar(Currency_ThousandSep)) {$ENDIF}; Result.NegativeOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_INEGCURR, '0'), 0); Result.PositiveOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRENCY, '0'), 0); Currency_CurrencySymbol := WideGetLocaleStr(GetThreadLocale, LOCALE_SCURRENCY, ''); - Result.lpCurrencySymbol := PWideChar(Currency_CurrencySymbol); + Result.lpCurrencySymbol := {$IFNDEF FPC} PWideChar(Currency_CurrencySymbol) + {$ELSE} LPTSTR(PWideChar(Currency_CurrencySymbol)) {$ENDIF}; end; //============================================================================================= +{$IFDEF FPC} +function GetLocaleStr(Locale, LocaleType: Integer; const Default: string): string; +var + L: Integer; + Buffer: array[0..255] of Char; +begin + L := GetLocaleInfo(Locale, LocaleType, Buffer, SizeOf(Buffer)); + if L > 0 then SetString(Result, Buffer, L - 1) else Result := Default; +end; +{$ENDIF} + function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString; var L: Integer; @@ -1458,6 +1517,7 @@ begin end; end; +{$IFNDEF FPC} function WideLoadPackage(const Name: Widestring): HMODULE; begin Result := WideSafeLoadLibrary(Name); @@ -1472,6 +1532,7 @@ begin raise; end; end; +{$ENDIF} function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word; begin diff --git a/unicode/src/lib/TntUnicodeControls/TntSystem.pas b/unicode/src/lib/TntUnicodeControls/TntSystem.pas index 60ea9232..e613ce0c 100644 --- a/unicode/src/lib/TntUnicodeControls/TntSystem.pas +++ b/unicode/src/lib/TntUnicodeControls/TntSystem.pas @@ -11,6 +11,10 @@ unit TntSystem; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} {*****************************************************************************} @@ -38,8 +42,10 @@ uses {TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage function DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString. +{$IFNDEF FPC} var WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean; +{$ENDIF} {TNT-WARN LoadResString} function WideLoadResString(ResStringRec: PResStringRec): WideString; @@ -76,6 +82,8 @@ function KeyUnicode(CharCode: Word): WideChar; procedure StrSwapByteOrder(Str: PWideChar); +{$IFDEF USE_SYSTEM_OVERRIDES} + type TTntSystemUpdate = (tsWideResourceStrings @@ -88,6 +96,8 @@ const procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates); +{$ENDIF USE_SYSTEM_OVERRIDES} + implementation uses @@ -101,15 +111,33 @@ begin Result := GDefaultSystemCodePage; end; +{$IFDEF USE_SYSTEM_OVERRIDES} var IsDebugging: Boolean; +{$ENDIF USE_SYSTEM_OVERRIDES} + +function WideLoadResStringDetect(ResStringRec: PResStringRec): WideString; +var + PCustom: PAnsiChar; +begin + // custom string pointer + PCustom := PAnsiChar(ResStringRec); { I would like to use PWideChar, but this would break legacy code. } + if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM))) + and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then + // detected UTF8 + Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM))) + else + // normal + Result := PCustom; +end; + +{$IFNDEF FPC} function WideLoadResString(ResStringRec: PResStringRec): WideString; const MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. } var Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. } - PCustom: PAnsiChar; begin if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then exit; { a custom resourcestring has been loaded. } @@ -121,18 +149,19 @@ begin Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^), ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE)) else begin - // custom string pointer - PCustom := PAnsiChar(ResStringRec.Identifier); { I would like to use PWideChar, but this would break legacy code. } - if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM))) - and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then - // detected UTF8 - Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM))) - else - // normal - Result := PCustom; + Result := WideLoadResStringDetect(ResStringRec); end; end; +{$ELSE} + +function WideLoadResString(ResStringRec: PResStringRec): WideString; +begin + Result := WideLoadResStringDetect(ResStringRec); +end; + +{$ENDIF} + function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar; var i, Len: Integer; @@ -806,6 +835,8 @@ begin end; end; +{$IFDEF USE_SYSTEM_OVERRIDES} + //-------------------------------------------------------------------- // LoadResString() // @@ -1359,8 +1390,16 @@ begin {$ENDIF} end; +{$ENDIF USE_SYSTEM_OVERRIDES} + initialization {$IFDEF COMPILER_9_UP} + {$DEFINE USE_GETACP} + {$ENDIF} + {$IFDEF FPC} + {$DEFINE USE_GETACP} + {$ENDIF} + {$IFDEF USE_GETACP} GDefaultSystemCodePage := GetACP; {$ELSE} {$IFDEF COMPILER_7_UP} @@ -1372,13 +1411,17 @@ initialization GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP}; {$ENDIF} {$ENDIF} + {$IFDEF USE_SYSTEM_OVERRIDES} {$IFNDEF COMPILER_9_UP} StartupDefaultUserCodePage := DefaultSystemCodePage; {$ENDIF} IsDebugging := DebugHook > 0; + {$ENDIF USE_SYSTEM_OVERRIDES} finalization + {$IFDEF USE_SYSTEM_OVERRIDES} UninstallSystemOverrides; FreeTntSystemThreadVars; { Make MemorySleuth happy. } + {$ENDIF USE_SYSTEM_OVERRIDES} end. diff --git a/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas b/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas index ede13f30..99f63aea 100644 --- a/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas +++ b/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas @@ -11,6 +11,10 @@ unit TntWideStrUtils; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface diff --git a/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas b/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas index ea5b7b0a..75132d22 100644 --- a/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas +++ b/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas @@ -11,6 +11,10 @@ unit TntWideStrings; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface @@ -54,6 +58,17 @@ type property Current: WideString read GetCurrent; end; +{$IFDEF FPC} + TStringsDefined = set of ( + sdDelimiter, sdQuoteChar, sdNameValueSeparator, sdLineBreak, + sdStrictDelimiter); +{$ENDIF} + +{$DEFINE NAMEVALUESEPARATOR_RW} +{$IFNDEF COMPILER_7_UP} + {$UNDEF NAMEVALUESEPARATOR_RW} +{$ENDIF} + { TWideStrings class } TWideStrings = class(TPersistent) @@ -61,7 +76,7 @@ type FDefined: TStringsDefined; FDelimiter: WideChar; FQuoteChar: WideChar; - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} FNameValueSeparator: WideChar; {$ENDIF} FUpdateCount: Integer; @@ -81,7 +96,7 @@ type function GetQuoteChar: WideChar; procedure SetQuoteChar(const Value: WideChar); function GetNameValueSeparator: WideChar; - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} procedure SetNameValueSeparator(const Value: WideChar); {$ENDIF} function GetValueFromIndex(Index: Integer): WideString; @@ -142,7 +157,7 @@ type property QuoteChar: WideChar read GetQuoteChar write SetQuoteChar; property Values[const Name: WideString]: WideString read GetValue write SetValue; property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex; - property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF COMPILER_7_UP} write SetNameValueSeparator {$ENDIF}; + property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF NAMEVALUESEPARATOR_RW} write SetNameValueSeparator {$ENDIF}; property Strings[Index: Integer]: WideString read Get write Put; default; property Text: WideString read GetTextStr write SetTextStr; property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter; @@ -243,7 +258,7 @@ begin try Clear; FDefined := TWideStrings(Source).FDefined; - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} FNameValueSeparator := TWideStrings(Source).FNameValueSeparator; {$ENDIF} FQuoteChar := TWideStrings(Source).FQuoteChar; @@ -258,7 +273,7 @@ begin BeginUpdate; try Clear; - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} FNameValueSeparator := WideChar(TStrings{TNT-ALLOW TStrings}(Source).NameValueSeparator); {$ENDIF} FQuoteChar := WideChar(TStrings{TNT-ALLOW TStrings}(Source).QuoteChar); @@ -282,7 +297,7 @@ begin TStrings{TNT-ALLOW TStrings}(Dest).BeginUpdate; try TStrings{TNT-ALLOW TStrings}(Dest).Clear; - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} TStrings{TNT-ALLOW TStrings}(Dest).NameValueSeparator := AnsiChar(NameValueSeparator); {$ENDIF} TStrings{TNT-ALLOW TStrings}(Dest).QuoteChar := AnsiChar(QuoteChar); @@ -790,7 +805,7 @@ end; function TWideStrings.GetNameValueSeparator: WideChar; begin - {$IFDEF COMPILER_7_UP} + {$IFDEF NAMEVALUESEPARATOR_RW} if not (sdNameValueSeparator in FDefined) then NameValueSeparator := '='; Result := FNameValueSeparator; @@ -799,7 +814,7 @@ begin {$ENDIF} end; -{$IFDEF COMPILER_7_UP} +{$IFDEF NAMEVALUESEPARATOR_RW} procedure TWideStrings.SetNameValueSeparator(const Value: WideChar); begin if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then diff --git a/unicode/src/lib/TntUnicodeControls/TntWindows.pas b/unicode/src/lib/TntUnicodeControls/TntWindows.pas index 3ae9133a..8fd7ec88 100644 --- a/unicode/src/lib/TntUnicodeControls/TntWindows.pas +++ b/unicode/src/lib/TntUnicodeControls/TntWindows.pas @@ -11,6 +11,10 @@ unit TntWindows; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$INCLUDE TntCompilers.inc} interface @@ -107,6 +111,10 @@ const //------------------------------------------------------------------------------------------ {$IFNDEF COMPILER_9_UP} type + {$IFDEF FPC} + TStartupInfoA = STARTUPINFO; + TStartupInfoW = STARTUPINFO; + {$ELSE} TStartupInfoA = _STARTUPINFOA; TStartupInfoW = record cb: DWORD; @@ -128,6 +136,7 @@ type hStdOutput: THandle; hStdError: THandle; end; + {$ENDIF} function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; lpCommandLine: PWideChar; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; @@ -136,6 +145,15 @@ function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; var lpProcessInformation: TProcessInformation): BOOL; stdcall; external kernel32 name 'CreateProcessW'; {$ENDIF} + +{$IFDEF FPC} +type + TCurrencyFmtA = CURRENCYFMT; + TCurrencyFmtW = CURRENCYFMT; + PCurrencyFmtA = ^TCurrencyFmtA; + PCurrencyFmtW = ^TCurrencyFmtW; +{$ENDIF} + //------------------------------------------------------------------------------------------ {TNT-WARN SetWindowText} @@ -342,6 +360,12 @@ function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD; {TNT-WARN LoadStringW} function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer; +{$IFDEF FPC} +type + TMenuItemInfoW = TMENUITEMINFO; + tagMenuItemINFOW = tagMENUITEMINFO; +{$ENDIF} + {TNT-WARN InsertMenuItem} {TNT-WARN InsertMenuItemA} {TNT-WARN InsertMenuItemW} @@ -395,6 +419,24 @@ function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar; var lplpBuffer: Pointer; var puLen: UINT): BOOL; type +{$IFDEF FPC} + PSHNAMEMAPPINGA = ^SHNAMEMAPPINGA; + SHNAMEMAPPINGA = record + pszOldPath : LPSTR; + pszNewPath : LPSTR; + cchOldPath : longint; + cchNewPath : longint; + end; + + PSHNAMEMAPPINGW = ^SHNAMEMAPPINGW; + SHNAMEMAPPINGW = record + pszOldPath : LPWSTR; + pszNewPath : LPWSTR; + cchOldPath : longint; + cchNewPath : longint; + end; +{$ENDIF} + TSHNameMappingHeaderA = record cNumOfMappings: Cardinal; lpNM: PSHNAMEMAPPINGA; @@ -474,7 +516,7 @@ end; procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA); begin CopyMemory(@WideFindData, @AnsiFindData, - Integer(@WideFindData.cFileName) - Integer(@WideFindData)); + PtrUInt(@WideFindData.cFileName) - PtrUInt(@WideFindData)); WStrPCopy(WideFindData.cFileName, AnsiFindData.cFileName); WStrPCopy(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName); end; @@ -966,7 +1008,9 @@ var AnsiBuff: AnsiString; begin if Win32PlatformIsUnicode then - Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, lpFormat, lpCurrencyStr, cchCurrency) + Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, + {$IFNDEF FPC} lpFormat {$ELSE} PCurrencyFmt(lpFormat) {$ENDIF}, + lpCurrencyStr, cchCurrency) else begin if lpFormat = nil then PAnsiFormat := nil @@ -1175,10 +1219,12 @@ end; function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL; begin if Win32PlatformIsUnicode then - Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, lpmii) + Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, + {$IFDEF FPC}@{$ENDIF}lpmii) else begin TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData)); - Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, TMenuItemInfoA(lpmii)); + Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, + {$IFDEF FPC}@{$ENDIF}TMenuItemInfoA(lpmii)); end; end; @@ -1197,10 +1243,11 @@ function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar; var lpiIcon: Word): HICON; begin if Win32PlatformIsUnicode then - Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, lpIconPath, lpiIcon) + Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, + lpIconPath, {$IFDEF FPC}@{$ENDIF}lpiIcon) else Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst, - PAnsiChar(AnsiString(lpIconPath)), lpiIcon) + PAnsiChar(AnsiString(lpIconPath)), {$IFDEF FPC}@{$ENDIF}lpiIcon) end; function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD; @@ -1298,7 +1345,8 @@ begin else AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo))); AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle)); - Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(AnsiFileOp); + Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}( + {$IFDEF FPC}@{$ENDIF}AnsiFileOp); // return struct results lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted; lpFileOp.hNameMappings := nil; @@ -1364,7 +1412,8 @@ begin AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle)); if lpbi.pszDisplayName <> nil then AnsiInfo.pszDisplayName := AnsiBuffer; - Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(AnsiInfo); + Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}( + {$IFDEF FPC}@{$ENDIF}AnsiInfo); if lpbi.pszDisplayName <> nil then WStrPCopy(lpbi.pszDisplayName, AnsiInfo.pszDisplayName); lpbi.iImage := AnsiInfo.iImage; |