source: trunk/Components/ACLLanguageUnit.pas@ 231

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

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