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