source: trunk/Components/ACLLanguageUnit.pas@ 249

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

#24
  • Property svn:eol-style set to native
File size: 25.7 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(Apply) + ')');
534
535 if anApplyFlag then
536 begin
537 aValue := languageItems.getValue(aLabel, aDefaultValue)
538 end
539 else
540 begin
541 languageItems.getValue(aLabel, aDefaultValue)
542 end
543 end;
544
545
546 procedure TLanguageFile.LoadComponentLanguage(aComponent: TComponent; const anApplyFlag: boolean);
547 begin
548 LoadComponentLanguageInternal(aComponent, '', anApplyFlag);
549 end;
550
551
552 procedure TLanguageFile.writeToFile(const aFileName : String);
553 var
554 tmpBackupFilename: string;
555 tmpFile: TextFile;
556 begin
557 tmpBackupFilename := ChangeFileExt(aFileName, '.bak' );
558 if FileExists(tmpBackupFilename) then
559 begin
560 if not DeleteFile(tmpBackupFilename) then
561 begin
562 raise Exception.Create( 'Unable to delete backup language file: ' + tmpBackupFilename);
563 end;
564 end;
565
566 if FileExists(aFileName) then
567 begin
568 if not CopyFile(aFileName, tmpBackupFilename ) then
569 begin
570 raise Exception.Create( 'Unable to copy to backup language file: ' + tmpBackupFilename);
571 end;
572 end;
573
574 AssignFile(tmpFile, aFileName);
575 ReWrite(tmpFile);
576
577 languageItems.saveTo(tmpFile);
578
579 CloseFile(tmpFile);
580 end;
581
582 procedure TLanguageFile.LoadComponentLanguageInternal(const aComponent: TComponent; const aPath: string; const aDoUpdates: boolean);
583 var
584 i : longint;
585 tmpComponentPath: string;
586 tmpValue: string;
587
588 tmpMenuItem: TMenuItem;
589 tmpButton: TButton;
590 tmpLabel: TLabel;
591 tmpRadioGroup: TRadioGroup;
592 tmpTabSet: TTabSet;
593 tmpTabbedNotebook: TTabbedNotebook;
594 tmpForm: TForm;
595 tmpRadioButton: TRadioButton;
596 tmpCheckBox: TCheckBox;
597 tmpCoolBar2: TCoolBar2;
598 tmpGroupBox: TGroupBox;
599 tmpMultiColumnListBox: TMultiColumnListBox;
600 tmpSystemOpenDialog: TSystemOpenDialog;
601 tmpSystemSaveDialog: TSystemSaveDialog;
602 Begin
603 tmpComponentPath := aPath + aComponent.Name + LANGUAGE_LABEL_DELIMITER;
604
605 // Components sorted with most common at top, ish...
606 if aComponent is TMenuItem then
607 begin
608 tmpMenuItem := TMenuItem(aComponent);
609
610 // skip separators
611 if tmpMenuItem.Caption <> '-' then
612 begin
613 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpMenuItem.Caption);
614 if '' <> tmpValue then tmpMenuItem.Caption := tmpValue;
615
616 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpMenuItem.Hint);
617 if '' <> tmpValue then tmpMenuItem.Hint := tmpValue;
618 end;
619 end
620
621 else if aComponent is TButton then
622 begin
623 tmpButton := TButton(aComponent);
624
625 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpButton.Caption);
626 if '' <> tmpValue then tmpButton.Caption := tmpValue;
627
628 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpButton.Hint);
629 if '' <> tmpValue then tmpButton.Hint := tmpValue;
630 end
631
632 else if aComponent is TLabel then
633 begin
634 tmpLabel := TLabel(aComponent);
635
636 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpLabel.Caption);
637 if '' <> tmpValue then tmpLabel.Caption := tmpValue;
638
639 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpLabel.Hint);
640 if '' <> tmpValue then tmpLabel.Hint := tmpValue;
641 end
642
643 else if aComponent is TRadioGroup then
644 begin
645 tmpRadioGroup := TRadioGroup(aComponent);
646
647 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioGroup.Caption);
648 if '' <> tmpValue then tmpRadioGroup.Caption := tmpValue;
649
650 for i := 0 to tmpRadioGroup.Items.Count - 1 do
651 begin
652 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpRadioGroup.Items[i]);
653 if '' <> tmpValue then tmpRadioGroup.Items[i] := tmpValue;
654 end;
655 end
656
657 else if aComponent is TTabSet then
658 begin
659 tmpTabSet := TTabSet(aComponent);
660
661 for i := 0 to tmpTabSet.Tabs.Count - 1 do
662 begin
663 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i), tmpTabSet.Tabs[i]);
664 if '' <> tmpValue then tmpTabSet.Tabs[i] := tmpValue;
665 end;
666 end
667
668 else if aComponent is TTabbedNotebook then
669 begin
670 tmpTabbedNotebook := TTabbedNotebook(aComponent);
671 for i := 0 to tmpTabbedNotebook.Pages.Count - 1 do
672 begin
673 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Caption', tmpTabbedNotebook.Pages[i]);
674 if '' <> tmpValue then tmpTabbedNotebook.Pages[i] := tmpValue;
675
676 tmpValue := languageItems.getValue(tmpComponentPath + 'Tab' + IntToStr(i) + '.Hint', tmpTabbedNotebook.Pages.Pages[i].Hint);
677 if '' <> tmpValue then tmpTabbedNotebook.Pages.Pages[i].Hint := tmpValue;
678 end;
679 end
680
681 else if aComponent is TForm then
682 begin
683 tmpForm := TForm(aComponent);
684
685 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpForm.Caption);
686 if '' <> tmpValue then tmpForm.Caption := tmpValue;
687
688 // load owned controls
689 for i := 0 to aComponent.ComponentCount - 1 do
690 begin
691 LoadComponentLanguageInternal(aComponent.Components[i], tmpComponentPath, aDoUpdates );
692 end;
693 end
694
695 else if aComponent is TRadioButton then
696 begin
697 tmpRadioButton := TRadioButton(aComponent);
698
699 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpRadioButton.Caption);
700 if '' <> tmpValue then tmpRadioButton.Caption := tmpValue;
701
702 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpRadioButton.Hint);
703 if '' <> tmpValue then tmpRadioButton.Hint := tmpValue;
704 end
705
706 else if aComponent is TCheckBox then
707 begin
708 tmpCheckBox := TCheckBox(aComponent);
709
710 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpCheckBox.Caption);
711 if '' <> tmpValue then tmpCheckBox.Caption := tmpValue;
712
713 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpCheckBox.Hint);
714 if '' <> tmpValue then tmpCheckBox.Hint := tmpValue;
715 end
716
717 else if aComponent is TCoolBar2 then
718 begin
719 tmpCoolBar2 := TCoolBar2(aComponent);
720 for i := 0 to tmpCoolBar2.Sections.Count - 1 do
721 begin
722 tmpValue := languageItems.getValue(tmpComponentPath + 'Item' + IntToStr(i), tmpCoolBar2.Sections[i].Text);
723 if '' <> tmpValue then tmpCoolBar2.Sections[i].Text := tmpValue;
724 end;
725 end
726
727 else if aComponent is TGroupBox then
728 begin
729 tmpGroupBox := TGroupBox(aComponent);
730
731 tmpValue := languageItems.getValue(tmpComponentPath + 'Caption', tmpGroupBox.Caption);
732 if '' <> tmpValue then tmpGroupBox.Caption := tmpValue;
733
734 tmpValue := languageItems.getValue(tmpComponentPath + 'Hint', tmpGroupBox.Hint);
735 if '' <> tmpValue then tmpGroupBox.Hint := tmpValue;
736 end
737
738 else if aComponent is TMultiColumnListBox then
739 begin
740 tmpMultiColumnListBox := TMultiColumnListBox(aComponent);
741
742 for i := 0 to tmpMultiColumnListBox.HeaderColumns.Count - 1 do
743 begin
744 tmpValue := languageItems.getValue(tmpComponentPath + 'Column' + IntToStr(i), tmpMultiColumnListBox.HeaderColumns[i].Text);
745 if '' <> tmpValue then tmpMultiColumnListBox.HeaderColumns[i].Text := tmpValue;
746 end;
747 end
748
749 else if aComponent is TSystemOpenDialog then
750 begin
751 tmpSystemOpenDialog := TSystemOpenDialog(aComponent);
752
753 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemOpenDialog.OKName);
754 if '' <> tmpValue then tmpSystemOpenDialog.OKName := tmpValue;
755
756 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemOpenDialog.Title);
757 if '' <> tmpValue then tmpSystemOpenDialog.Title := tmpValue;
758 end
759
760 else if aComponent is TSystemSaveDialog then
761 begin
762 tmpSystemSaveDialog := TSystemSaveDialog(aComponent);
763
764 tmpValue := languageItems.getValue(tmpComponentPath + 'OKName', tmpSystemSaveDialog.OKName);
765 if '' <> tmpValue then tmpSystemSaveDialog.OKName := tmpValue;
766
767 tmpValue := languageItems.getValue(tmpComponentPath + 'Title', tmpSystemSaveDialog.Title);
768 if '' <> tmpValue then tmpSystemSaveDialog.Title := tmpValue;
769 end;
770 end;
771
772
773 procedure LoadLanguage(const aFilePath: String);
774 var
775 tmpNewLanguage: TLanguageFile;
776 begin
777 LogEvent(LogI18n, 'LoadLanguage(' + aFilePath + ')');
778 try
779 tmpNewLanguage := TLanguageFile.Create(aFilePath);
780 except
781 // TODO more log output
782 exit;
783 end;
784
785 ApplyLanguage(tmpNewLanguage);
786 end;
787
788
789 function LoadLanguageForSpec(const anAppName: string; const aLanguageSpec: string) : boolean;
790 var
791 tmpFilePath: string;
792 tmpFileName: string;
793 tmpOSDir: string;
794 begin
795 // Filenames loaded will be <AppName>.<Language>.lng
796 tmpFilename := anAppName + LANGUAGE_DELIMITER + aLanguageSpec + LANGUAGE_FILE_EXTENSION;
797
798 // eCS 1.1+ look in x:\ecs\lang
799 tmpOSDir := GetEnv(LANGUAGE_ENVIRONMENT_VAR_OSDIR);
800 if tmpOSDir <> '' then
801 begin
802 tmpFilePath := AddDirectorySeparator(tmpOSDir) + 'lang\' + tmpFileName;
803 if FileExists(tmpFilePath) then
804 begin
805 LoadLanguage(tmpFilePath);
806 result := true;
807 exit;
808 end;
809 end;
810
811 // something or rather, maybe: look in %ULSPATH%
812 if SearchPath(LANGUAGE_ENVIRONMENT_VAR_ULSPATH, tmpFilename, tmpFilepath ) then
813 begin
814 LoadLanguage(tmpFilePath);
815 result := true;
816 exit;
817 end;
818
819 // Standalone/compatibility: look in own dir
820 tmpFilePath := GetApplicationDir + tmpFileName;
821
822 if FileExists(tmpFilePath) then
823 begin
824 LoadLanguage(tmpFilePath);
825 result := true;
826 exit;
827 end;
828
829 result := false;
830 end;
831
832
833 Procedure LoadDefaultLanguage(const anAppName: string);
834 var
835 tmpLanguageVar: string;
836 tmpMajorLanguage: string;
837 tmpMinorLanguage: string;
838 tmpParts : TStringList;
839
840 begin
841 tmpLanguageVar := GetEnv(LANGUAGE_ENVIRONMENT_VAR_LANG);
842 LogEvent(LogI18n, LANGUAGE_ENVIRONMENT_VAR_LANG + '=' + tmpLanguageVar);
843
844 if tmpLanguageVar = '' then
845 begin
846 tmpLanguageVar := DEFAULT_LANGUAGE;
847 end;
848
849 tmpParts := TStringList.Create;
850 StrExtractStrings(tmpParts, tmpLanguageVar, ['_'], #0);
851
852 tmpMajorLanguage := '';
853 if tmpParts.count > 0 then
854 begin
855 tmpMajorLanguage := tmpParts[0];
856 end;
857
858 // note there might be some other stuff on the end of LANG
859 // such as ES_ES_EURO...
860
861 if tmpParts.count > 1 then
862 begin
863 tmpMinorLanguage := tmpParts[1];
864
865 LogEvent(LogI18n, 'try loading ' + tmpMajorLanguage + '_' + tmpMinorLanguage);
866 if LoadLanguageForSpec(anAppName, tmpMajorLanguage + '_' + tmpMinorLanguage) then
867 begin
868 // found a specifc language
869 LogEvent(LogI18n, ' translation for ' + tmpMajorLanguage + '_' + tmpMinorLanguage + ' sucessfully loaded');
870 tmpParts.Destroy;
871 exit;
872 end;
873 end;
874
875 // try generic language?
876 LogEvent(LogI18n, 'try loading (major only) ' + tmpMajorLanguage);
877 if LoadLanguageForSpec(anAppName, tmpMajorLanguage) then
878 begin
879 LogEvent(LogI18n, 'translation for ''' + tmpMajorLanguage + ''' sucessfully loaded');
880 tmpParts.Destroy;
881 exit;
882 end;
883
884 LogEvent(LogI18n, 'No language found, using default ' + tmpMajorLanguage);
885 LoadLanguage('');
886
887 tmpParts.Destroy;
888 end;
889
890
891 Initialization
892 g_LanguageCallbacks := nil;
893 g_CurrentLanguageFile := nil;
894 g_LanguageUpdateCallbacks := nil;
895
896
897 Finalization
898 DestroyListAndObjects(g_LanguageUpdateCallbacks);
899 DestroyListAndObjects(g_LanguageCallbacks);
900 if nil <> g_CurrentLanguageFile then g_CurrentLanguageFile.Destroy;
901
902End.
Note: See TracBrowser for help on using the repository browser.