source: trunk/Components/ACLLanguageUnit.pas@ 254

Last change on this file since 254 was 254, checked in by RBRi, 18 years ago

i18n fix

  • Property svn:eol-style set to native
File size: 25.8 KB
RevLine 
[15]1Unit ACLLanguageUnit;
2
[226]3// NewView - a new OS/2 Help Viewer
4// Copyright 2003-2006 Aaron Lawrence
5// Copyright 2006-2007 Ronald Brill (rbri at rbri dot de)
6// This software is released under the GNU Public License - see readme.txt
7
8// Helper functions for i18n
9
[15]10Interface
11
12uses
13 OS2Def,
[188]14 Classes,
[226]15 Forms,
16 FileUtilsUnit;
[15]17
[226]18
19const
20 LANGUAGE_DELIMITER = '_';
21 LANGUAGE_FILE_EXTENSION = FILE_EXTENSION_DELIMITER + 'lng';
22 LANGUAGE_COMMENT_CHAR = '#';
23 LANGUAGE_ENVIRONMENT_VAR_LANG = 'LANG';
24 LANGUAGE_ENVIRONMENT_VAR_OSDIR = 'OSDIR';
25 LANGUAGE_ENVIRONMENT_VAR_ULSPATH = 'ULSPATH';
26 LANGUAGE_DEFAULT_LANGUAGE = 'EN_US';
27 LANGUAGE_DEFAULT_MARKER = '***';
28 LANGUAGE_LABEL_DELIMITER = '.';
29
30
[15]31type
32 TLanguageItem = record
[231]33 pLabel: pString;
[226]34 pValue: pString;
35 wasUsed: boolean;
36 isDefault: boolean;
[15]37 end;
[226]38 TPLanguageItem = ^TLanguageItem;
[15]39
[226]40 TLanguageItemList = class
[15]41 protected
[226]42 translationsList : TStringList;
43 procedure setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
44 public
45 constructor Create;
46 destructor Destroy; override;
[15]47
[226]48 function getValue(const aLabel : String; const aDefaultValue : String) : String;
49 procedure setValue(const aLabel : String; const aValue : String);
[249]50 procedure readFrom(aTextFile : TextFile);
[226]51 procedure saveTo(const aTextFile : TextFile);
52 end;
[15]53
54
[226]55 TLanguageFile = class
56 protected
57 languageItems : TLanguageItemList;
58 fileName: string;
[15]59
[226]60 procedure LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
[15]61
62 public
[226]63 constructor Create(const aFileName : String);
[15]64 destructor Destroy; override;
65
[226]66 // if anApplyFlag is true, then the component and it's
[15]67 // owned components will be updated. If false, then
68 // it will only be checked and missing items noted.
69
[226]70 // For convenience in loading strings manually, related to the component
71 procedure LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
[15]72
73
[226]74 // write the current transations to a file
75 procedure writeToFile(const aFileName : String);
[15]76
[226]77 // If anApplyFlag is true, then assign aValue the translation
78 // for aLabel. Or, if not found, use aDefaultValue.
79 // If anApplyFlag is false, just look it up but don't assign to
80 // aValue
81 procedure LL( const anApplyFlag: boolean;
82 Var aValue: string;
83 const aLabel: string;
84 const aDefaultValue: string );
[15]85
86 end;
87
[226]88
[15]89 // callback for when language events occur
90 // If apply is true, then the specified language has been loaded
91 // If apply is false, then the specified language file is being
92 // saved, so you should access any strings you need,
93 // but not actually change anything
[226]94 TLanguageEvent = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean) of object;
[15]95
96 // non-object version
[226]97 TLanguageProc = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean);
[15]98
[226]99
[15]100var
101 g_CurrentLanguageFile: TLanguageFile;
102
[226]103 // Register that you want to know when the current language changes
104 // Will immediately call you back, if there is a current language
105 procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
[15]106
[226]107 // Register a procedure callback (not-object)
108 procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
[15]109
110
[226]111 // Register a procedure that will be called only when a language file
112 // is being updated (use to load forms if needed)
113 procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
[15]114
115
[226]116 // Change current language to given, and tell everybody who has registered
117 procedure ApplyLanguage(aLanguage: TLanguageFile);
[15]118
[226]119 // Tell everybody who has registered to access the given file,
120 // but don't apply strings from it
121 procedure UpdateLanguage(aLanguage: TLanguageFile);
[15]122
123
[226]124 // Load and apply specified language file
125 procedure LoadLanguage(const aFilePath: String);
[15]126
127
[226]128 // load a language from the standard location.
129 // anAppName is a short name for the app, e.g. 'newview'
130 // language spec is e.g. 'es' or 'es_es'
131 function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string): boolean;
[15]132
[226]133
134 // load default language based on LANG environment var
135 procedure LoadDefaultLanguage(const anAppName: string);
136
137
[15]138Implementation
139
140uses
[226]141 Dos, SysUtils,
[188]142 StdCtrls,
143 Buttons,
144 ExtCtrls,
145 TabCtrls,
146 Dialogs,
147 Coolbar2,
148 Multicolumnlistbox,
149 ACLUtility,
[220]150 FileUtilsUnit,
151 StringUtilsUnit,
152 DebugUnit;
[15]153
154var
155 g_LanguageCallbacks: TList;
156 g_LanguageUpdateCallbacks: TList;
157
[226]158
159 // -----------------
160 // TLanguageItemList
161 // -----------------
162
163 constructor TLanguageItemList.Create;
164 begin
165 // LogEvent(LogI18n, 'TLanguageItemList.Create');
166 // setup our memory
167 translationsList := TStringList.Create;
168 translationsList.Sorted := true; // for lookup speed
169 translationsList.CaseSensitive := true; // also for speed. We manually convert to uppercase.
170 translationsList.Duplicates := dupAccept;
171 end;
172
173
174 destructor TLanguageItemList.Destroy;
175 var
176 i: longint;
177 tmpPLanguageItem: TPLanguageItem;
178 begin
179 // LogEvent(LogI18n, 'TLanguageItemList.Destroy');
180 for i := 0 to translationsList.Count - 1 do
181 begin
182 tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
183
184 // free the parts of the item
[231]185 DisposeStr(tmpPLanguageItem^.pLabel);
[226]186 DisposeStr(tmpPLanguageItem^.pValue);
187 Dispose(tmpPLanguageItem);
188 end;
189
190 translationsList.Destroy;
191 end;
192
193
194 function TLanguageItemList.getValue(const aLabel : String; const aDefaultValue : String) : String;
195 var
196 tmpPosition : LongInt;
197 tmpFound : Boolean;
198 tmpPLanguageItem : TPLanguageItem;
199 begin
200 tmpFound := translationsList.Find(UpperCase(aLabel), tmpPosition);
201
202 if not tmpFound then
203 begin
204 setValueWithFlags(aLabel, aDefaultValue, true);
205 result := '';
206
207 // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ') [' + aDefaultValue + ']->' + result);
208 exit;
209 end;
210
211 tmpPLanguageItem := TPLanguageItem(translationsList.Objects[tmpPosition]);
212
213 // mark as used
214 tmpPLanguageItem^.wasUsed := true;
215
216 if tmpPLanguageItem^.isDefault then
217 begin
218 result := '';
219
220 // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
221 exit;
222 end;
223
224 result := tmpPLanguageItem^.pValue^;
225 // LogEvent(LogI18n, 'TLanguageItemList.getValue(' + aLabel + ')->' + result);
226 end;
227
228
229 procedure TLanguageItemList.setValue(const aLabel : String; const aValue : String);
230 begin
231 setValueWithFlags(aLabel, aValue, false);
232 end;
233
234
235 procedure TLanguageItemList.setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
236 var
237 tmpPLanguageItem: TPLanguageItem;
238 begin
239 // LogEvent(LogI18n, 'TLanguageItemList.setValueWithFlags(' + aLabel + ')->' + aValue + '[' + BoolToStr(aDefaultFlag) + ']');
240
241 New(tmpPLanguageItem);
[231]242 tmpPLanguageItem^.pLabel := NewStr(aLabel);
[226]243 tmpPLanguageItem^.pValue := NewStr(aValue);
244 tmpPLanguageItem^.wasUsed := false;
245 tmpPLanguageItem^.isDefault := aDefaultFlag;
246
247 translationsList.AddObject(UpperCase(aLabel), TObject(tmpPLanguageItem));
248 end;
249
250
[249]251 procedure TLanguageItemList.readFrom(aTextFile : TextFile);
252 var
253 tmpLine : string;
254 tmpLabel : string;
255 tmpValue : string;
256 tmpLineParts : TStringList;
257 begin
258 tmpLineParts := TStringList.Create;
259
260 while not Eof(aTextFile) do
261 begin
262 ReadLn(aTextFile, tmpLine);
263
264 tmpLineParts.clear;
265 StrExtractStringsQuoted(tmpLineParts, tmpLine);
266
267 if tmpLineParts.count > 0 then
268 begin
269 tmpLabel := tmpLineParts[0];
270
271 // TODO trim leading blanks
272 if tmpLabel[1] <> LANGUAGE_COMMENT_CHAR then
273 begin
274 // Got a name, read the value and store.
275 tmpValue := '';
276 if tmpLineParts.count > 0 then
277 begin
278 tmpValue := tmpLineParts[1];
279 end;
280
281 setValue(tmpLabel, tmpValue);
282 end;
283 end;
284 end;
285
286 tmpLineParts.Destroy;
287 end;
288
289
[226]290 procedure TLanguageItemList.saveTo(const aTextFile : TextFile);
291 var
292 i : integer;
293 tmpPLanguageItem: TPLanguageItem;
294 tmpLabel : String;
295 tmpQuotedValue : String;
296 tmpUnusedHeaderFlag : boolean;
297 begin
298 // used first
299 for i := 0 to translationsList.Count - 1 do
300 begin
301 tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
302 if tmpPLanguageItem^.wasUsed then
303 begin
[231]304 tmpLabel := tmpPLanguageItem^.pLabel^;
[226]305
306 tmpQuotedValue := tmpPLanguageItem^.pValue^;
307 tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
308 tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);
309
310 if tmpPLanguageItem^.isDefault then
311 begin
312 WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
313 end
314 else
315 begin
316 WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
317 end;
318 end;
319 end;
320
321
322 // unused at the end
323 tmpUnusedHeaderFlag := false;
324 for i := 0 to translationsList.Count - 1 do
325 begin
326 tmpPLanguageItem := TPLanguageItem(translationsList.Objects[i]);
327 if not tmpPLanguageItem^.wasUsed then
328 begin
329 if not tmpUnusedHeaderFlag then
330 begin
331 tmpUnusedHeaderFlag := true;
332
333 Writeln(aTextFile, '# **********************************************************');
334 Writeln(aTextFile, '# * The following items are no longer needed. *');
335 Writeln(aTextFile, '# * You can delete them after checking they are of no use. *');
336 Writeln(aTextFile, '# **********************************************************');
337 end;
338
[231]339 tmpLabel := tmpPLanguageItem^.pLabel^;
[226]340
341 tmpQuotedValue := tmpPLanguageItem^.pValue^;
342 tmpQuotedValue := StrEscapeAllCharsBy(tmpQuotedValue, [], '"');
343 tmpQuotedValue := StrInDoubleQuotes(tmpQuotedValue);
344
345 if tmpPLanguageItem^.isDefault then
346 begin
347 WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue + ' ' + LANGUAGE_DEFAULT_MARKER);
348 end
349 else
350 begin
351 WriteLn(aTextFile, tmpLabel + ' ' + tmpQuotedValue);
352 end;
353 end;
354 end;
355 end;
356
357
358 // -----------------
359 // TLanguageCallback
360 // -----------------
361
[15]362Type
363 TLanguageCallback = class
364 FCallbackMethod: TLanguageEvent;
365 FCallbackProc: TLanguageProc;
366 constructor CreateMethod( CallbackMethod: TLanguageEvent );
367 constructor CreateProc( CallbackProc: TLanguageProc );
368 end;
369
370
[226]371 constructor TLanguageCallback.CreateMethod(CallbackMethod: TLanguageEvent);
372 begin
373 FCallbackMethod := CallbackMethod;
374 FCallbackProc := nil;
375 end;
[15]376
377
[226]378 constructor TLanguageCallback.CreateProc(aCallbackProc: TLanguageProc);
379 begin
380 FCallbackProc := CallbackProc;
381 FCallbackMethod := nil;
382 end;
[15]383
384
[226]385 procedure AddLanguageCallback(aCallbackObject: TLanguageCallback);
386 begin
387 if g_LanguageCallbacks = nil then
388 begin
389 g_LanguageCallbacks := TList.Create;
390 end;
[15]391
[226]392 g_LanguageCallbacks.Add(aCallbackObject);
393 end;
[15]394
395
[226]396 procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
397 begin
398 AddLanguageCallback( TLanguageCallback.CreateMethod(aCallbackEvent) );
[15]399
[226]400 if g_CurrentLanguageFile <> nil then
401 begin
402 aCallbackEvent(g_CurrentLanguageFile, true);
403 end;
404 end;
[15]405
406
[226]407 procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
408 begin
409 AddLanguageCallback( TLanguageCallback.CreateProc(aCallbackProc) );
[15]410
[226]411 if g_CurrentLanguageFile <> nil then
412 begin
413 aCallbackProc(g_CurrentLanguageFile, true);
414 end;
[15]415 end;
416
[226]417
418 procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
[15]419 begin
[226]420 if g_LanguageUpdateCallbacks = nil then
[15]421 begin
[226]422 g_LanguageUpdateCallbacks := TList.Create;
[15]423 end;
[226]424
425 g_LanguageUpdateCallbacks.Add(TObject(aCallbackProc));
426 // since this is for when updating a language only, we don't immediately call it
[15]427 end;
428
429
[226]430 procedure ApplyLanguage(aLanguage: TLanguageFile);
431 var
432 i: longint;
433 tmpCallback: TLanguageCallback;
[15]434 begin
[226]435 if g_CurrentLanguageFile <> nil then
[15]436 begin
[226]437 g_CurrentLanguageFile.Destroy;
[15]438 end;
439
[226]440 g_CurrentLanguageFile := aLanguage;
[15]441
[226]442 // do language callbacks to everyone
443 for i := 0 to g_LanguageCallbacks.Count - 1 do
444 begin
445 tmpCallback := g_LanguageCallbacks[i];
[15]446
[226]447 if Assigned(tmpCallback.FCallbackMethod) then
448 begin
449 tmpCallback.FCallbackMethod(g_CurrentLanguageFile, true);
450 end;
[15]451
[226]452 if Assigned(tmpCallback.FCallbackProc) then
453 begin
454 tmpCallback.FCallbackProc(g_CurrentLanguageFile, true);
455 end;
456 end;
457 end;
[15]458
459
[226]460 procedure UpdateLanguage(aLanguage: TLanguageFile);
461 var
462 i: longint;
463 tmpCallback : TLanguageCallback;
464 tmpUpdateProc : TProcedure;
465 begin
466 if g_LanguageUpdateCallbacks <> nil then
467 begin
468 // first call all update callbacks so dynamically created
469 // things can be loaded (i.e. forms)
470 // Note: this will cause them to load their strings from
471 // the current language if any. This is fine, necessary even.
472 for i := 0 to g_LanguageUpdateCallbacks.Count - 1 do
473 begin
474 tmpUpdateProc := TProcedure(g_LanguageUpdateCallbacks[i]);
475 tmpUpdateProc;
476 end;
477 end;
[15]478
[226]479 if g_LanguageCallbacks <> nil then
480 begin
481 // now call the language events
482 for i := 0 to g_LanguageCallbacks.Count - 1 do
483 begin
484 tmpCallback := g_LanguageCallbacks[i];
485 if Assigned(tmpCallback.FCallbackMethod) then
486 begin
487 tmpCallback.FCallbackMethod(aLanguage, false);
488 end;
489 if Assigned(tmpCallback.FCallbackProc) then
490 begin
491 tmpCallback.FCallbackProc(aLanguage, false);
492 end;
493 end;
494 end;
495 end;
[15]496
[220]497
[226]498 constructor TLanguageFile.Create( const aFileName : String);
499 var
500 tmpTextFile : TextFile;
[15]501 begin
[226]502 filename := aFileName;
[15]503
[226]504 languageItems := TLanguageItemList.Create;
[15]505
[226]506 if not FileExists(aFileName) then
[15]507 begin
[226]508 exit;
509 end;
[220]510
[226]511 // read the file
512 FileMode := fmInput;
513 AssignFile(tmpTextFile, aFileName);
514 Reset(tmpTextFile);
515
[249]516 languageItems.readFrom(tmpTextFile);
[226]517
518 CloseFile(tmpTextFile);
[15]519 end;
520
521
[226]522 destructor TLanguageFile.Destroy;
[15]523 begin
[226]524 languageItems.Destroy;
[15]525 end;
526
527
[226]528 procedure TLanguageFile.LL( const anApplyFlag: boolean;
529 Var aValue: string;
530 const aLabel: string;
531 const aDefaultValue: string );
532 begin
[254]533 // LogEvent(LogI18n, 'TLanguageFile.LL(' + BoolToStr(anApplyFlag) + ' "' + aLabel + '" "' + aDefaultValue +'")');
[15]534
[226]535 if anApplyFlag then
536 begin
[254]537 aValue := languageItems.getValue(aLabel, aDefaultValue);
538 if '' = aValue then
539 begin
540 aValue := aDefaultValue;
541 end
[226]542 end
543 else
544 begin
[231]545 languageItems.getValue(aLabel, aDefaultValue)
[226]546 end
547 end;
[15]548
549
[226]550 procedure TLanguageFile.LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
551 begin
552 LoadComponentLanguageInternal(aComponent, '', anApplyFlag);
553 end;
[15]554
555
[226]556 procedure TLanguageFile.writeToFile(const aFileName : String);
557 var
558 tmpBackupFilename: string;
559 tmpFile: TextFile;
[15]560 begin
[226]561 tmpBackupFilename := ChangeFileExt(aFileName, '.bak' );
562 if FileExists(tmpBackupFilename) then
[15]563 begin
[226]564 if not DeleteFile(tmpBackupFilename) then
[15]565 begin
[226]566 raise Exception.Create( 'Unable to delete backup language file: ' + tmpBackupFilename);
[15]567 end;
[226]568 end;
[15]569
[226]570 if FileExists(aFileName) then
571 begin
572 if not CopyFile(aFileName, tmpBackupFilename ) then
573 begin
574 raise Exception.Create( 'Unable to copy to backup language file: ' + tmpBackupFilename);
575 end;
[15]576 end;
[226]577
578 AssignFile(tmpFile, aFileName);
579 ReWrite(tmpFile);
580
581 languageItems.saveTo(tmpFile);
582
583 CloseFile(tmpFile);
[15]584 end;
585
[226]586 procedure TLanguageFile.LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
587 var
588 i : longint;
589 tmpComponentPath: string;
590 tmpValue: string;
[15]591
[226]592 tmpMenuItem: TMenuItem;
593 tmpButton: TButton;
594 tmpLabel: TLabel;
595 tmpRadioGroup: TRadioGroup;
596 tmpTabSet: TTabSet;
597 tmpTabbedNotebook: TTabbedNotebook;
598 tmpForm: TForm;
599 tmpRadioButton: TRadioButton;
600 tmpCheckBox: TCheckBox;
601 tmpCoolBar2: TCoolBar2;
602 tmpGroupBox: TGroupBox;
603 tmpMultiColumnListBox: TMultiColumnListBox;
604 tmpSystemOpenDialog: TSystemOpenDialog;
605 tmpSystemSaveDialog: TSystemSaveDialog;
606 Begin
607 tmpComponentPath := aPath + aComponent.Name + LANGUAGE_LABEL_DELIMITER;
[15]608
[226]609 // Components sorted with most common at top, ish...
610 if aComponent is TMenuItem then
611 begin
612 tmpMenuItem := TMenuItem(aComponent);
[15]613
[226]614 // skip separators
615 if tmpMenuItem.Caption <> '-' then
616 begin
[231]617 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpMenuItem.Caption);
[226]618 if '' <> tmpValue then tmpMenuItem.Caption := tmpValue;
[15]619
[231]620 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpMenuItem.Hint);
[226]621 if '' <> tmpValue then tmpMenuItem.Hint := tmpValue;
622 end;
623 end
[15]624
[226]625 else if aComponent is TButton then
626 begin
627 tmpButton := TButton(aComponent);
[15]628
[231]629 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpButton.Caption);
[226]630 if '' <> tmpValue then tmpButton.Caption := tmpValue;
631
[231]632 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpButton.Hint);
[226]633 if '' <> tmpValue then tmpButton.Hint := tmpValue;
634 end
635
636 else if aComponent is TLabel then
[15]637 begin
[226]638 tmpLabel := TLabel(aComponent);
639
[231]640 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpLabel.Caption);
[226]641 if '' <> tmpValue then tmpLabel.Caption := tmpValue;
642
[231]643 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpLabel.Hint);
[226]644 if '' <> tmpValue then tmpLabel.Hint := tmpValue;
[15]645 end
[226]646
647 else if aComponent is TRadioGroup then
[15]648 begin
[226]649 tmpRadioGroup := TRadioGroup(aComponent);
[15]650
[231]651 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioGroup.Caption);
[226]652 if '' <> tmpValue then tmpRadioGroup.Caption := tmpValue;
[15]653
[226]654 for i := 0 to tmpRadioGroup.Items.Count - 1 do
655 begin
[231]656 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpRadioGroup.Items[i]);
[226]657 if '' <> tmpValue then tmpRadioGroup.Items[i] := tmpValue;
658 end;
659 end
[15]660
[226]661 else if aComponent is TTabSet then
662 begin
663 tmpTabSet := TTabSet(aComponent);
[15]664
[226]665 for i := 0 to tmpTabSet.Tabs.Count - 1 do
666 begin
[231]667 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i), tmpTabSet.Tabs[i]);
[226]668 if '' <> tmpValue then tmpTabSet.Tabs[i] := tmpValue;
669 end;
670 end
671
672 else if aComponent is TTabbedNotebook then
[15]673 begin
[226]674 tmpTabbedNotebook := TTabbedNotebook(aComponent);
675 for i := 0 to tmpTabbedNotebook.Pages.Count - 1 do
676 begin
[231]677 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Caption', tmpTabbedNotebook.Pages[i]);
[226]678 if '' <> tmpValue then tmpTabbedNotebook.Pages[i] := tmpValue;
[15]679
[231]680 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Hint', tmpTabbedNotebook.Pages.Pages[i].Hint);
[226]681 if '' <> tmpValue then tmpTabbedNotebook.Pages.Pages[i].Hint := tmpValue;
682 end;
683 end
[15]684
[226]685 else if aComponent is TForm then
686 begin
687 tmpForm := TForm(aComponent);
[15]688
[231]689 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpForm.Caption);
[226]690 if '' <> tmpValue then tmpForm.Caption := tmpValue;
[15]691
[226]692 // load owned controls
693 for i := 0 to aComponent.ComponentCount - 1 do
694 begin
695 LoadComponentLanguageInternal(aComponent.Components[i], tmpComponentPath, aDoUpdates );
696 end;
697 end
[15]698
[226]699 else if aComponent is TRadioButton then
[15]700 begin
[226]701 tmpRadioButton := TRadioButton(aComponent);
[15]702
[231]703 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioButton.Caption);
[226]704 if '' <> tmpValue then tmpRadioButton.Caption := tmpValue;
[15]705
[231]706 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpRadioButton.Hint);
[226]707 if '' <> tmpValue then tmpRadioButton.Hint := tmpValue;
708 end
[15]709
[226]710 else if aComponent is TCheckBox then
711 begin
712 tmpCheckBox := TCheckBox(aComponent);
[15]713
[231]714 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpCheckBox.Caption);
[226]715 if '' <> tmpValue then tmpCheckBox.Caption := tmpValue;
[15]716
[231]717 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpCheckBox.Hint);
[226]718 if '' <> tmpValue then tmpCheckBox.Hint := tmpValue;
719 end
[15]720
[226]721 else if aComponent is TCoolBar2 then
722 begin
723 tmpCoolBar2 := TCoolBar2(aComponent);
724 for i := 0 to tmpCoolBar2.Sections.Count - 1 do
725 begin
[231]726 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpCoolBar2.Sections[i].Text);
[226]727 if '' <> tmpValue then tmpCoolBar2.Sections[i].Text := tmpValue;
728 end;
729 end
[15]730
[226]731 else if aComponent is TGroupBox then
[15]732 begin
[226]733 tmpGroupBox := TGroupBox(aComponent);
[15]734
[231]735 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpGroupBox.Caption);
[226]736 if '' <> tmpValue then tmpGroupBox.Caption := tmpValue;
[15]737
[231]738 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpGroupBox.Hint);
[226]739 if '' <> tmpValue then tmpGroupBox.Hint := tmpValue;
740 end
[15]741
[226]742 else if aComponent is TMultiColumnListBox then
743 begin
744 tmpMultiColumnListBox := TMultiColumnListBox(aComponent);
[15]745
[226]746 for i := 0 to tmpMultiColumnListBox.HeaderColumns.Count - 1 do
747 begin
[231]748 tmpValue := languageItems.getValue(tmpComponentPath + 'Column' + IntToStr(i), tmpMultiColumnListBox.HeaderColumns[i].Text);
[226]749 if '' <> tmpValue then tmpMultiColumnListBox.HeaderColumns[i].Text := tmpValue;
750 end;
751 end
[15]752
[226]753 else if aComponent is TSystemOpenDialog then
754 begin
755 tmpSystemOpenDialog := TSystemOpenDialog(aComponent);
[15]756
[231]757 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemOpenDialog.OKName);
[226]758 if '' <> tmpValue then tmpSystemOpenDialog.OKName := tmpValue;
[15]759
[231]760 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemOpenDialog.Title);
[226]761 if '' <> tmpValue then tmpSystemOpenDialog.Title := tmpValue;
[15]762 end
763
[226]764 else if aComponent is TSystemSaveDialog then
765 begin
766 tmpSystemSaveDialog := TSystemSaveDialog(aComponent);
[15]767
[231]768 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemSaveDialog.OKName);
[226]769 if '' <> tmpValue then tmpSystemSaveDialog.OKName := tmpValue;
[15]770
[231]771 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemSaveDialog.Title);
[226]772 if '' <> tmpValue then tmpSystemSaveDialog.Title := tmpValue;
773 end;
774 end;
[15]775
776
[226]777 procedure LoadLanguage(const aFilePath: String);
778 var
779 tmpNewLanguage: TLanguageFile;
[15]780 begin
[226]781 LogEvent(LogI18n, 'LoadLanguage(' + aFilePath + ')');
782 try
783 tmpNewLanguage := TLanguageFile.Create(aFilePath);
784 except
785 // TODO more log output
[15]786 exit;
787 end;
788
[226]789 ApplyLanguage(tmpNewLanguage);
[15]790 end;
791
792
[226]793 function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string) : boolean;
794 var
795 tmpFilePath: string;
796 tmpFileName: string;
797 tmpOSDir: string;
[15]798 begin
[226]799 // Filenames loaded will be <AppName>.<Language>.lng
800 tmpFilename := anAppName + LANGUAGE_DELIMITER + aLanguageSpec + LANGUAGE_FILE_EXTENSION;
[15]801
[226]802 // eCS 1.1+ look in x:\ecs\lang
803 tmpOSDir := GetEnv(LANGUAGE_ENVIRONMENT_VAR_OSDIR);
804 if tmpOSDir <> '' then
805 begin
806 tmpFilePath := AddDirectorySeparator(tmpOSDir) + 'lang\' + tmpFileName;
807 if FileExists(tmpFilePath) then
808 begin
809 LoadLanguage(tmpFilePath);
810 result := true;
811 exit;
812 end;
813 end;
[15]814
[226]815 // something or rather, maybe: look in %ULSPATH%
816 if SearchPath(LANGUAGE_ENVIRONMENT_VAR_ULSPATH, tmpFilename, tmpFilepath ) then
817 begin
818 LoadLanguage(tmpFilePath);
819 result := true;
820 exit;
821 end;
[220]822
[226]823 // Standalone/compatibility: look in own dir
824 tmpFilePath := GetApplicationDir + tmpFileName;
[15]825
[226]826 if FileExists(tmpFilePath) then
827 begin
828 LoadLanguage(tmpFilePath);
829 result := true;
830 exit;
831 end;
832
833 result := false;
[220]834 end;
[15]835
836
[226]837 Procedure LoadDefaultLanguage(const anAppName: string);
838 var
839 tmpLanguageVar: string;
840 tmpMajorLanguage: string;
841 tmpMinorLanguage: string;
842 tmpParts : TStringList;
843
[220]844 begin
[226]845 tmpLanguageVar := GetEnv(LANGUAGE_ENVIRONMENT_VAR_LANG);
846 LogEvent(LogI18n, LANGUAGE_ENVIRONMENT_VAR_LANG + '=' + tmpLanguageVar);
[15]847
[226]848 if tmpLanguageVar = '' then
849 begin
850 tmpLanguageVar := DEFAULT_LANGUAGE;
851 end;
[15]852
[226]853 tmpParts := TStringList.Create;
854 StrExtractStrings(tmpParts, tmpLanguageVar, ['_'], #0);
[220]855
[226]856 tmpMajorLanguage := '';
857 if tmpParts.count > 0 then
[15]858 begin
[226]859 tmpMajorLanguage := tmpParts[0];
860 end;
861
862 // note there might be some other stuff on the end of LANG
863 // such as ES_ES_EURO...
864
865 if tmpParts.count > 1 then
866 begin
867 tmpMinorLanguage := tmpParts[1];
868
869 LogEvent(LogI18n, 'try loading ' + tmpMajorLanguage + '_' + tmpMinorLanguage);
870 if LoadLanguageForSpec(anAppName, tmpMajorLanguage + '_' + tmpMinorLanguage) then
871 begin
872 // found a specifc language
873 LogEvent(LogI18n, ' translation for ' + tmpMajorLanguage + '_' + tmpMinorLanguage + ' sucessfully loaded');
874 tmpParts.Destroy;
875 exit;
876 end;
877 end;
878
879 // try generic language?
880 LogEvent(LogI18n, 'try loading (major only) ' + tmpMajorLanguage);
881 if LoadLanguageForSpec(anAppName, tmpMajorLanguage) then
882 begin
883 LogEvent(LogI18n, 'translation for ''' + tmpMajorLanguage + ''' sucessfully loaded');
[220]884 tmpParts.Destroy;
[15]885 exit;
886 end;
887
[226]888 LogEvent(LogI18n, 'No language found, using default ' + tmpMajorLanguage);
889 LoadLanguage('');
890
891 tmpParts.Destroy;
[15]892 end;
893
[220]894
[226]895 Initialization
896 g_LanguageCallbacks := nil;
897 g_CurrentLanguageFile := nil;
898 g_LanguageUpdateCallbacks := nil;
[15]899
[220]900
[226]901 Finalization
902 DestroyListAndObjects(g_LanguageUpdateCallbacks);
903 DestroyListAndObjects(g_LanguageCallbacks);
904 if nil <> g_CurrentLanguageFile then g_CurrentLanguageFile.Destroy;
[15]905
[226]906End.
Note: See TracBrowser for help on using the repository browser.