source: trunk/Components/ACLLanguageUnit.pas@ 226

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

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