diff --git a/rtl/objpas/datih.inc b/rtl/objpas/datih.inc index 748a0dd91e..e20ab98e14 100644 --- a/rtl/objpas/datih.inc +++ b/rtl/objpas/datih.inc @@ -27,20 +27,7 @@ const MSecsPerDay = SecsPerDay * 1000; DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899 - DateSeparator: char = '-'; - TimeSeparator: char = ':'; - TimeAMString: string = 'am'; - TimePMString: string = 'pm'; - ShortMonthNames: array[1..12] of string = - ('Jan','Feb','Mar','Apr','May','Jun', - 'Jul','Aug','Sep','Oct','Nov','Dec'); - LongMonthNames: array[1..12] of string = - ('January','February','March','April','May','June', - 'July','August','September','October','November','December'); - ShortDayNames: array[1..7] of string = - ('Sun','Mon','Tue','Wen','Thu','Fri','Sat'); - LongDayNames: array[1..7] of string = - ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); + { date time formatting characters: c : shortdateformat + ' ' + shorttimeformat @@ -73,10 +60,6 @@ const 'xx' : literal text } - ShortDateFormat: string = 'd/m/y'; - LongDateFormat: string = 'dd" "mmmm" "yyyy'; - ShortTimeFormat: string = 'hh:nn'; - LongTimeFormat: string = 'hh:nn:ss'; Eoln = #10; @@ -123,7 +106,10 @@ Function FileDateToDateTime (Filedate : Longint) : TDateTime; { $Log$ - Revision 1.4 1998-10-11 13:40:53 michael + Revision 1.5 1999-02-28 13:17:34 michael + + Added internationalization support and more format functions + + Revision 1.4 1998/10/11 13:40:53 michael + Added Conversion TDateTime <-> file date and time Revision 1.3 1998/10/08 14:07:45 florian diff --git a/rtl/objpas/sysinth.inc b/rtl/objpas/sysinth.inc new file mode 100644 index 0000000000..e0ccc7f7d8 --- /dev/null +++ b/rtl/objpas/sysinth.inc @@ -0,0 +1,130 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1998 by the Free Pascal development team + + International settings for Sysutils unit. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ + All the variables presented here must be set by the InitInternational + routine. They must be set to match the 'local' settings, although + most have an initial value. + + + These routines are OS-dependent. +} + +{ --------------------------------------------------------------------- + Upper/lowercase translations + ---------------------------------------------------------------------} + +type + TCaseTranslationTable = array[0..255] of char; + +var + { Tables with upper and lowercase forms of character sets. + MUST be initialized with the correct code-pages } + UpperCaseTable: TCaseTranslationTable; + LowerCaseTable: TCaseTranslationTable; + +{ --------------------------------------------------------------------- + Date formatting settings + ---------------------------------------------------------------------} + +Const + + { Character to be put between date, month and year } + DateSeparator: char = '-'; + + { Format used for short date notation } + ShortDateFormat: string = 'd/m/y'; + + { Format used for long date notation } + LongDateFormat: string = 'dd" "mmmm" "yyyy'; + + + { Short names of months. } + ShortMonthNames: array[1..12] of string = + ('Jan','Feb','Mar','Apr','May','Jun', + 'Jul','Aug','Sep','Oct','Nov','Dec'); + + { Long names of months. } + LongMonthNames: array[1..12] of string = + ('January','February','March','April','May','June', + 'July','August','September','October','November','December'); + + { Short names of days } + ShortDayNames: array[1..7] of string = + ('Sun','Mon','Tue','Wen','Thu','Fri','Sat'); + + { Full names of days } + LongDayNames: array[1..7] of string = + ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); + + { Format used for short time notation } + ShortTimeFormat: string = 'hh:nn'; + + { Format used for long time notation } + LongTimeFormat: string = 'hh:nn:ss'; + + { Character to be put between hours and minutes } + TimeSeparator: char = ':'; + + { String to indicate AM time when using 12 hour clock. } + TimeAMString: string[7] = 'AM'; + + { String to indicate PM time when using 12 hour clock. } + TimePMString: string[7] = 'PM'; + + + +{ --------------------------------------------------------------------- + Number formatting constants + ---------------------------------------------------------------------} + + + { Character that comes between integer and fractional part of a number } + DecimalSeparator : Char = '.'; + + { Character that is put every 3 numbers in a currency } + ThousandSeparator : Char = ','; + + { Number of decimals to use when formatting a currency. } + CurrencyDecimals : Byte = 2; + + { Format to use when formatting currency : + 0 = $1 + 1 = 1$ + 2 = $ 1 + 3 = 1 $ + 4 = Currency string replaces decimal indicator. e.g. 1$50 + } + CurrencyFormat : Byte = 1; + + { Same as above, only for negative currencies: + 0 = ($1) + 1 = -$1 + 2 = $-1 + 3 = $1- + 4 = (1$) + 5 = -1$ + 6 = 1-$ + 7 = 1$- + 8 = -1 $ + 9 = -$ 1 + 10 = $ 1- + } + NegCurrFormat : Byte = 5; + + { Currency notation. Default is $ for dollars. } + CurrencyString : String[7] = '$'; + diff --git a/rtl/objpas/sysstr.inc b/rtl/objpas/sysstr.inc index 44f151129b..0c94066d10 100644 --- a/rtl/objpas/sysstr.inc +++ b/rtl/objpas/sysstr.inc @@ -163,12 +163,6 @@ end ; { these functions rely on the character set loaded by the OS } {==============================================================================} -type - TCaseTranslationTable = array[0..255] of char; - -var - UpperCaseTable: TCaseTranslationTable; - LowerCaseTable: TCaseTranslationTable; function AnsiUpperCase(const s: string): string; var len, i: integer; @@ -698,23 +692,196 @@ begin end; end; +Function FormatBuf (Var Buffer; BufLen : Cardinal; + Const Fmt; fmtLen : Cardinal; + Const Args : Array of const) : Cardinal; + +Var S,F : String; + +begin + Setlength(F,fmtlen); + Move(fmt,F[1],fmtlen); + S:=Format (F,Args); + If Length(S)>Buflen then + Result:=Length(S) + else + Result:=Buflen; + Move(S[1],Buffer,Result); +end; + +Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const); + +begin + Res:=Format(fmt,Args); +end; + +Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar; + +begin + Buffer[FormatBuf(Buffer^,Maxint,Fmt^,strlen(fmt),args)]:=#0; + Result:=Buffer; +end; + +Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar; + +begin + Buffer[FormatBuf(Buffer^,MaxLen,Fmt^,strlen(fmt),args)]:=#0; + Result:=Buffer; +end; + +Function FloatToStr(Value: Extended): String; +Begin + Result := FloatToStrF(Value, ffGeneral, 15, 0); +End; + +Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String; +Var + P: Integer; + Negative, TooSmall, TooLarge: Boolean; +Begin + Case format Of + + ffGeneral: + + Begin + If (Precision = -1) Or (Precision > 15) Then Precision := 15; + TooSmall := Abs(Value) < 0.00001; + If Not TooSmall Then + Begin + Str(Value:0:999, Result); + P := Pos('.', Result); + Result[P] := DecimalSeparator; + TooLarge := P > Precision + 1; + End; + + If TooSmall Or TooLarge Then + Result := FloatToStrF(Value, ffExponent, Precision, Digits); + + P := Length(Result); + While Result[P] = '0' Do Dec(P); + If Result[P] = DecimalSeparator Then Dec(P); + SetLength(Result, P); + End; + + ffExponent: + + Begin + If (Precision = -1) Or (Precision > 15) Then Precision := 15; + Str(Value:Precision + 8, Result); + Result[3] := DecimalSeparator; + If (Digits < 4) And (Result[Precision + 5] = '0') Then + Begin + Delete(Result, Precision + 5, 1); + If (Digits < 3) And (Result[Precision + 5] = '0') Then + Begin + Delete(Result, Precision + 5, 1); + If (Digits < 2) And (Result[Precision + 5] = '0') Then + Begin + Delete(Result, Precision + 5, 1); + If (Digits < 1) And (Result[Precision + 5] = '0') Then Delete(Result, Precision + 3, 3); + End; + End; + End; + If Result[1] = ' ' Then Delete(Result, 1, 1); + End; + + ffFixed: + + Begin + If Digits = -1 Then Digits := 2 + Else If Digits > 15 Then Digits := 15; + Str(Value:0:Digits, Result); + If Result[1] = ' ' Then Delete(Result, 1, 1); + P := Pos('.', Result); + If P <> 0 Then Result[P] := DecimalSeparator; + End; + + ffNumber: + + Begin + If Digits = -1 Then Digits := 2 + Else If Digits > 15 Then Digits := 15; + Str(Value:0:Digits, Result); + If Result[1] = ' ' Then Delete(Result, 1, 1); + P := Pos('.', Result); + If P <> 0 Then Result[P] := DecimalSeparator; + Dec(P, 3); + While (P > 1) Do + Begin + If Result[P - 1] <> '-' Then Insert(ThousandSeparator, Result, P); + Dec(P, 3); + End; + End; + + ffCurrency: + + Begin + If Value < 0 Then + Begin + Negative := True; + Value := -Value; + End + Else Negative := False; + + If Digits = -1 Then Digits := CurrencyDecimals + Else If Digits > 15 Then Digits := 15; + Str(Value:0:Digits, Result); + If Result[1] = ' ' Then Delete(Result, 1, 1); + P := Pos('.', Result); + If P <> 0 Then Result[P] := DecimalSeparator; + Dec(P, 3); + While (P > 1) Do + Begin + Insert(ThousandSeparator, Result, P); + Dec(P, 3); + End; + + If Not Negative Then + Begin + Case CurrencyFormat Of + 0: Result := CurrencyString + Result; + 1: Result := Result + CurrencyString; + 2: Result := CurrencyString + ' ' + Result; + 3: Result := Result + ' ' + CurrencyString; + End + End + Else + Begin + Case NegCurrFormat Of + 0: Result := '(' + CurrencyString + Result + ')'; + 1: Result := '-' + CurrencyString + Result; + 2: Result := CurrencyString + '-' + Result; + 3: Result := CurrencyString + Result + '-'; + 4: Result := '(' + Result + CurrencyString + ')'; + 5: Result := '-' + Result + CurrencyString; + 6: Result := Result + '-' + CurrencyString; + 7: Result := Result + CurrencyString + '-'; + 8: Result := '-' + Result + ' ' + CurrencyString; + 9: Result := '-' + CurrencyString + ' ' + Result; + 10: Result := CurrencyString + ' ' + Result + '-'; + End; + End; + End; + End; +End; + {==============================================================================} { extra functions } {==============================================================================} -{ LeftStr returns Count left-most characters from S } +{ LeftStr returns Count left-most characters from S } function LeftStr(const S: string; Count: integer): string; begin -result := Copy(S, 1, Count); + result := Copy(S, 1, Count); end ; -{ RightStr returns Count right-most characters from S } +{ RightStr returns Count right-most characters from S } function RightStr(const S: string; Count: integer): string; begin -result := Copy(S, 1 + Length(S) - Count, Count); -end ; + result := Copy(S, 1 + Length(S) - Count, Count); +end; { BCDToInt converts the BCD value Value to an integer } @@ -730,14 +897,16 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin end ; end ; -{ Case Translation Tables } - - { Although these tables can be obtained through system calls } - { it is better to not use those, since most implementation are not 100% } - - { WARNING: } - { before modifying a translation table make sure that the current codepage } - { of the OS corresponds to the one you make changes to } +{ + Case Translation Tables + Can be used in internationalization support. + + Although these tables can be obtained through system calls + it is better to not use those, since most implementation are not 100% + WARNING: + before modifying a translation table make sure that the current codepage + of the OS corresponds to the one you make changes to +} const { upper case translation table for character set 850 } @@ -784,100 +953,12 @@ const #240, #241, #242, #243, #244, #245, #246, #247, #248, #249, #250, #251, #252, #253, #254, #255 ); -{$IFDEF GO32V2} - -{ Codepage constants } - -const - CP_US = 437; - CP_MultiLingual = 850; - CP_SlavicLatin2 = 852; - CP_Turkish = 857; - CP_Portugal = 860; - CP_IceLand = 861; - CP_Canada = 863; - CP_NorwayDenmark = 865; - -{ CountryInfo } -type - TCountryInfo = packed record - InfoId: byte; - case integer of - 1: ( Size: word; - CountryId: word; - CodePage: word; - CountryInfo: array[0..33] of byte ); - 2: ( UpperCaseTable: longint ); - 4: ( FilenameUpperCaseTable: longint ); - 5: ( FilecharacterTable: longint ); - 6: ( CollatingTable: longint ); - 7: ( DBCSLeadByteTable: longint ); - end ; - - -procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo); -var Regs: Registers; -begin -Regs.AH := $65; -Regs.AL := InfoId; -Regs.BX := CodePage; -Regs.DX := CountryId; -Regs.ES := transfer_buffer div 16; -Regs.DI := transfer_buffer and 15; -Regs.CX := SizeOf(TCountryInfo); -RealIntr($21, Regs); -DosMemGet(transfer_buffer shr 16, transfer_buffer and 65535, CountryInfo, Regs.CX ); -end ; - -procedure InitAnsi; -var CountryInfo: TCountryInfo; i: integer; -begin -{ Fill table entries 0 to 127 } -for i := 0 to 96 do - UpperCaseTable[i] := chr(i); -for i := 97 to 122 do - UpperCaseTable[i] := chr(i - 32); -for i := 123 to 127 do - UpperCaseTable[i] := chr(i); -for i := 0 to 64 do - LowerCaseTable[i] := chr(i); -for i := 65 to 90 do - LowerCaseTable[i] := chr(i + 32); -for i := 91 to 255 do - LowerCaseTable[i] := chr(i); -{ Get country and codepage info } -GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo); -if CountryInfo.CodePage = 850 then begin - Move(CP850UCT, UpperCaseTable[128], 128); - Move(CP850LCT, LowerCaseTable[128], 128); - end -else begin -{ this needs to be checked !! - this is correct only if UpperCaseTable is - and Offset:Segment word record (PM) } - { get the uppercase table from dosmemory } - GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo); - DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128); - for i := 128 to 255 do begin - if UpperCaseTable[i] <> chr(i) then - LowerCaseTable[ord(UpperCaseTable[i])] := chr(i); - end ; - end ; -end ; - -{$ELSE} -// {$IFDEF LINUX} - -procedure InitAnsi; -begin -end ; - -// {$ENDIF} -{$ENDIF} - { $Log$ - Revision 1.12 1999-02-24 15:56:29 michael + Revision 1.13 1999-02-28 13:17:35 michael + + Added internationalization support and more format functions + + Revision 1.12 1999/02/24 15:56:29 michael + Small fixes. Moved getlocaltime to system-dependent files Revision 1.11 1999/02/10 22:15:12 michael diff --git a/rtl/objpas/sysstrh.inc b/rtl/objpas/sysstrh.inc index 9408b00b9e..6a5c2994e7 100644 --- a/rtl/objpas/sysstrh.inc +++ b/rtl/objpas/sysstrh.inc @@ -27,7 +27,11 @@ type PString = ^String; + + { For FloatToText } + TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency); + function NewStr(const S: string): PString; procedure DisposeStr(S: PString); procedure AssignStr(var P: PString; const S: string); @@ -70,6 +74,12 @@ function StrToIntDef(const S: string; Default: integer): integer; function LoadStr(Ident: integer): string; // function FmtLoadStr(Ident: integer; const Args: array of const): string; Function Format (Const Fmt : String; const Args : Array of const) : String; +Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal; +Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar; +Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar; +Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const); +Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String; +Function FloatToStr(Value: Extended): String; {==============================================================================} { extra functions } @@ -81,7 +91,10 @@ function BCDToInt(Value: integer): integer; { $Log$ - Revision 1.5 1998-12-15 22:43:11 peter + Revision 1.6 1999-02-28 13:17:36 michael + + Added internationalization support and more format functions + + Revision 1.5 1998/12/15 22:43:11 peter * removed temp symbols Revision 1.4 1998/11/04 10:20:53 peter diff --git a/rtl/objpas/sysutils.pp b/rtl/objpas/sysutils.pp index 9a225fb58b..a4ba17fec0 100644 --- a/rtl/objpas/sysutils.pp +++ b/rtl/objpas/sysutils.pp @@ -18,6 +18,7 @@ interface {$MODE objfpc} { force ansistrings } {$H+} + uses {$ifdef linux} linux @@ -26,76 +27,79 @@ interface dos,windows {$else} {$ifdef go32v2} - dos,go32 + dos,go32 {$endif go32v2} {$endif win32} {$endif linux} - ; + ; - type - { some helpful data types } +type + { some helpful data types } - tprocedure = procedure; + tprocedure = procedure; - tfilename = string; + tfilename = string; - longrec = packed record - lo,hi : word; - end; + longrec = packed record + lo,hi : word; + end; - wordrec = packed record - lo,hi : byte; - end; + wordrec = packed record + lo,hi : byte; + end; - { exceptions } - exception = class(TObject) - private - fmessage : string; - fhelpcontext : longint; - public - constructor create(const msg : string); - constructor createfmt(const msg : string; const args : array of const); - constructor createres(ident : longint); - { !!!! } - property helpcontext : longint read fhelpcontext write fhelpcontext; - property message : string read fmessage write fmessage; - end; + { exceptions } + exception = class(TObject) + private + fmessage : string; + fhelpcontext : longint; + public + constructor create(const msg : string); + constructor createfmt(const msg : string; const args : array of const); + constructor createres(ident : longint); + { !!!! } + property helpcontext : longint read fhelpcontext write fhelpcontext; + property message : string read fmessage write fmessage; + end; - exceptclass = class of exception; + exceptclass = class of exception; - { integer math exceptions } - EInterror = Class(Exception); - EDivByZero = Class(EIntError); - ERangeError = Class(EIntError); - EIntOverflow = Class(EIntError); + { integer math exceptions } + EInterror = Class(Exception); + EDivByZero = Class(EIntError); + ERangeError = Class(EIntError); + EIntOverflow = Class(EIntError); - { General math errors } - EMathError = Class(Exception); - EInvalidOp = Class(EMathError); - EZeroDivide = Class(EMathError); - EOverflow = Class(EMathError); - EUnderflow = Class(EMathError); + { General math errors } + EMathError = Class(Exception); + EInvalidOp = Class(EMathError); + EZeroDivide = Class(EMathError); + EOverflow = Class(EMathError); + EUnderflow = Class(EMathError); - { Run-time and I/O Errors } - EInOutError = class(Exception) - public - ErrorCode : Longint; - end; - EInvalidPointer = Class(Exception); - EOutOfMemory = Class(Exception); - EAccessViolation = Class(Exception); - EInvalidCast = Class(Exception); + { Run-time and I/O Errors } + EInOutError = class(Exception) + public + ErrorCode : Longint; + end; + EInvalidPointer = Class(Exception); + EOutOfMemory = Class(Exception); + EAccessViolation = Class(Exception); + EInvalidCast = Class(Exception); - { String conversion errors } - EConvertError = class(Exception); + { String conversion errors } + EConvertError = class(Exception); - { Other errors } - EAbort = Class(Exception); - EAbstractError = Class(Exception); - EAssertionFailed = Class(Exception); + { Other errors } + EAbort = Class(Exception); + EAbstractError = Class(Exception); + EAssertionFailed = Class(Exception); + { Read internationalization settings } + {$i sysinth.inc} + { Read date & Time function declarations } {$i datih.inc} @@ -131,6 +135,9 @@ interface { Read filename handling functions implementation } {$i fina.inc} + { Read String Handling functions implementation } + {$i sysstr.inc} + { Read other file handling function implementations } {$i filutil.inc} @@ -140,9 +147,6 @@ interface { Read date & Time function implementations } {$i dati.inc} - { Read String Handling functions implementation } - {$i sysstr.inc} - { Read pchar handling functions implementation } {$i syspch.inc} @@ -266,13 +270,18 @@ begin end; -{Initialization code.} +{ Initialization code. } + begin - InitExceptions; + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } end. { $Log$ - Revision 1.22 1999-02-10 22:15:13 michael + Revision 1.23 1999-02-28 13:17:37 michael + + Added internationalization support and more format functions + + Revision 1.22 1999/02/10 22:15:13 michael + Changed to ansistrings Revision 1.21 1999/02/09 14:24:50 pierre