source: branches/2.20_branch/Components/ACLLanguageUnit.pas@ 471

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

i18n fix
  • Property svn:eol-style set to native
File size: 25.8 KB
Line 
1Unit ACLLanguageUnit;
2
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
10Interface
11
12uses
13 OS2Def,
14 Classes,
15 Forms,
16 FileUtilsUnit;
17
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
31type
32 TLanguageItem = record
33 pLabel: pString;
34 pValue: pString;
35 wasUsed: boolean;
36 isDefault: boolean;
37 end;
38 TPLanguageItem = ^TLanguageItem;
39
40 TLanguageItemList = class
41 protected
42 translationsList : TStringList;
43 procedure setValueWithFlags(const aLabel : String; const aValue : String; const aDefaultFlag : boolean);
44 public
45 constructor Create;
46 destructor Destroy; override;
47
48 function getValue(const aLabel : String; const aDefaultValue : String) : String;
49 procedure setValue(const aLabel : String; const aValue : String);
50 procedure readFrom(aTextFile : TextFile);
51 procedure saveTo(const aTextFile : TextFile);
52 end;
53
54
55 TLanguageFile = class
56 protected
57 languageItems : TLanguageItemList;
58 fileName: string;
59
60 procedure LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
61
62 public
63 constructor Create(const aFileName : String);
64 destructor Destroy; override;
65
66 // if anApplyFlag is true, then the component and it's
67 // owned components will be updated. If false, then
68 // it will only be checked and missing items noted.
69
70 // For convenience in loading strings manually, related to the component
71 procedure LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
72
73
74 // write the current transations to a file
75 procedure writeToFile(const aFileName : String);
76
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 );
85
86 end;
87
88
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
94 TLanguageEvent = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean) of object;
95
96 // non-object version
97 TLanguageProc = procedure(aLanguage: TLanguageFile; const anApplyFlag: boolean);
98
99
100var
101 g_CurrentLanguageFile: TLanguageFile;
102
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);
106
107 // Register a procedure callback (not-object)
108 procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
109
110
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);
114
115
116 // Change current language to given, and tell everybody who has registered
117 procedure ApplyLanguage(aLanguage: TLanguageFile);
118
119 // Tell everybody who has registered to access the given file,
120 // but don't apply strings from it
121 procedure UpdateLanguage(aLanguage: TLanguageFile);
122
123
124 // Load and apply specified language file
125 procedure LoadLanguage(const aFilePath: String);
126
127
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;
132
133
134 // load default language based on LANG environment var
135 procedure LoadDefaultLanguage(const anAppName: string);
136
137
138Implementation
139
140uses
141 Dos, SysUtils,
142 StdCtrls,
143 Buttons,
144 ExtCtrls,
145 TabCtrls,
146 Dialogs,
147 Coolbar2,
148 Multicolumnlistbox,
149 ACLUtility,
150 FileUtilsUnit,
151 StringUtilsUnit,
152 DebugUnit;
153
154var
155 g_LanguageCallbacks: TList;
156 g_LanguageUpdateCallbacks: TList;
157
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
185 DisposeStr(tmpPLanguageItem^.pLabel);
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);
242 tmpPLanguageItem^.pLabel := NewStr(aLabel);
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
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
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
304 tmpLabel := tmpPLanguageItem^.pLabel^;
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
339 tmpLabel := tmpPLanguageItem^.pLabel^;
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
362Type
363 TLanguageCallback = class
364 FCallbackMethod: TLanguageEvent;
365 FCallbackProc: TLanguageProc;
366 constructor CreateMethod( CallbackMethod: TLanguageEvent );
367 constructor CreateProc( CallbackProc: TLanguageProc );
368 end;
369
370
371 constructor TLanguageCallback.CreateMethod(CallbackMethod: TLanguageEvent);
372 begin
373 FCallbackMethod := CallbackMethod;
374 FCallbackProc := nil;
375 end;
376
377
378 constructor TLanguageCallback.CreateProc(aCallbackProc: TLanguageProc);
379 begin
380 FCallbackProc := CallbackProc;
381 FCallbackMethod := nil;
382 end;
383
384
385 procedure AddLanguageCallback(aCallbackObject: TLanguageCallback);
386 begin
387 if g_LanguageCallbacks = nil then
388 begin
389 g_LanguageCallbacks := TList.Create;
390 end;
391
392 g_LanguageCallbacks.Add(aCallbackObject);
393 end;
394
395
396 procedure RegisterEventForLanguages(aCallbackEvent : TLanguageEvent);
397 begin
398 AddLanguageCallback( TLanguageCallback.CreateMethod(aCallbackEvent) );
399
400 if g_CurrentLanguageFile <> nil then
401 begin
402 aCallbackEvent(g_CurrentLanguageFile, true);
403 end;
404 end;
405
406
407 procedure RegisterProcForLanguages(aCallbackProc : TLanguageProc);
408 begin
409 AddLanguageCallback( TLanguageCallback.CreateProc(aCallbackProc) );
410
411 if g_CurrentLanguageFile <> nil then
412 begin
413 aCallbackProc(g_CurrentLanguageFile, true);
414 end;
415 end;
416
417
418 procedure RegisterUpdateProcForLanguages(aCallbackProc: TProcedure);
419 begin
420 if g_LanguageUpdateCallbacks = nil then
421 begin
422 g_LanguageUpdateCallbacks := TList.Create;
423 end;
424
425 g_LanguageUpdateCallbacks.Add(TObject(aCallbackProc));
426 // since this is for when updating a language only, we don't immediately call it
427 end;
428
429
430 procedure ApplyLanguage(aLanguage: TLanguageFile);
431 var
432 i: longint;
433 tmpCallback: TLanguageCallback;
434 begin
435 if g_CurrentLanguageFile <> nil then
436 begin
437 g_CurrentLanguageFile.Destroy;
438 end;
439
440 g_CurrentLanguageFile := aLanguage;
441
442 // do language callbacks to everyone
443 for i := 0 to g_LanguageCallbacks.Count - 1 do
444 begin
445 tmpCallback := g_LanguageCallbacks[i];
446
447 if Assigned(tmpCallback.FCallbackMethod) then
448 begin
449 tmpCallback.FCallbackMethod(g_CurrentLanguageFile, true);
450 end;
451
452 if Assigned(tmpCallback.FCallbackProc) then
453 begin
454 tmpCallback.FCallbackProc(g_CurrentLanguageFile, true);
455 end;
456 end;
457 end;
458
459
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;
478
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;
496
497
498 constructor TLanguageFile.Create( const aFileName : String);
499 var
500 tmpTextFile : TextFile;
501 begin
502 filename := aFileName;
503
504 languageItems := TLanguageItemList.Create;
505
506 if not FileExists(aFileName) then
507 begin
508 exit;
509 end;
510
511 // read the file
512 FileMode := fmInput;
513 AssignFile(tmpTextFile, aFileName);
514 Reset(tmpTextFile);
515
516 languageItems.readFrom(tmpTextFile);
517
518 CloseFile(tmpTextFile);
519 end;
520
521
522 destructor TLanguageFile.Destroy;
523 begin
524 languageItems.Destroy;
525 end;
526
527
528 procedure TLanguageFile.LL( const anApplyFlag: boolean;
529 Var aValue: string;
530 const aLabel: string;
531 const aDefaultValue: string );
532 begin
533 // LogEvent(LogI18n, 'TLanguageFile.LL(' + BoolToStr(anApplyFlag) + ' "' + aLabel + '" "' + aDefaultValue +'")');
534
535 if anApplyFlag then
536 begin
537 aValue := languageItems.getValue(aLabel, aDefaultValue);
538 if '' = aValue then
539 begin
540 aValue := aDefaultValue;
541 end
542 end
543 else
544 begin
545 languageItems.getValue(aLabel, aDefaultValue)
546 end
547 end;
548
549
550 procedure TLanguageFile.LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
551 begin
552 LoadComponentLanguageInternal(aComponent, '', anApplyFlag);
553 end;
554
555
556 procedure TLanguageFile.writeToFile(const aFileName : String);
557 var
558 tmpBackupFilename: string;
559 tmpFile: TextFile;
560 begin
561 tmpBackupFilename := ChangeFileExt(aFileName, '.bak' );
562 if FileExists(tmpBackupFilename) then
563 begin
564 if not DeleteFile(tmpBackupFilename) then
565 begin
566 raise Exception.Create( 'Unable to delete backup language file: ' + tmpBackupFilename);
567 end;
568 end;
569
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;
576 end;
577
578 AssignFile(tmpFile, aFileName);
579 ReWrite(tmpFile);
580
581 languageItems.saveTo(tmpFile);
582
583 CloseFile(tmpFile);
584 end;
585
586 procedure TLanguageFile.LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
587 var
588 i : longint;
589 tmpComponentPath: string;
590 tmpValue: string;
591
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;
608
609 // Components sorted with most common at top, ish...
610 if aComponent is TMenuItem then
611 begin
612 tmpMenuItem := TMenuItem(aComponent);
613
614 // skip separators
615 if tmpMenuItem.Caption <> '-' then
616 begin
617 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpMenuItem.Caption);
618 if '' <> tmpValue then tmpMenuItem.Caption := tmpValue;
619
620 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpMenuItem.Hint);
621 if '' <> tmpValue then tmpMenuItem.Hint := tmpValue;
622 end;
623 end
624
625 else if aComponent is TButton then
626 begin
627 tmpButton := TButton(aComponent);
628
629 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpButton.Caption);
630 if '' <> tmpValue then tmpButton.Caption := tmpValue;
631
632 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpButton.Hint);
633 if '' <> tmpValue then tmpButton.Hint := tmpValue;
634 end
635
636 else if aComponent is TLabel then
637 begin
638 tmpLabel := TLabel(aComponent);
639
640 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpLabel.Caption);
641 if '' <> tmpValue then tmpLabel.Caption := tmpValue;
642
643 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpLabel.Hint);
644 if '' <> tmpValue then tmpLabel.Hint := tmpValue;
645 end
646
647 else if aComponent is TRadioGroup then
648 begin
649 tmpRadioGroup := TRadioGroup(aComponent);
650
651 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioGroup.Caption);
652 if '' <> tmpValue then tmpRadioGroup.Caption := tmpValue;
653
654 for i := 0 to tmpRadioGroup.Items.Count - 1 do
655 begin
656 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpRadioGroup.Items[i]);
657 if '' <> tmpValue then tmpRadioGroup.Items[i] := tmpValue;
658 end;
659 end
660
661 else if aComponent is TTabSet then
662 begin
663 tmpTabSet := TTabSet(aComponent);
664
665 for i := 0 to tmpTabSet.Tabs.Count - 1 do
666 begin
667 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i), tmpTabSet.Tabs[i]);
668 if '' <> tmpValue then tmpTabSet.Tabs[i] := tmpValue;
669 end;
670 end
671
672 else if aComponent is TTabbedNotebook then
673 begin
674 tmpTabbedNotebook := TTabbedNotebook(aComponent);
675 for i := 0 to tmpTabbedNotebook.Pages.Count - 1 do
676 begin
677 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Caption', tmpTabbedNotebook.Pages[i]);
678 if '' <> tmpValue then tmpTabbedNotebook.Pages[i] := tmpValue;
679
680 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Hint', tmpTabbedNotebook.Pages.Pages[i].Hint);
681 if '' <> tmpValue then tmpTabbedNotebook.Pages.Pages[i].Hint := tmpValue;
682 end;
683 end
684
685 else if aComponent is TForm then
686 begin
687 tmpForm := TForm(aComponent);
688
689 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpForm.Caption);
690 if '' <> tmpValue then tmpForm.Caption := tmpValue;
691
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
698
699 else if aComponent is TRadioButton then
700 begin
701 tmpRadioButton := TRadioButton(aComponent);
702
703 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioButton.Caption);
704 if '' <> tmpValue then tmpRadioButton.Caption := tmpValue;
705
706 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpRadioButton.Hint);
707 if '' <> tmpValue then tmpRadioButton.Hint := tmpValue;
708 end
709
710 else if aComponent is TCheckBox then
711 begin
712 tmpCheckBox := TCheckBox(aComponent);
713
714 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpCheckBox.Caption);
715 if '' <> tmpValue then tmpCheckBox.Caption := tmpValue;
716
717 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpCheckBox.Hint);
718 if '' <> tmpValue then tmpCheckBox.Hint := tmpValue;
719 end
720
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
726 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpCoolBar2.Sections[i].Text);
727 if '' <> tmpValue then tmpCoolBar2.Sections[i].Text := tmpValue;
728 end;
729 end
730
731 else if aComponent is TGroupBox then
732 begin
733 tmpGroupBox := TGroupBox(aComponent);
734
735 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpGroupBox.Caption);
736 if '' <> tmpValue then tmpGroupBox.Caption := tmpValue;
737
738 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpGroupBox.Hint);
739 if '' <> tmpValue then tmpGroupBox.Hint := tmpValue;
740 end
741
742 else if aComponent is TMultiColumnListBox then
743 begin
744 tmpMultiColumnListBox := TMultiColumnListBox(aComponent);
745
746 for i := 0 to tmpMultiColumnListBox.HeaderColumns.Count - 1 do
747 begin
748 tmpValue := languageItems.getValue(tmpComponentPath + 'Column' + IntToStr(i), tmpMultiColumnListBox.HeaderColumns[i].Text);
749 if '' <> tmpValue then tmpMultiColumnListBox.HeaderColumns[i].Text := tmpValue;
750 end;
751 end
752
753 else if aComponent is TSystemOpenDialog then
754 begin
755 tmpSystemOpenDialog := TSystemOpenDialog(aComponent);
756
757 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemOpenDialog.OKName);
758 if '' <> tmpValue then tmpSystemOpenDialog.OKName := tmpValue;
759
760 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemOpenDialog.Title);
761 if '' <> tmpValue then tmpSystemOpenDialog.Title := tmpValue;
762 end
763
764 else if aComponent is TSystemSaveDialog then
765 begin
766 tmpSystemSaveDialog := TSystemSaveDialog(aComponent);
767
768 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemSaveDialog.OKName);
769 if '' <> tmpValue then tmpSystemSaveDialog.OKName := tmpValue;
770
771 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemSaveDialog.Title);
772 if '' <> tmpValue then tmpSystemSaveDialog.Title := tmpValue;
773 end;
774 end;
775
776
777 procedure LoadLanguage(const aFilePath: String);
778 var
779 tmpNewLanguage: TLanguageFile;
780 begin
781 LogEvent(LogI18n, 'LoadLanguage(' + aFilePath + ')');
782 try
783 tmpNewLanguage := TLanguageFile.Create(aFilePath);
784 except
785 // TODO more log output
786 exit;
787 end;
788
789 ApplyLanguage(tmpNewLanguage);
790 end;
791
792
793 function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string) : boolean;
794 var
795 tmpFilePath: string;
796 tmpFileName: string;
797 tmpOSDir: string;
798 begin
799 // Filenames loaded will be <AppName>.<Language>.lng
800 tmpFilename := anAppName + LANGUAGE_DELIMITER + aLanguageSpec + LANGUAGE_FILE_EXTENSION;
801
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;
814
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;
822
823 // Standalone/compatibility: look in own dir
824 tmpFilePath := GetApplicationDir + tmpFileName;
825
826 if FileExists(tmpFilePath) then
827 begin
828 LoadLanguage(tmpFilePath);
829 result := true;
830 exit;
831 end;
832
833 result := false;
834 end;
835
836
837 Procedure LoadDefaultLanguage(const anAppName: string);
838 var
839 tmpLanguageVar: string;
840 tmpMajorLanguage: string;
841 tmpMinorLanguage: string;
842 tmpParts : TStringList;
843
844 begin
845 tmpLanguageVar := GetEnv(LANGUAGE_ENVIRONMENT_VAR_LANG);
846 LogEvent(LogI18n, LANGUAGE_ENVIRONMENT_VAR_LANG + '=' + tmpLanguageVar);
847
848 if tmpLanguageVar = '' then
849 begin
850 tmpLanguageVar := DEFAULT_LANGUAGE;
851 end;
852
853 tmpParts := TStringList.Create;
854 StrExtractStrings(tmpParts, tmpLanguageVar, ['_'], #0);
855
856 tmpMajorLanguage := '';
857 if tmpParts.count > 0 then
858 begin
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');
884 tmpParts.Destroy;
885 exit;
886 end;
887
888 LogEvent(LogI18n, 'No language found, using default ' + tmpMajorLanguage);
889 LoadLanguage('');
890
891 tmpParts.Destroy;
892 end;
893
894
895 Initialization
896 g_LanguageCallbacks := nil;
897 g_CurrentLanguageFile := nil;
898 g_LanguageUpdateCallbacks := nil;
899
900
901 Finalization
902 DestroyListAndObjects(g_LanguageUpdateCallbacks);
903 DestroyListAndObjects(g_LanguageCallbacks);
904 if nil <> g_CurrentLanguageFile then g_CurrentLanguageFile.Destroy;
905
906End.
Note: See TracBrowser for help on using the repository browser.