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