1 unit gnugettextD5;
2 // Information about this file:
3 // $LastChangedDate: 2005-04-04 19:40:57 +0200 (Mon, 04 Apr 2005) $
4 // $LastChangedRevision: 60 $
5 // $HeadURL: svn://svn.berlios.de/dxgettext/trunk/dxgettext/sample/gnugettextD5.pas $
6 
7 // Delphi 5 optimized interface for gnugettext.pas
8 // This unit must only be used on Delphi 5. When you upgrade to Delphi 6 or
9 // later, you should remove this unit and replace all reference to gnugettextD5
10 // with refernces to gnugettext.
11 
12 interface
13 
14 uses
15   Classes;
16 
17 // Ansistring versions of the api
_null18 function _(const szMsgId: string): string;
gettextnull19 function gettext(const szMsgId: string): string;
dgettextnull20 function dgettext(const szDomain: string; const szMsgId: string): string;
21 procedure TranslateComponent(AnObject: TComponent);
22 
23 
24 
25 //*****************************************************************************
26 // Don't use anything in the interface below this line.
27 // It only contains code or gnugettext.pas to make it compile with Delphi 5.
28 
29 type
30   UTF8String = AnsiString;
31 
32 const
33   PathDelim='\';
34   sLineBreak=#13#10;
35 
36 function GetEnvironmentVariable(const VarName: string): string;
37 function DirectoryExists(const Name:string):boolean;
38 function IncludeTrailingPathDelimiter(s: string): string;
39 function ExcludeTrailingPathDelimiter(s: string): string;
40 procedure RaiseLastOSError;
41 function StrToFloatDef(const S:String;Default:Extended):Extended;
42 function Utf8Decode(const S: UTF8String): WideString;
43 function Utf8Encode(const WS: WideString): UTF8String;
44 
45 
46 
47 implementation
48 
49 uses
50   filectrl, Windows, SysUtils,
51   gnugettext;
52 
53 function GetEnvironmentVariable(const VarName: string): string;
54 var Size: Integer;
55 begin
56   Size := Windows.GetEnvironmentVariable(PChar(VarName), nil, 0);
57   SetLength(Result, Size - 1);
58   Windows.GetEnvironmentVariable(PChar(VarName), PChar(Result), Size);
59 end;
60 
61 function DirectoryExists(const Name:string):boolean;
62 begin
63   Result := FileCtrl.DirectoryExists(Name);
64 end;
65 
66 function IncludeTrailingPathDelimiter(s: string): string;
67 begin
68   Result := IncludeTrailingBackslash(s);
69 end;
70 
71 function ExcludeTrailingPathDelimiter(s: string): string;
72 begin
73   Result := ExcludeTrailingBackslash(s);
74 end;
75 
76 procedure RaiseLastOSError;
77 begin
78   RaiseLastWin32Error;
79 end;
80 
81 function StrToFloatDef(const S:String;Default:Extended):Extended;
82 begin
83   if not TextToFloat(PChar(S), Result, fvExtended) then
84     Result := Default;
85 end;
86 
87 function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal;
88 var
89   i, count: Cardinal;
90   c: Cardinal;
91 begin
92   Result := 0;
93   if Source = nil then
94     Exit;
95   count := 0;
96   i := 0;
97   if Dest <> nil then begin
98     while (i < SourceChars) and (count < MaxDestBytes) do begin
99       c := Cardinal(Source[i]);
100       Inc(i);
101       if c <= $7F then begin
102         Dest[count] := Char(c);
103         Inc(count);
104       end else
105       if c > $7FF then begin
106         if count + 3 > MaxDestBytes then
107           break;
108         Dest[count] := Char($E0 or (c shr 12));
109         Dest[count + 1] := Char($80 or ((c shr 6) and $3F));
110         Dest[count + 2] := Char($80 or (c and $3F));
111         Inc(count, 3);
112       end else //  $7F < Source[i] <= $7FF
113       begin
114         if count + 2 > MaxDestBytes then
115           break;
116         Dest[count] := Char($C0 or (c shr 6));
117         Dest[count + 1] := Char($80 or (c and $3F));
118         Inc(count, 2);
119       end;
120     end;
121     if count >= MaxDestBytes then
122       count := MaxDestBytes - 1;
123     Dest[count] := #0;
124   end else begin
125     while i < SourceChars do begin
126       c := Integer(Source[i]);
127       Inc(i);
128       if c > $7F then begin
129         if c > $7FF then
130           Inc(count);
131         Inc(count);
132       end;
133       Inc(count);
134     end;
135   end;
136   Result := count + 1; // convert zero based index to byte count
137 end;
138 
139 function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
140 var
141   i, count: Cardinal;
142   c: Byte;
143   wc: Cardinal;
144 begin
145   if Source = nil then begin
146     Result := 0;
147     Exit;
148   end;
149   Result := Cardinal(-1);
150   count := 0;
151   i := 0;
152   if Dest <> nil then begin
153     while (i < SourceBytes) and (count < MaxDestChars) do begin
154       wc := Cardinal(Source[i]);
155       Inc(i);
156       if (wc and $80) <> 0 then begin
157         if i >= SourceBytes then
158           Exit; // incomplete multibyte char
159         wc := wc and $3F;
160         if (wc and $20) <> 0 then begin
161           c := Byte(Source[i]);
162           Inc(i);
163           if (c and $C0) <> $80 then
164             Exit; // malformed trail byte or out of range char
165           if i >= SourceBytes then
166             Exit; // incomplete multibyte char
167           wc := (wc shl 6) or (c and $3F);
168         end;
169         c := Byte(Source[i]);
170         Inc(i);
171         if (c and $C0) <> $80 then
172           Exit; // malformed trail byte
173 
174         Dest[count] := WideChar((wc shl 6) or (c and $3F));
175       end else
176         Dest[count] := WideChar(wc);
177       Inc(count);
178     end;
179     if count >= MaxDestChars then
180       count := MaxDestChars - 1;
181     Dest[count] := #0;
182   end else begin
183     while (i < SourceBytes) do begin
184       c := Byte(Source[i]);
185       Inc(i);
186       if (c and $80) <> 0 then begin
187         if i >= SourceBytes then
188           Exit; // incomplete multibyte char
189         c := c and $3F;
190         if (c and $20) <> 0 then begin
191           c := Byte(Source[i]);
192           Inc(i);
193           if (c and $C0) <> $80 then
194             Exit; // malformed trail byte or out of range char
195           if i >= SourceBytes then
196             Exit; // incomplete multibyte char
197         end;
198         c := Byte(Source[i]);
199         Inc(i);
200         if (c and $C0) <> $80 then
201           Exit; // malformed trail byte
202       end;
203       Inc(count);
204     end;
205   end;
206   Result := count + 1;
207 end;
208 
209 function Utf8Decode(const S: UTF8String): WideString;
210 var
211   L: Integer;
212   Temp: WideString;
213 begin
214   Result := '';
215   if S = '' then
216     Exit;
217   SetLength(Temp, Length(S));
218 
219   L := Utf8ToUnicode(PWideChar(Temp), Length(Temp) + 1, PChar(S), Length(S));
220   if L > 0 then
221     SetLength(Temp, L - 1)
222   else
223     Temp := '';
224   Result := Temp;
225 end;
226 
227 function Utf8Encode(const WS: WideString): UTF8String;
228 var
229   L: Integer;
230   Temp: UTF8String;
231 begin
232   Result := '';
233   if WS = '' then
234     Exit;
235   SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator
236 
237   L := UnicodeToUtf8(PChar(Temp), Length(Temp) + 1, PWideChar(WS), Length(WS));
238   if L > 0 then
239     SetLength(Temp, L - 1)
240   else
241     Temp := '';
242   Result := Temp;
243 end;
244 
245 function _(const szMsgId: string): string;
246 begin
247   Result:=gettext(szMsgid);
248 end;
249 
250 function gettext(const szMsgId: string): string;
251 begin
252   Result:=string(DefaultInstance.gettext(DefaultInstance.ansi2wideDTCP(szMsgId)));
253 end;
254 
255 function dgettext(const szDomain: string; const szMsgId: string): string;
256 begin
257   Result:=string(DefaultInstance.dgettext(szDomain,DefaultInstance.ansi2wideDTCP(szMsgId)));
258 end;
259 
260 procedure TranslateComponent(AnObject: TComponent);
261 begin
262   gnugettext.TranslateComponent(AnObject);
263 end;
264 
265 end.
266