1 | ///*********************************************************************************************************************
|
---|
2 | /// $Id: DKLang.pas,v 1.36 2006/08/11 06:59:45 dale Exp $
|
---|
3 | ///---------------------------------------------------------------------------------------------------------------------
|
---|
4 | /// DKLang Localization Package
|
---|
5 | /// Copyright 2002-2006 DK Software, http://www.dk-soft.org/
|
---|
6 | ///*********************************************************************************************************************
|
---|
7 | ///
|
---|
8 | /// The contents of this package are subject to the Mozilla Public License
|
---|
9 | /// Version 1.1 (the "License"); you may not use this file except in compliance
|
---|
10 | /// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
|
---|
11 | ///
|
---|
12 | /// Alternatively, you may redistribute this library, use and/or modify it under the
|
---|
13 | /// terms of the GNU Lesser General Public License as published by the Free Software
|
---|
14 | /// Foundation; either version 2.1 of the License, or (at your option) any later
|
---|
15 | /// version. You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/
|
---|
16 | ///
|
---|
17 | /// Software distributed under the License is distributed on an "AS IS" basis,
|
---|
18 | /// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
|
---|
19 | /// specific language governing rights and limitations under the License.
|
---|
20 | ///
|
---|
21 | /// The initial developer of the original code is Dmitry Kann, http://www.dk-soft.org/
|
---|
22 | /// Unicode support was initially developed by Bruce J. Miller <bjmiller-at-gmail.com>
|
---|
23 | ///
|
---|
24 | ///*********************************************************************************************************************
|
---|
25 | // The main unit (and the only required runtime unit) of the package. Contains all the
|
---|
26 | // basic class and component declarations
|
---|
27 | //
|
---|
28 | unit DKLang;
|
---|
29 |
|
---|
30 | {$INCLUDE TntCompilers.inc}
|
---|
31 |
|
---|
32 | interface
|
---|
33 | uses
|
---|
34 | Windows, SysUtils, Classes, Contnrs, Masks, TntClasses,
|
---|
35 | // TntWideStrings shouldn't be used in BDS 2006+ as those IDEs correctly implement default WideStrings
|
---|
36 | {$IFDEF COMPILER_10_UP}
|
---|
37 | WideStrings
|
---|
38 | {$ELSE}
|
---|
39 | TntWideStrings
|
---|
40 | {$ENDIF}
|
---|
41 | ;
|
---|
42 |
|
---|
43 | type
|
---|
44 | // Error
|
---|
45 | EDKLangError = class(Exception);
|
---|
46 |
|
---|
47 | TDKLang_Constants = class;
|
---|
48 |
|
---|
49 | // A translation state
|
---|
50 | TDKLang_TranslationState = (
|
---|
51 | dktsUntranslated, // The value is still untranslated
|
---|
52 | dktsAutotranslated); // The value was translated using the Translation Repository and hence the result needs checking
|
---|
53 | TDKLang_TranslationStates = set of TDKLang_TranslationState;
|
---|
54 |
|
---|
55 | //-------------------------------------------------------------------------------------------------------------------
|
---|
56 | // An interface to an object capable of storing its data as a language source strings
|
---|
57 | //-------------------------------------------------------------------------------------------------------------------
|
---|
58 |
|
---|
59 | IDKLang_LanguageSourceObject = interface(IInterface)
|
---|
60 | ['{41861692-AF49-4973-BDA1-0B1375407D29}']
|
---|
61 | // Is called just before storing begins. Must return True to allow the storing or False otherwise
|
---|
62 | function CanStore: Boolean;
|
---|
63 | // Must append the language source lines (Strings) with its own data. If an entry states intersect with
|
---|
64 | // StateFilter, the entry should be skipped
|
---|
65 | procedure StoreLangSource(Strings: TWideStrings; StateFilter: TDKLang_TranslationStates);
|
---|
66 | // Prop handlers
|
---|
67 | function GetSectionName: WideString;
|
---|
68 | // Props
|
---|
69 | // -- The name of the section corresponding to object language source data (without square brackets)
|
---|
70 | property SectionName: WideString read GetSectionName;
|
---|
71 | end;
|
---|
72 |
|
---|
73 | //-------------------------------------------------------------------------------------------------------------------
|
---|
74 | // A list of masks capable of testing an arbitrary string for matching. A string is considered matching when it
|
---|
75 | // matches any mask from the list
|
---|
76 | //-------------------------------------------------------------------------------------------------------------------
|
---|
77 |
|
---|
78 | TDKLang_MaskList = class(TObjectList)
|
---|
79 | private
|
---|
80 | function GetItems(Index: Integer): TMask;
|
---|
81 | public
|
---|
82 | // Creates and fills the list from Strings
|
---|
83 | constructor Create(MaskStrings: TStrings);
|
---|
84 | // Returns True if s matches any mask from the list
|
---|
85 | function Matches(const s: String): Boolean;
|
---|
86 | // Props
|
---|
87 | // -- Masks by index
|
---|
88 | property Items[Index: Integer]: TMask read GetItems; default;
|
---|
89 | end;
|
---|
90 |
|
---|
91 | //-------------------------------------------------------------------------------------------------------------------
|
---|
92 | // A single component property value translation, referred to by ID
|
---|
93 | //-------------------------------------------------------------------------------------------------------------------
|
---|
94 |
|
---|
95 | PDKLang_PropValueTranslation = ^TDKLang_PropValueTranslation;
|
---|
96 | TDKLang_PropValueTranslation = record
|
---|
97 | iID: Integer; // An entry ID, form-wide unique and permanent
|
---|
98 | wsValue: WideString; // The property value translation
|
---|
99 | TranStates: TDKLang_TranslationStates; // Translation states
|
---|
100 | end;
|
---|
101 |
|
---|
102 | //-------------------------------------------------------------------------------------------------------------------
|
---|
103 | // List of property value translations for the whole component hierarchy (usually for a single form); a plain list
|
---|
104 | // indexed (and sorted) by ID
|
---|
105 | //-------------------------------------------------------------------------------------------------------------------
|
---|
106 |
|
---|
107 | TDKLang_CompTranslation = class(TList)
|
---|
108 | private
|
---|
109 | // Prop storage
|
---|
110 | FComponentName: String;
|
---|
111 | // Prop handlers
|
---|
112 | function GetItems(Index: Integer): PDKLang_PropValueTranslation;
|
---|
113 | protected
|
---|
114 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
115 | public
|
---|
116 | constructor Create(const sComponentName: String);
|
---|
117 | // Adds an entry into the list and returns the index of the newly added entry
|
---|
118 | function Add(iID: Integer; const wsValue: WideString; TranStates: TDKLang_TranslationStates): Integer;
|
---|
119 | // Returns index of entry by its ID; -1 if not found
|
---|
120 | function IndexOfID(iID: Integer): Integer;
|
---|
121 | // Tries to find the entry by property ID; returns True, if succeeded, and its index in iIndex; otherwise returns
|
---|
122 | // False and its adviced insertion-point index in iIndex
|
---|
123 | function FindID(iID: Integer; out iIndex: Integer): Boolean;
|
---|
124 | // Returns the property entry for given ID, or nil if not found
|
---|
125 | function FindPropByID(iID: Integer): PDKLang_PropValueTranslation;
|
---|
126 | // Props
|
---|
127 | // -- Root component's name for which the translations in the list are (form, frame, datamodule etc)
|
---|
128 | property ComponentName: String read FComponentName;
|
---|
129 | // -- Translations by index
|
---|
130 | property Items[Index: Integer]: PDKLang_PropValueTranslation read GetItems; default;
|
---|
131 | end;
|
---|
132 |
|
---|
133 | //-------------------------------------------------------------------------------------------------------------------
|
---|
134 | // List of component translations
|
---|
135 | //-------------------------------------------------------------------------------------------------------------------
|
---|
136 |
|
---|
137 | TDKLang_CompTranslations = class(TList)
|
---|
138 | private
|
---|
139 | // Prop storage
|
---|
140 | FConstants: TDKLang_Constants;
|
---|
141 | FIsStreamUnicode: Boolean;
|
---|
142 | FParams: TWideStrings;
|
---|
143 | // Callback function for obtaining current language ID
|
---|
144 | function GetLangIDCallback: LANGID;
|
---|
145 | // Prop handlers
|
---|
146 | function GetItems(Index: Integer): TDKLang_CompTranslation;
|
---|
147 | protected
|
---|
148 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
149 | public
|
---|
150 | constructor Create;
|
---|
151 | destructor Destroy; override;
|
---|
152 | procedure Clear; override;
|
---|
153 | // Adds an item to the list and returns the index of the newly added entry
|
---|
154 | function Add(Item: TDKLang_CompTranslation): Integer;
|
---|
155 | // Returns index of entry by component name; -1 if not found
|
---|
156 | function IndexOfComponentName(const sComponentName: String): Integer;
|
---|
157 | // Returns component translation entry by component name; nil if not found
|
---|
158 | function FindComponentName(const sComponentName: String): TDKLang_CompTranslation;
|
---|
159 | // Stream loading and storing in plaintext (ini-file-like) format. bParamsOnly tells the object to load only the
|
---|
160 | // sectionless parameters and not to load components nor constants. This may be used to evaluate the translation
|
---|
161 | // parameters only (eg. its language)
|
---|
162 | procedure Text_LoadFromStream(Stream: TStream; bParamsOnly: Boolean = False);
|
---|
163 | procedure Text_SaveToStream(Stream: TStream; bUnicode, bSkipUntranslated: Boolean);
|
---|
164 | // File loading in plaintext (ini-file-like) format
|
---|
165 | procedure Text_LoadFromFile(const wsFileName: WideString; bParamsOnly: Boolean = False);
|
---|
166 | // File storing in plaintext (ini-file-like) format:
|
---|
167 | // bUnicode - if False, stores the data in ANSI encoding; if True, stores them in Unicode
|
---|
168 | // bSkipUntranslated - if True, untranslated values are eliminated from the file
|
---|
169 | procedure Text_SaveToFile(const wsFileName: WideString; bUnicode, bSkipUntranslated: Boolean);
|
---|
170 | // Resource loading
|
---|
171 | procedure Text_LoadFromResource(Instance: HINST; const wsResName: WideString; bParamsOnly: Boolean = False); overload;
|
---|
172 | procedure Text_LoadFromResource(Instance: HINST; iResID: Integer; bParamsOnly: Boolean = False); overload;
|
---|
173 | // Props
|
---|
174 | // -- Constant entries
|
---|
175 | property Constants: TDKLang_Constants read FConstants;
|
---|
176 | // -- True if last loading from text file/stream detected that it used Unicode encoding; False if it was ANSI
|
---|
177 | property IsStreamUnicode: Boolean read FIsStreamUnicode;
|
---|
178 | // -- Component translations by index
|
---|
179 | property Items[Index: Integer]: TDKLang_CompTranslation read GetItems; default;
|
---|
180 | // -- Simple parameters stored in a translation file BEFORE the first section (ie. sectionless)
|
---|
181 | property Params: TWideStrings read FParams;
|
---|
182 | end;
|
---|
183 |
|
---|
184 | //-------------------------------------------------------------------------------------------------------------------
|
---|
185 | // A single component property entry
|
---|
186 | //-------------------------------------------------------------------------------------------------------------------
|
---|
187 |
|
---|
188 | PDKLang_PropEntry = ^TDKLang_PropEntry;
|
---|
189 | TDKLang_PropEntry = record
|
---|
190 | iID: Integer; // An entry ID, form-wide unique and permanent
|
---|
191 | sPropName: String; // Component's property name to which the entry is applied
|
---|
192 | wsDefLangValue: WideString; // The property's value for the default language, represented as a widestring
|
---|
193 | bValidated: Boolean; // Validation flag, used internally in TDKLang_CompEntry.UpdateEntries
|
---|
194 | end;
|
---|
195 |
|
---|
196 | //-------------------------------------------------------------------------------------------------------------------
|
---|
197 | // List of property entries (sorted by property name, case-insensitively)
|
---|
198 | //-------------------------------------------------------------------------------------------------------------------
|
---|
199 |
|
---|
200 | TDKLang_PropEntries = class(TList)
|
---|
201 | private
|
---|
202 | // Prop handlers
|
---|
203 | function GetItems(Index: Integer): PDKLang_PropEntry;
|
---|
204 | protected
|
---|
205 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
206 | // Resets bValidated flag for each entry
|
---|
207 | procedure Invalidate;
|
---|
208 | // Deletes all invalid entries
|
---|
209 | procedure DeleteInvalidEntries;
|
---|
210 | // Returns max property entry ID over the list; 0 if list is empty
|
---|
211 | function GetMaxID: Integer;
|
---|
212 | public
|
---|
213 | // Add an entry into the list (returns True) or replaces the property value with sDefLangValue if property with
|
---|
214 | // this name already exists (and returns False). Also sets bValidated to True
|
---|
215 | function Add(iID: Integer; const sPropName: String; const wsDefLangValue: WideString): Boolean;
|
---|
216 | // Returns index of entry by its ID; -1 if not found
|
---|
217 | function IndexOfID(iID: Integer): Integer;
|
---|
218 | // Returns index of entry by property name; -1 if not found
|
---|
219 | function IndexOfPropName(const sPropName: String): Integer;
|
---|
220 | // Tries to find the entry by property name; returns True, if succeeded, and its index in iIndex; otherwise returns
|
---|
221 | // False and its adviced insertion-point index in iIndex
|
---|
222 | function FindPropName(const sPropName: String; out iIndex: Integer): Boolean;
|
---|
223 | // Returns entry by property name; nil if not found
|
---|
224 | function FindPropByName(const sPropName: String): PDKLang_PropEntry;
|
---|
225 | // Stream loading and storing
|
---|
226 | procedure LoadFromDFMResource(Stream: TStream);
|
---|
227 | procedure SaveToDFMResource(Stream: TStream);
|
---|
228 | // Props
|
---|
229 | // -- Entries by index
|
---|
230 | property Items[Index: Integer]: PDKLang_PropEntry read GetItems; default;
|
---|
231 | end;
|
---|
232 |
|
---|
233 | //-------------------------------------------------------------------------------------------------------------------
|
---|
234 | // Single component entry
|
---|
235 | //-------------------------------------------------------------------------------------------------------------------
|
---|
236 |
|
---|
237 | TDKLang_CompEntries = class;
|
---|
238 |
|
---|
239 | TDKLang_CompEntry = class(TObject)
|
---|
240 | private
|
---|
241 | // Component property entries
|
---|
242 | FPropEntries: TDKLang_PropEntries;
|
---|
243 | // Owned component entries
|
---|
244 | FOwnedCompEntries: TDKLang_CompEntries;
|
---|
245 | // Prop storage
|
---|
246 | FName: String;
|
---|
247 | FComponent: TComponent;
|
---|
248 | FOwner: TDKLang_CompEntry;
|
---|
249 | // Recursively calls PropEntries.Invalidate for each component
|
---|
250 | procedure InvalidateProps;
|
---|
251 | // Returns max property entry ID across all owned components; 0 if list is empty
|
---|
252 | function GetMaxPropEntryID: Integer;
|
---|
253 | // Internal recursive update routine
|
---|
254 | procedure InternalUpdateEntries(var iFreePropEntryID: Integer; bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps: Boolean; IgnoreMasks, StoreMasks: TDKLang_MaskList);
|
---|
255 | // Recursively establishes links to components by filling FComponent field with the component reference found by
|
---|
256 | // its Name. Also removes components whose names no longer associated with actually instantiated components.
|
---|
257 | // Required to be called after loading from the stream
|
---|
258 | procedure BindComponents(CurComponent: TComponent);
|
---|
259 | // Recursively appends property data as a language source format into Strings
|
---|
260 | procedure StoreLangSource(Strings: TWideStrings);
|
---|
261 | // Prop handlers
|
---|
262 | function GetName: String;
|
---|
263 | function GetComponentNamePath(bIncludeRoot: Boolean): String;
|
---|
264 | public
|
---|
265 | constructor Create(AOwner: TDKLang_CompEntry);
|
---|
266 | destructor Destroy; override;
|
---|
267 | // If bModifyList=True, recursively updates (or creates) component hierarchy and component property values,
|
---|
268 | // creating and deleting entries as appropriate. If bModifyList=False, only refreshes the [current=default]
|
---|
269 | // property values
|
---|
270 | procedure UpdateEntries(bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps: Boolean; IgnoreMasks, StoreMasks: TDKLang_MaskList);
|
---|
271 | // Recursively replaces the property values with ones found in Translation; if Translation=nil, applies the default
|
---|
272 | // property values
|
---|
273 | procedure ApplyTranslation(Translation: TDKLang_CompTranslation; cCodePage: Cardinal);
|
---|
274 | // Stream loading/storing
|
---|
275 | procedure LoadFromDFMResource(Stream: TStream);
|
---|
276 | procedure SaveToDFMResource(Stream: TStream);
|
---|
277 | // Removes the given component by reference, if any; if bRecursive=True, acts recursively
|
---|
278 | procedure RemoveComponent(AComponent: TComponent; bRecursive: Boolean);
|
---|
279 | // Props
|
---|
280 | // -- Reference to the component (nil while loading from the stream)
|
---|
281 | property Component: TComponent read FComponent;
|
---|
282 | // -- Returns component name path in the form 'owner1.owner2.name'. If bIncludeRoot=False, excludes the top-level
|
---|
283 | // owner name
|
---|
284 | property ComponentNamePath[bIncludeRoot: Boolean]: String read GetComponentNamePath;
|
---|
285 | // -- Component name in the IDE
|
---|
286 | property Name: String read GetName;
|
---|
287 | // -- Owner entry, can be nil
|
---|
288 | property Owner: TDKLang_CompEntry read FOwner;
|
---|
289 | end;
|
---|
290 |
|
---|
291 | //-------------------------------------------------------------------------------------------------------------------
|
---|
292 | // List of component entries
|
---|
293 | //-------------------------------------------------------------------------------------------------------------------
|
---|
294 |
|
---|
295 | TDKLang_CompEntries = class(TList)
|
---|
296 | private
|
---|
297 | // Prop storage
|
---|
298 | FOwner: TDKLang_CompEntry;
|
---|
299 | // Prop handlers
|
---|
300 | function GetItems(Index: Integer): TDKLang_CompEntry;
|
---|
301 | protected
|
---|
302 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
303 | public
|
---|
304 | constructor Create(AOwner: TDKLang_CompEntry);
|
---|
305 | // Add an entry into the list; returns the index of the newly added entry
|
---|
306 | function Add(Item: TDKLang_CompEntry): Integer;
|
---|
307 | // Returns index of entry by component name; -1 if not found
|
---|
308 | function IndexOfCompName(const sCompName: String): Integer;
|
---|
309 | // Returns index of entry by component reference; -1 if not found
|
---|
310 | function IndexOfComponent(CompReference: TComponent): Integer;
|
---|
311 | // Returns entry for given component reference; nil if not found
|
---|
312 | function FindComponent(CompReference: TComponent): TDKLang_CompEntry;
|
---|
313 | // Stream loading and storing
|
---|
314 | procedure LoadFromDFMResource(Stream: TStream);
|
---|
315 | procedure SaveToDFMResource(Stream: TStream);
|
---|
316 | // Props
|
---|
317 | // -- Items by index
|
---|
318 | property Items[Index: Integer]: TDKLang_CompEntry read GetItems; default;
|
---|
319 | // -- Owner component entry
|
---|
320 | property Owner: TDKLang_CompEntry read FOwner;
|
---|
321 | end;
|
---|
322 |
|
---|
323 | //-------------------------------------------------------------------------------------------------------------------
|
---|
324 | // A constant
|
---|
325 | //-------------------------------------------------------------------------------------------------------------------
|
---|
326 |
|
---|
327 | PDKLang_Constant = ^TDKLang_Constant;
|
---|
328 | TDKLang_Constant = record
|
---|
329 | sName: String; // Constant name, written obeying standard rules for identifier naming
|
---|
330 | wsValue: WideString; // Constant value
|
---|
331 | wsDefValue: WideString; // Default constant value (in the default language; initially the same as wsValue)
|
---|
332 | TranStates: TDKLang_TranslationStates; // Translation states
|
---|
333 | end;
|
---|
334 |
|
---|
335 | //-------------------------------------------------------------------------------------------------------------------
|
---|
336 | // List of constants (sorted by name, case-insensitively)
|
---|
337 | //-------------------------------------------------------------------------------------------------------------------
|
---|
338 |
|
---|
339 | // Callback function called when there's a need to determine language of constants being converted from ANSI to
|
---|
340 | // Unicode
|
---|
341 | TDKLang_GetLangIDCallback = function: LANGID of object;
|
---|
342 |
|
---|
343 | TDKLang_Constants = class(TList, IInterface, IDKLang_LanguageSourceObject)
|
---|
344 | private
|
---|
345 | // Get language ID callback
|
---|
346 | FGetLangIDCallback: TDKLang_GetLangIDCallback;
|
---|
347 | // Prop storage
|
---|
348 | FAutoSaveLangSource: Boolean;
|
---|
349 | // IInterface
|
---|
350 | function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
---|
351 | function _AddRef: Integer; stdcall;
|
---|
352 | function _Release: Integer; stdcall;
|
---|
353 | // IDKLang_LanguageSourceObject
|
---|
354 | function IDKLang_LanguageSourceObject.CanStore = LSO_CanStore;
|
---|
355 | procedure IDKLang_LanguageSourceObject.StoreLangSource = LSO_StoreLangSource;
|
---|
356 | function IDKLang_LanguageSourceObject.GetSectionName = LSO_GetSectionName;
|
---|
357 | function LSO_CanStore: Boolean;
|
---|
358 | procedure LSO_StoreLangSource(Strings: TWideStrings; StateFilter: TDKLang_TranslationStates);
|
---|
359 | function LSO_GetSectionName: WideString;
|
---|
360 | // Prop handlers
|
---|
361 | function GetAsRawString: String;
|
---|
362 | function GetItems(Index: Integer): PDKLang_Constant;
|
---|
363 | function GetItemsByName(const sName: String): PDKLang_Constant;
|
---|
364 | function GetValues(const sName: String): WideString;
|
---|
365 | procedure SetAsRawString(const Value: String);
|
---|
366 | procedure SetValues(const sName: String; const wsValue: WideString);
|
---|
367 | protected
|
---|
368 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
369 | public
|
---|
370 | constructor Create(AGetLangIDCallback: TDKLang_GetLangIDCallback);
|
---|
371 | // Add an entry into the list; returns the index of the newly inserted entry
|
---|
372 | function Add(const sName: String; const wsValue: WideString; TranStates: TDKLang_TranslationStates): Integer;
|
---|
373 | // Returns index of entry by name; -1 if not found
|
---|
374 | function IndexOfName(const sName: String): Integer;
|
---|
375 | // Tries to find the entry by name; returns True, if succeeded, and its index in iIndex; otherwise returns False
|
---|
376 | // and its adviced insertion-point index in iIndex
|
---|
377 | function FindName(const sName: String; out iIndex: Integer): Boolean;
|
---|
378 | // Finds the constant by name; returns nil if not found
|
---|
379 | function FindConstName(const sName: String): PDKLang_Constant;
|
---|
380 | // Stream loading/storing
|
---|
381 | procedure LoadFromStream(Stream: TStream);
|
---|
382 | procedure SaveToStream(Stream: TStream);
|
---|
383 | // Loads the constants from binary resource with the specified name. Returns True if resource existed, False
|
---|
384 | // otherwise
|
---|
385 | function LoadFromResource(Instance: HINST; const wsResName: WideString): Boolean;
|
---|
386 | // Updates the values for existing names from Constants. If Constants=nil, reverts the values to their defaults
|
---|
387 | // (wsDefValue)
|
---|
388 | procedure TranslateFrom(Constants: TDKLang_Constants);
|
---|
389 | // Props
|
---|
390 | // -- Binary list representation as raw data
|
---|
391 | property AsRawString: String read GetAsRawString write SetAsRawString;
|
---|
392 | // -- If True (default), the list will be automatically saved into the Project's language resource file (*.dklang)
|
---|
393 | property AutoSaveLangSource: Boolean read FAutoSaveLangSource write FAutoSaveLangSource;
|
---|
394 | // -- Constants by index
|
---|
395 | property Items[Index: Integer]: PDKLang_Constant read GetItems; default;
|
---|
396 | // -- Constants by name. If no constant of that name exists, an Exception is raised
|
---|
397 | property ItemsByName[const sName: String]: PDKLang_Constant read GetItemsByName;
|
---|
398 | // -- Constant values, by name. If no constant of that name exists, an Exception is raised
|
---|
399 | property Values[const sName: String]: WideString read GetValues write SetValues;
|
---|
400 | end;
|
---|
401 |
|
---|
402 | //-------------------------------------------------------------------------------------------------------------------
|
---|
403 | // Non-visual language controller component
|
---|
404 | //-------------------------------------------------------------------------------------------------------------------
|
---|
405 |
|
---|
406 | // TDKLanguageController options
|
---|
407 | TDKLanguageControllerOption = (
|
---|
408 | dklcoAutoSaveLangSource, // If on, the component will automatically save itself into the Project's language resource file (*.dklang)
|
---|
409 | dklcoIgnoreEmptyProps, // Ignore all properties having no string assigned
|
---|
410 | dklcoIgnoreNonAlphaProps, // Ignore all properties with no alpha characters (e.g. with numbers or symbols only); includes dklcoIgnoreEmptyProps behavior
|
---|
411 | dklcoIgnoreFontProps); // Ignore all TFont properties
|
---|
412 | TDKLanguageControllerOptions = set of TDKLanguageControllerOption;
|
---|
413 | const
|
---|
414 | DKLang_DefaultControllerOptions = [dklcoAutoSaveLangSource, dklcoIgnoreEmptyProps, dklcoIgnoreNonAlphaProps, dklcoIgnoreFontProps];
|
---|
415 |
|
---|
416 | type
|
---|
417 | TDKLanguageController = class(TComponent, IDKLang_LanguageSourceObject)
|
---|
418 | private
|
---|
419 | // Prop storage
|
---|
420 | FIgnoreList: TStrings;
|
---|
421 | FOnLanguageChanged: TNotifyEvent;
|
---|
422 | FOnLanguageChanging: TNotifyEvent;
|
---|
423 | FOptions: TDKLanguageControllerOptions;
|
---|
424 | FRootCompEntry: TDKLang_CompEntry;
|
---|
425 | FSectionName: WideString;
|
---|
426 | FStoreList: TStrings;
|
---|
427 | // Methods for LangData custom property support
|
---|
428 | procedure LangData_Load(Stream: TStream);
|
---|
429 | procedure LangData_Store(Stream: TStream);
|
---|
430 | // IDKLang_LanguageSourceObject
|
---|
431 | function IDKLang_LanguageSourceObject.CanStore = LSO_CanStore;
|
---|
432 | procedure IDKLang_LanguageSourceObject.StoreLangSource = LSO_StoreLangSource;
|
---|
433 | function IDKLang_LanguageSourceObject.GetSectionName = GetActualSectionName;
|
---|
434 | function LSO_CanStore: Boolean;
|
---|
435 | procedure LSO_StoreLangSource(Strings: TWideStrings; StateFilter: TDKLang_TranslationStates);
|
---|
436 | // Forces component entries to update their entries. If bModifyList=False, only default property values are
|
---|
437 | // initialized, no entry additions/removes are allowed
|
---|
438 | procedure UpdateComponents(bModifyList: Boolean);
|
---|
439 | // Prop handlers
|
---|
440 | function GetActualSectionName: WideString;
|
---|
441 | procedure SetIgnoreList(Value: TStrings);
|
---|
442 | procedure SetStoreList(Value: TStrings);
|
---|
443 | protected
|
---|
444 | procedure DefineProperties(Filer: TFiler); override;
|
---|
445 | procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
---|
446 | // Fires the OnLanguageChanging event
|
---|
447 | procedure DoLanguageChanging;
|
---|
448 | // Fires the OnLanguageChanged event
|
---|
449 | procedure DoLanguageChanged;
|
---|
450 | public
|
---|
451 | constructor Create(AOwner: TComponent); override;
|
---|
452 | destructor Destroy; override;
|
---|
453 | procedure Loaded; override;
|
---|
454 | // Props
|
---|
455 | // -- Name of a section that is actually used to store and read language data
|
---|
456 | property ActualSectionName: WideString read GetActualSectionName;
|
---|
457 | // -- The root entry, corresponding to the instance's owner
|
---|
458 | property RootCompEntry: TDKLang_CompEntry read FRootCompEntry;
|
---|
459 | published
|
---|
460 | // -- List of ignored properties
|
---|
461 | property IgnoreList: TStrings read FIgnoreList write SetIgnoreList;
|
---|
462 | // -- Language controller options
|
---|
463 | property Options: TDKLanguageControllerOptions read FOptions write FOptions default DKLang_DefaultControllerOptions;
|
---|
464 | // -- Name of a section corresponding to the form or frame served by the controller. If empty (default), Owner's
|
---|
465 | // name is used as section name
|
---|
466 | property SectionName: WideString read FSectionName write FSectionName;
|
---|
467 | // -- List of forcibly stored properties
|
---|
468 | property StoreList: TStrings read FStoreList write SetStoreList;
|
---|
469 | // Events
|
---|
470 | // -- Fires when language is changed through the LangManager
|
---|
471 | property OnLanguageChanging: TNotifyEvent read FOnLanguageChanging write FOnLanguageChanging;
|
---|
472 | // -- Fires when language is changed through the LangManager
|
---|
473 | property OnLanguageChanged: TNotifyEvent read FOnLanguageChanged write FOnLanguageChanged;
|
---|
474 | end;
|
---|
475 |
|
---|
476 | //-------------------------------------------------------------------------------------------------------------------
|
---|
477 | // A helper language resource list
|
---|
478 | //-------------------------------------------------------------------------------------------------------------------
|
---|
479 |
|
---|
480 | // Language resource entry kind
|
---|
481 | TDKLang_LangResourceKind = (
|
---|
482 | dklrkResName, // The entry is a resource addressed by name
|
---|
483 | dklrkResID, // The entry is a resource addressed by ID
|
---|
484 | dklrkFile); // The entry is a translation file
|
---|
485 |
|
---|
486 | PDKLang_LangResource = ^TDKLang_LangResource;
|
---|
487 | TDKLang_LangResource = record
|
---|
488 | Kind: TDKLang_LangResourceKind; // Entry kind
|
---|
489 | Instance: HINST; // Instance containing the resource (Kind=[dklrkResName, dklrkResID])
|
---|
490 | wsName: WideString; // File (Kind=dklrkFile) or resource (Kind=dklrkResName) name
|
---|
491 | iResID: Integer; // Resource ID (Kind=dklrkResID)
|
---|
492 | wLangID: LANGID; // Language contained in the resource
|
---|
493 | end;
|
---|
494 |
|
---|
495 | TDKLang_LangResources = class(TList)
|
---|
496 | private
|
---|
497 | function GetItems(Index: Integer): PDKLang_LangResource;
|
---|
498 | protected
|
---|
499 | procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
---|
500 | public
|
---|
501 | function Add(Kind: TDKLang_LangResourceKind; Instance: HINST; const wsName: WideString; iResID: Integer; wLangID: LANGID): Integer;
|
---|
502 | // Returns the index of entry having the specified LangID; -1 if no such entry
|
---|
503 | function IndexOfLangID(wLangID: LANGID): Integer;
|
---|
504 | // Returns the entry having the specified LangID; nil if no such entry
|
---|
505 | function FindLangID(wLangID: LANGID): PDKLang_LangResource;
|
---|
506 | // Props
|
---|
507 | // -- Items by index
|
---|
508 | property Items[Index: Integer]: PDKLang_LangResource read GetItems; default;
|
---|
509 | end;
|
---|
510 |
|
---|
511 | //-------------------------------------------------------------------------------------------------------------------
|
---|
512 | // Global thread-safe language manager class
|
---|
513 | //-------------------------------------------------------------------------------------------------------------------
|
---|
514 |
|
---|
515 | TDKLanguageManager = class(TObject)
|
---|
516 | private
|
---|
517 | // Synchronizer object to ensure the thread safety
|
---|
518 | FSynchronizer: TMultiReadExclusiveWriteSynchronizer;
|
---|
519 | // Internal constants object
|
---|
520 | FConstants: TDKLang_Constants;
|
---|
521 | // Internal list of language controllers have been created (runtime only)
|
---|
522 | FLangControllers: TList;
|
---|
523 | // Language resources registered (runtime only)
|
---|
524 | FLangResources: TDKLang_LangResources;
|
---|
525 | // Prop storage
|
---|
526 | FCodePage: Cardinal;
|
---|
527 | FDefaultLanguageID: LANGID;
|
---|
528 | FLanguageID: LANGID;
|
---|
529 | // Applies the specified translation to controllers and constants. Translations=nil means the default language to
|
---|
530 | // be applied
|
---|
531 | procedure ApplyTran(Translations: TDKLang_CompTranslations);
|
---|
532 | // Applies the specified translation to a single controller. Not a thread-safe method
|
---|
533 | procedure ApplyTranToController(Translations: TDKLang_CompTranslations; Controller: TDKLanguageController);
|
---|
534 | // Creates and returns the translations object, or nil if wLangID=DefaultLangID or creation failed. Not a
|
---|
535 | // thread-safe method
|
---|
536 | function GetTranslationsForLang(wLangID: LANGID): TDKLang_CompTranslations;
|
---|
537 | // Updates CodePage in order to match current LanguageID. Not a thread-safe method
|
---|
538 | procedure UpdateCodePage;
|
---|
539 | // Prop handlers
|
---|
540 | function GetConstantValue(const sName: String): WideString;
|
---|
541 | function GetConstantValueA(const sName: String): String;
|
---|
542 | function GetDefaultLanguageID: LANGID;
|
---|
543 | function GetLanguageCount: Integer;
|
---|
544 | function GetLanguageID: LANGID;
|
---|
545 | function GetLanguageIDs(Index: Integer): LANGID;
|
---|
546 | function GetLanguageIndex: Integer;
|
---|
547 | function GetLanguageNames(Index: Integer): WideString;
|
---|
548 | function GetLanguageResources(Index: Integer): PDKLang_LangResource;
|
---|
549 | procedure SetDefaultLanguageID(Value: LANGID);
|
---|
550 | procedure SetLanguageID(Value: LANGID);
|
---|
551 | procedure SetLanguageIndex(Value: Integer);
|
---|
552 | protected
|
---|
553 | // Internal language controller registration procedures (allowed at runtime only)
|
---|
554 | procedure AddLangController(Controller: TDKLanguageController);
|
---|
555 | procedure RemoveLangController(Controller: TDKLanguageController);
|
---|
556 | // Called by controllers when they are initialized and ready. Applies the currently selected language to the
|
---|
557 | // controller
|
---|
558 | procedure TranslateController(Controller: TDKLanguageController);
|
---|
559 | public
|
---|
560 | constructor Create;
|
---|
561 | destructor Destroy; override;
|
---|
562 | // Registers a translation file for specified language. Returns True if the file was a valid translation file with
|
---|
563 | // language specified. The file replaces any language resource for that language registered before. You can never
|
---|
564 | // replace the DefaultLanguage though
|
---|
565 | function RegisterLangFile(const wsFileName: WideString): Boolean;
|
---|
566 | // Register a resource as containing translation data for specified language. The resource replaces any language
|
---|
567 | // resource for that language registered before. You can never replace the DefaultLanguage though
|
---|
568 | procedure RegisterLangResource(Instance: HINST; const wsResourceName: WideString; wLangID: LANGID); overload;
|
---|
569 | procedure RegisterLangResource(Instance: HINST; iResID: Integer; wLangID: LANGID); overload;
|
---|
570 | // Removes language with the specified LangID from the registered language resources list. You cannot remove the
|
---|
571 | // DefaultLanguage
|
---|
572 | procedure UnregisterLangResource(wLangID: LANGID);
|
---|
573 | // Scans the specified directory for language files using given file mask. If bRecursive=True, also searches in the
|
---|
574 | // subdirectories of sDir. Returns the number of files successfully registered. Examples that scan the
|
---|
575 | // application directory for files with '.lng' extension:
|
---|
576 | // ScanForLangFiles(ExtractFileDir(ParamStr(0)), '*.lng', False); // ANSI version, not always correct
|
---|
577 | // ScanForLangFiles(WideExtractFileDir(WideParamStr(0)), '*.lng', False); // Unicode version, requires Tnt
|
---|
578 | // // Unicode Controls
|
---|
579 | function ScanForLangFiles(const wsDir, wsMask: WideString; bRecursive: Boolean): Integer;
|
---|
580 | // Returns the index of specified LangID, or -1 if not found
|
---|
581 | function IndexOfLanguageID(wLangID: LANGID): Integer;
|
---|
582 | // Props
|
---|
583 | // -- Code page corresponding to the current value of LanguageID
|
---|
584 | property CodePage: Cardinal read FCodePage;
|
---|
585 | // -- Constant values by name, Unicode version
|
---|
586 | property ConstantValue[const sName: String]: WideString read GetConstantValue;
|
---|
587 | // -- Constant values by name, ANSI version
|
---|
588 | property ConstantValueA[const sName: String]: String read GetConstantValueA;
|
---|
589 | // -- Constant values by name, Unicode version; the same as ConstantValue[]
|
---|
590 | property ConstantValueW[const sName: String]: WideString read GetConstantValue;
|
---|
591 | // -- Default language ID. The default value is US English ($409)
|
---|
592 | property DefaultLanguageID: LANGID read GetDefaultLanguageID write SetDefaultLanguageID;
|
---|
593 | // -- Current language ID. Initially equals to DefaultLanguageID. When being changed, affects all the registered
|
---|
594 | // language controllers as well as constants
|
---|
595 | property LanguageID: LANGID read GetLanguageID write SetLanguageID;
|
---|
596 | // -- Current language index
|
---|
597 | property LanguageIndex: Integer read GetLanguageIndex write SetLanguageIndex;
|
---|
598 | // -- Number of languages (language resources) registered, including the default language
|
---|
599 | property LanguageCount: Integer read GetLanguageCount;
|
---|
600 | // -- LangIDs of languages (language resources) registered, index ranged 0 to LanguageCount-1
|
---|
601 | property LanguageIDs[Index: Integer]: LANGID read GetLanguageIDs;
|
---|
602 | // -- Names of languages (language resources) registered, index ranged 0 to LanguageCount-1, Unicode version only
|
---|
603 | property LanguageNames[Index: Integer]: WideString read GetLanguageNames;
|
---|
604 | // -- Language resources registered, index ranged 0 to LanguageCount-1. Always nil for Index=0, ie. for default
|
---|
605 | // language
|
---|
606 | property LanguageResources[Index: Integer]: PDKLang_LangResource read GetLanguageResources;
|
---|
607 | end;
|
---|
608 |
|
---|
609 | // Returns the global language manager instance (allowed at runtime only)
|
---|
610 | function LangManager: TDKLanguageManager;
|
---|
611 |
|
---|
612 | // Encoding/decoding of control characters in backslashed (escaped) form (CRLF -> \n, TAB -> \t, \ -> \\ etc)
|
---|
613 | function EncodeControlChars(const ws: WideString): WideString; // Raw string -> Escaped string
|
---|
614 | function DecodeControlChars(const ws: WideString): WideString; // Escaped string -> Raw string
|
---|
615 | // Finds and updates the corresponding section in Strings (which appear as language source file). If no appropriate
|
---|
616 | // section found, appends the lines to the end of Strings
|
---|
617 | procedure UpdateLangSourceStrings(Strings: TWideStrings; LSObject: IDKLang_LanguageSourceObject; StateFilter: TDKLang_TranslationStates);
|
---|
618 | // The same as UpdateLangSourceStrings() but operates directly on a language source file. If no such file, a new file
|
---|
619 | // is created
|
---|
620 | procedure UpdateLangSourceFile(const wsFileName: WideString; LSObject: IDKLang_LanguageSourceObject; StateFilter: TDKLang_TranslationStates);
|
---|
621 | // Raises exception EDKLangError
|
---|
622 | procedure DKLangError(const sMsg: String); overload;
|
---|
623 | procedure DKLangError(const sMsg: String; const aParams: Array of const); overload;
|
---|
624 |
|
---|
625 | // Shortcut to LangManager.ConstantValueW[]
|
---|
626 | function DKLangConstW(const sName: String): WideString; overload;
|
---|
627 | // The same, but formats constant value using aParams
|
---|
628 | function DKLangConstW(const sName: String; const aParams: Array of const): WideString; overload;
|
---|
629 | // Shortcut to LangManager.ConstantValueA[]
|
---|
630 | function DKLangConstA(const sName: String): String; overload;
|
---|
631 | // The same, but formats constant value using aParams
|
---|
632 | function DKLangConstA(const sName: String; const aParams: Array of const): String; overload;
|
---|
633 |
|
---|
634 | const
|
---|
635 | // Version used for saving binary data into streams
|
---|
636 | IDKLang_StreamVersion = 2;
|
---|
637 |
|
---|
638 | // Resource name for constant entries in the .res file and executable resources
|
---|
639 | SDKLang_ConstResourceName = 'DKLANG_CONSTS';
|
---|
640 |
|
---|
641 | // Section name for constant entries in the language source or translation files
|
---|
642 | SDKLang_ConstSectionName = '$CONSTANTS';
|
---|
643 |
|
---|
644 | // Component translations parameter names
|
---|
645 | SDKLang_TranParam_LangID = 'LANGID';
|
---|
646 | SDKLang_TranParam_SourceLangID = 'SourceLANGID';
|
---|
647 | SDKLang_TranParam_Author = 'Author';
|
---|
648 | SDKLang_TranParam_Generator = 'Generator';
|
---|
649 | SDKLang_TranParam_LastModified = 'LastModified';
|
---|
650 | SDKLang_TranParam_TargetApplication = 'TargetApplication';
|
---|
651 |
|
---|
652 | // Default language source file extension
|
---|
653 | SDKLang_LangSourceExtension = 'dklang';
|
---|
654 |
|
---|
655 | ILangID_USEnglish = $0409;
|
---|
656 |
|
---|
657 | var
|
---|
658 | // Set to True by DKLang expert to indicate the design time execution
|
---|
659 | IsDesignTime: Boolean = False;
|
---|
660 |
|
---|
661 | resourcestring
|
---|
662 | SDKLangErrMsg_DuplicatePropValueID = 'Duplicate property value translation ID (%d)';
|
---|
663 | SDKLangErrMsg_ErrorLoadingTran = 'Loading translations failed.'#13#10'Line %d: %s';
|
---|
664 | SDKLangErrMsg_InvalidConstName = 'Invalid constant name ("%s")';
|
---|
665 | SDKLangErrMsg_DuplicateConstName = 'Duplicate constant name ("%s")';
|
---|
666 | SDKLangErrMsg_ConstantNotFound = 'Constant "%s" not found';
|
---|
667 | SDKLangErrMsg_LangManagerCalledAtDT = 'Call to LangManager() is allowed at runtime only';
|
---|
668 | SDKLangErrMsg_StreamVersionTooHigh = 'Stream version (%d) is greater than the current one (%d)';
|
---|
669 |
|
---|
670 | implementation
|
---|
671 | uses TypInfo, Math, TntSysUtils, TntSystem;
|
---|
672 |
|
---|
673 | var
|
---|
674 | _LangManager: TDKLanguageManager = nil;
|
---|
675 |
|
---|
676 | function LangManager: TDKLanguageManager;
|
---|
677 | begin
|
---|
678 | // Check that it's a runtime call
|
---|
679 | if IsDesignTime then DKLangError(SDKLangErrMsg_LangManagerCalledAtDT);
|
---|
680 | // Create _LangManager if needed
|
---|
681 | if _LangManager=nil then _LangManager := TDKLanguageManager.Create;
|
---|
682 | Result := _LangManager;
|
---|
683 | end;
|
---|
684 |
|
---|
685 | function EncodeControlChars(const ws: WideString): WideString;
|
---|
686 | var
|
---|
687 | i, iLen: Integer;
|
---|
688 | wc: WideChar;
|
---|
689 | begin
|
---|
690 | Result := '';
|
---|
691 | iLen := Length(ws);
|
---|
692 | i := 1;
|
---|
693 | while i<=iLen do begin
|
---|
694 | wc := ws[i];
|
---|
695 | case wc of
|
---|
696 | // Tab character
|
---|
697 | #9: Result := Result+'\t';
|
---|
698 | // Linefeed character. Skip subsequent Carriage Return char, if any
|
---|
699 | #10: begin
|
---|
700 | Result := Result+'\n';
|
---|
701 | if (i<iLen) and (ws[i+1]=#13) then Inc(i);
|
---|
702 | end;
|
---|
703 | // Carriage Return character. Skip subsequent Linefeed char, if any
|
---|
704 | #13: begin
|
---|
705 | Result := Result+'\n';
|
---|
706 | if (i<iLen) and (ws[i+1]=#10) then Inc(i);
|
---|
707 | end;
|
---|
708 | // Backslash. Just duplicate it
|
---|
709 | '\': Result := Result+'\\';
|
---|
710 | // All control characters having no special names represent as '\00' escape sequence; add directly all others
|
---|
711 | else if wc<#32 then Result := Result+WideFormat('\%.2d', [Word(wc)]) else Result := Result+wc;
|
---|
712 | end;
|
---|
713 | Inc(i);
|
---|
714 | end;
|
---|
715 | end;
|
---|
716 |
|
---|
717 | function DecodeControlChars(const ws: WideString): WideString;
|
---|
718 | var
|
---|
719 | i, iLen: Integer;
|
---|
720 | wc: WideChar;
|
---|
721 | bEscape: Boolean;
|
---|
722 | begin
|
---|
723 | Result := '';
|
---|
724 | iLen := Length(ws);
|
---|
725 | i := 1;
|
---|
726 | while i<=iLen do begin
|
---|
727 | wc := ws[i];
|
---|
728 | bEscape := False;
|
---|
729 | if (wc='\') and (i<iLen) then
|
---|
730 | case ws[i+1] of
|
---|
731 | // An escaped charcode '\00'
|
---|
732 | '0'..'9': if (i<iLen-1) and (ws[i+2] in [WideChar('0')..WideChar('9')]) then begin
|
---|
733 | Result := Result+WideChar((Word(ws[i+1])-Word('0'))*10+(Word(ws[i+2])-Word('0')));
|
---|
734 | Inc(i, 2);
|
---|
735 | bEscape := True;
|
---|
736 | end;
|
---|
737 | '\': begin
|
---|
738 | Result := Result+'\';
|
---|
739 | Inc(i);
|
---|
740 | bEscape := True;
|
---|
741 | end;
|
---|
742 | 'n': begin
|
---|
743 | Result := Result+#13#10;
|
---|
744 | Inc(i);
|
---|
745 | bEscape := True;
|
---|
746 | end;
|
---|
747 | 't': begin
|
---|
748 | Result := Result+#9;
|
---|
749 | Inc(i);
|
---|
750 | bEscape := True;
|
---|
751 | end;
|
---|
752 | end;
|
---|
753 | if not bEscape then Result := Result+wc;
|
---|
754 | Inc(i);
|
---|
755 | end;
|
---|
756 | end;
|
---|
757 |
|
---|
758 | procedure UpdateLangSourceStrings(Strings: TWideStrings; LSObject: IDKLang_LanguageSourceObject; StateFilter: TDKLang_TranslationStates);
|
---|
759 | var
|
---|
760 | idx, i: Integer;
|
---|
761 | wsSectionName: WideString;
|
---|
762 | SLLangSrc: TTntStringList;
|
---|
763 | begin
|
---|
764 | if not LSObject.CanStore then Exit;
|
---|
765 | SLLangSrc := TTntStringList.Create;
|
---|
766 | try
|
---|
767 | // Put section name
|
---|
768 | wsSectionName := WideFormat('[%s]', [LSObject.SectionName]);
|
---|
769 | SLLangSrc.Add(wsSectionName);
|
---|
770 | // Export language source data
|
---|
771 | LSObject.StoreLangSource(SLLangSrc, StateFilter);
|
---|
772 | // Add empty string
|
---|
773 | SLLangSrc.Add('');
|
---|
774 | // Lock Strings updates
|
---|
775 | Strings.BeginUpdate;
|
---|
776 | try
|
---|
777 | // Try to find the section
|
---|
778 | idx := Strings.IndexOf(wsSectionName);
|
---|
779 | // If found
|
---|
780 | if idx>=0 then begin
|
---|
781 | // Remove all the lines up to the next section
|
---|
782 | repeat Strings.Delete(idx) until (idx=Strings.Count) or (Copy(Strings[idx], 1, 1)='[');
|
---|
783 | // Insert language source lines into Strings
|
---|
784 | for i := 0 to SLLangSrc.Count-1 do begin
|
---|
785 | Strings.Insert(idx, SLLangSrc[i]);
|
---|
786 | Inc(idx);
|
---|
787 | end;
|
---|
788 | // Else simply append the language source
|
---|
789 | end else
|
---|
790 | Strings.AddStrings(SLLangSrc);
|
---|
791 | finally
|
---|
792 | Strings.EndUpdate;
|
---|
793 | end;
|
---|
794 | finally
|
---|
795 | SLLangSrc.Free;
|
---|
796 | end;
|
---|
797 | end;
|
---|
798 |
|
---|
799 | procedure UpdateLangSourceFile(const wsFileName: WideString; LSObject: IDKLang_LanguageSourceObject; StateFilter: TDKLang_TranslationStates);
|
---|
800 | var SLLangSrc: TTntStringList;
|
---|
801 | begin
|
---|
802 | SLLangSrc := TTntStringList.Create;
|
---|
803 | try
|
---|
804 | // Load language file source, if any
|
---|
805 | if WideFileExists(wsFileName) then SLLangSrc.LoadFromFile(wsFileName);
|
---|
806 | // Store the data
|
---|
807 | UpdateLangSourceStrings(SLLangSrc, LSObject, StateFilter);
|
---|
808 | // Save the language source back into file
|
---|
809 | SLLangSrc.SaveToFile(wsFileName);
|
---|
810 | finally
|
---|
811 | SLLangSrc.Free;
|
---|
812 | end;
|
---|
813 | end;
|
---|
814 |
|
---|
815 | procedure DKLangError(const sMsg: String); overload;
|
---|
816 |
|
---|
817 | function RetAddr: Pointer;
|
---|
818 | asm
|
---|
819 | mov eax, [ebp+4]
|
---|
820 | end;
|
---|
821 |
|
---|
822 | begin
|
---|
823 | raise EDKLangError.Create(sMsg) at RetAddr;
|
---|
824 | end;
|
---|
825 |
|
---|
826 | procedure DKLangError(const sMsg: String; const aParams: Array of const); overload;
|
---|
827 |
|
---|
828 | function RetAddr: Pointer;
|
---|
829 | asm
|
---|
830 | mov eax, [ebp+4]
|
---|
831 | end;
|
---|
832 |
|
---|
833 | begin
|
---|
834 | raise EDKLangError.CreateFmt(sMsg, aParams) at RetAddr;
|
---|
835 | end;
|
---|
836 |
|
---|
837 | function DKLangConstW(const sName: String): WideString;
|
---|
838 | begin
|
---|
839 | Result := LangManager.ConstantValueW[sName];
|
---|
840 | end;
|
---|
841 |
|
---|
842 | function DKLangConstW(const sName: String; const aParams: Array of const): WideString;
|
---|
843 | begin
|
---|
844 | Result := WideFormat(DKLangConstW(sName), aParams);
|
---|
845 | end;
|
---|
846 |
|
---|
847 | function DKLangConstA(const sName: String): String;
|
---|
848 | begin
|
---|
849 | Result := LangManager.ConstantValueA[sName];
|
---|
850 | end;
|
---|
851 |
|
---|
852 | function DKLangConstA(const sName: String; const aParams: Array of const): String;
|
---|
853 | begin
|
---|
854 | Result := Format(DKLangConstA(sName), aParams);
|
---|
855 | end;
|
---|
856 |
|
---|
857 | //===================================================================================================================
|
---|
858 | // Stream I/O
|
---|
859 | //===================================================================================================================
|
---|
860 | // Writing
|
---|
861 |
|
---|
862 | procedure StreamWriteByte(Stream: TStream; b: Byte);
|
---|
863 | begin
|
---|
864 | Stream.WriteBuffer(b, 1);
|
---|
865 | end;
|
---|
866 |
|
---|
867 | procedure StreamWriteWord(Stream: TStream; w: Word);
|
---|
868 | begin
|
---|
869 | Stream.WriteBuffer(w, 2);
|
---|
870 | end;
|
---|
871 |
|
---|
872 | procedure StreamWriteInt(Stream: TStream; i: Integer);
|
---|
873 | begin
|
---|
874 | Stream.WriteBuffer(i, 4);
|
---|
875 | end;
|
---|
876 |
|
---|
877 | procedure StreamWriteBool(Stream: TStream; b: Boolean);
|
---|
878 | begin
|
---|
879 | Stream.WriteBuffer(b, 1);
|
---|
880 | end;
|
---|
881 |
|
---|
882 | procedure StreamWriteStr(Stream: TStream; const s: string);
|
---|
883 | var w: Word;
|
---|
884 | begin
|
---|
885 | w := Length(s);
|
---|
886 | Stream.WriteBuffer(w, 2);
|
---|
887 | Stream.WriteBuffer(s[1], w);
|
---|
888 | end;
|
---|
889 |
|
---|
890 | procedure StreamWriteWideStr(Stream: TStream; const ws: WideString);
|
---|
891 | var w: Word;
|
---|
892 | begin
|
---|
893 | w := Length(ws);
|
---|
894 | Stream.WriteBuffer(w, 2);
|
---|
895 | Stream.WriteBuffer(ws[1], w*2);
|
---|
896 | end;
|
---|
897 |
|
---|
898 | procedure StreamWriteLine(Stream: TStream; const ws: WideString); overload;
|
---|
899 | var wsLn: WideString;
|
---|
900 | begin
|
---|
901 | wsLn := ws+#13#10;
|
---|
902 | Stream.WriteBuffer(wsLn[1], Length(wsLn)*2);
|
---|
903 | end;
|
---|
904 |
|
---|
905 | procedure StreamWriteLine(Stream: TStream; const s: String); overload;
|
---|
906 | var sLn: String;
|
---|
907 | begin
|
---|
908 | sLn := s+#13#10;
|
---|
909 | Stream.WriteBuffer(sLn[1], Length(sLn));
|
---|
910 | end;
|
---|
911 |
|
---|
912 | procedure StreamWriteLine(Stream: TStream; const ws: WideString; const aParams: Array of const); overload;
|
---|
913 | begin
|
---|
914 | StreamWriteLine(Stream, WideFormat(ws, aParams));
|
---|
915 | end;
|
---|
916 |
|
---|
917 | // Writes stream version number
|
---|
918 | procedure StreamWriteStreamVersion(Stream: TStream);
|
---|
919 | begin
|
---|
920 | StreamWriteByte(Stream, IDKLang_StreamVersion);
|
---|
921 | end;
|
---|
922 |
|
---|
923 | //===================================================================================================================
|
---|
924 | // Reading
|
---|
925 |
|
---|
926 | function StreamReadByte(Stream: TStream): Byte;
|
---|
927 | begin
|
---|
928 | Stream.ReadBuffer(Result, 1);
|
---|
929 | end;
|
---|
930 |
|
---|
931 | function StreamReadWord(Stream: TStream): Word;
|
---|
932 | begin
|
---|
933 | Stream.ReadBuffer(Result, 2);
|
---|
934 | end;
|
---|
935 |
|
---|
936 | function StreamReadInt(Stream: TStream): Integer;
|
---|
937 | begin
|
---|
938 | Stream.ReadBuffer(Result, 4);
|
---|
939 | end;
|
---|
940 |
|
---|
941 | function StreamReadBool(Stream: TStream): Boolean;
|
---|
942 | begin
|
---|
943 | Stream.ReadBuffer(Result, 1);
|
---|
944 | end;
|
---|
945 |
|
---|
946 | function StreamReadStr(Stream: TStream): string;
|
---|
947 | var w: Word;
|
---|
948 | begin
|
---|
949 | w := StreamReadWord(Stream);
|
---|
950 | SetLength(Result, w);
|
---|
951 | Stream.ReadBuffer(Result[1], w);
|
---|
952 | end;
|
---|
953 |
|
---|
954 | function StreamReadWideStr(Stream: TStream): WideString;
|
---|
955 | var w: Word;
|
---|
956 | begin
|
---|
957 | w := StreamReadWord(Stream);
|
---|
958 | SetLength(Result, w);
|
---|
959 | Stream.ReadBuffer(Result[1], w*2);
|
---|
960 | end;
|
---|
961 |
|
---|
962 | //===================================================================================================================
|
---|
963 | // TDKLang_MaskList
|
---|
964 | //===================================================================================================================
|
---|
965 |
|
---|
966 | constructor TDKLang_MaskList.Create(MaskStrings: TStrings);
|
---|
967 | var i: Integer;
|
---|
968 | begin
|
---|
969 | inherited Create;
|
---|
970 | for i := 0 to MaskStrings.Count-1 do Add(TMask.Create(MaskStrings[i]));
|
---|
971 | end;
|
---|
972 |
|
---|
973 | function TDKLang_MaskList.GetItems(Index: Integer): TMask;
|
---|
974 | begin
|
---|
975 | Result := TMask(Get(Index));
|
---|
976 | end;
|
---|
977 |
|
---|
978 | function TDKLang_MaskList.Matches(const s: String): Boolean;
|
---|
979 | var i: Integer;
|
---|
980 | begin
|
---|
981 | for i := 0 to Count-1 do
|
---|
982 | if Items[i].Matches(s) then begin
|
---|
983 | Result := True;
|
---|
984 | Exit;
|
---|
985 | end;
|
---|
986 | Result := False;
|
---|
987 | end;
|
---|
988 |
|
---|
989 | //===================================================================================================================
|
---|
990 | // TDKLang_CompTranslation
|
---|
991 | //===================================================================================================================
|
---|
992 |
|
---|
993 | function TDKLang_CompTranslation.Add(iID: Integer; const wsValue: WideString; TranStates: TDKLang_TranslationStates): Integer;
|
---|
994 | var p: PDKLang_PropValueTranslation;
|
---|
995 | begin
|
---|
996 | // Find insertion point and check ID uniqueness
|
---|
997 | if FindID(iID, Result) then DKLangError(SDKLangErrMsg_DuplicatePropValueID, [iID]);
|
---|
998 | // Create and insert a new entry
|
---|
999 | New(p);
|
---|
1000 | Insert(Result, p);
|
---|
1001 | // Initialize entry
|
---|
1002 | p.iID := iID;
|
---|
1003 | p.wsValue := wsValue;
|
---|
1004 | p.TranStates := TranStates;
|
---|
1005 | end;
|
---|
1006 |
|
---|
1007 | constructor TDKLang_CompTranslation.Create(const sComponentName: String);
|
---|
1008 | begin
|
---|
1009 | inherited Create;
|
---|
1010 | FComponentName := sComponentName;
|
---|
1011 | end;
|
---|
1012 |
|
---|
1013 | function TDKLang_CompTranslation.FindID(iID: Integer; out iIndex: Integer): Boolean;
|
---|
1014 | var iL, iR, i, iItemID: Integer;
|
---|
1015 | begin
|
---|
1016 | // Since the list is sorted by ID, implement binary search here
|
---|
1017 | Result := False;
|
---|
1018 | iL := 0;
|
---|
1019 | iR := Count-1;
|
---|
1020 | while iL<=iR do begin
|
---|
1021 | i := (iL+iR) shr 1;
|
---|
1022 | iItemID := GetItems(i).iID;
|
---|
1023 | if iItemID<iID then
|
---|
1024 | iL := i+1
|
---|
1025 | else if iItemID=iID then begin
|
---|
1026 | Result := True;
|
---|
1027 | iL := i;
|
---|
1028 | Break;
|
---|
1029 | end else
|
---|
1030 | iR := i-1;
|
---|
1031 | end;
|
---|
1032 | iIndex := iL;
|
---|
1033 | end;
|
---|
1034 |
|
---|
1035 | function TDKLang_CompTranslation.FindPropByID(iID: Integer): PDKLang_PropValueTranslation;
|
---|
1036 | var idx: Integer;
|
---|
1037 | begin
|
---|
1038 | if not FindID(iID, idx) then Result := nil else Result := GetItems(idx);
|
---|
1039 | end;
|
---|
1040 |
|
---|
1041 | function TDKLang_CompTranslation.GetItems(Index: Integer): PDKLang_PropValueTranslation;
|
---|
1042 | begin
|
---|
1043 | Result := Get(Index);
|
---|
1044 | end;
|
---|
1045 |
|
---|
1046 | function TDKLang_CompTranslation.IndexOfID(iID: Integer): Integer;
|
---|
1047 | begin
|
---|
1048 | if not FindID(iID, Result) then Result := -1;
|
---|
1049 | end;
|
---|
1050 |
|
---|
1051 | procedure TDKLang_CompTranslation.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
1052 | begin
|
---|
1053 | // Don't call inherited Notify() here as it does nothing
|
---|
1054 | if Action=lnDeleted then Dispose(PDKLang_PropValueTranslation(Ptr));
|
---|
1055 | end;
|
---|
1056 |
|
---|
1057 | //===================================================================================================================
|
---|
1058 | // TDKLang_CompTranslations
|
---|
1059 | //===================================================================================================================
|
---|
1060 |
|
---|
1061 | function TDKLang_CompTranslations.Add(Item: TDKLang_CompTranslation): Integer;
|
---|
1062 | begin
|
---|
1063 | Result := inherited Add(Item);
|
---|
1064 | end;
|
---|
1065 |
|
---|
1066 | procedure TDKLang_CompTranslations.Clear;
|
---|
1067 | begin
|
---|
1068 | inherited Clear;
|
---|
1069 | // Clear also parameters and constants
|
---|
1070 | if FParams<>nil then FParams.Clear;
|
---|
1071 | if FConstants<>nil then FConstants.Clear;
|
---|
1072 | end;
|
---|
1073 |
|
---|
1074 | constructor TDKLang_CompTranslations.Create;
|
---|
1075 | begin
|
---|
1076 | inherited Create;
|
---|
1077 | FConstants := TDKLang_Constants.Create(GetLangIDCallback);
|
---|
1078 | FParams := TTntStringList.Create;
|
---|
1079 | end;
|
---|
1080 |
|
---|
1081 | destructor TDKLang_CompTranslations.Destroy;
|
---|
1082 | begin
|
---|
1083 | FreeAndNil(FParams);
|
---|
1084 | FreeAndNil(FConstants);
|
---|
1085 | inherited Destroy;
|
---|
1086 | end;
|
---|
1087 |
|
---|
1088 | function TDKLang_CompTranslations.FindComponentName(const sComponentName: String): TDKLang_CompTranslation;
|
---|
1089 | var idx: Integer;
|
---|
1090 | begin
|
---|
1091 | idx := IndexOfComponentName(sComponentName);
|
---|
1092 | if idx<0 then Result := nil else Result := GetItems(idx);
|
---|
1093 | end;
|
---|
1094 |
|
---|
1095 | function TDKLang_CompTranslations.GetItems(Index: Integer): TDKLang_CompTranslation;
|
---|
1096 | begin
|
---|
1097 | Result := Get(Index);
|
---|
1098 | end;
|
---|
1099 |
|
---|
1100 | function TDKLang_CompTranslations.GetLangIDCallback: LANGID;
|
---|
1101 | begin
|
---|
1102 | Result := StrToIntDef(Params.Values[SDKLang_TranParam_LangID], ILangID_USEnglish);
|
---|
1103 | end;
|
---|
1104 |
|
---|
1105 | function TDKLang_CompTranslations.IndexOfComponentName(const sComponentName: String): Integer;
|
---|
1106 | begin
|
---|
1107 | for Result := 0 to Count-1 do
|
---|
1108 | if SameText(GetItems(Result).ComponentName, sComponentName) then Exit;
|
---|
1109 | Result := -1;
|
---|
1110 | end;
|
---|
1111 |
|
---|
1112 | procedure TDKLang_CompTranslations.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
1113 | begin
|
---|
1114 | // Don't call inherited Notify() here as it does nothing
|
---|
1115 | if Action=lnDeleted then TDKLang_CompTranslation(Ptr).Free;
|
---|
1116 | end;
|
---|
1117 |
|
---|
1118 | procedure TDKLang_CompTranslations.Text_LoadFromFile(const wsFileName: WideString; bParamsOnly: Boolean);
|
---|
1119 | var Stream: TStream;
|
---|
1120 | begin
|
---|
1121 | Stream := TTntFileStream.Create(wsFileName, fmOpenRead or fmShareDenyWrite);
|
---|
1122 | try
|
---|
1123 | Text_LoadFromStream(Stream, bParamsOnly);
|
---|
1124 | finally
|
---|
1125 | Stream.Free;
|
---|
1126 | end;
|
---|
1127 | end;
|
---|
1128 |
|
---|
1129 | procedure TDKLang_CompTranslations.Text_LoadFromResource(Instance: HINST; const wsResName: WideString; bParamsOnly: Boolean = False);
|
---|
1130 | var Stream: TStream;
|
---|
1131 | begin
|
---|
1132 | Stream := TTntResourceStream.Create(Instance, wsResName, PWideChar(RT_RCDATA));
|
---|
1133 | try
|
---|
1134 | Text_LoadFromStream(Stream, bParamsOnly);
|
---|
1135 | finally
|
---|
1136 | Stream.Free;
|
---|
1137 | end;
|
---|
1138 | end;
|
---|
1139 |
|
---|
1140 | procedure TDKLang_CompTranslations.Text_LoadFromResource(Instance: HINST; iResID: Integer; bParamsOnly: Boolean = False);
|
---|
1141 | var Stream: TStream;
|
---|
1142 | begin
|
---|
1143 | Stream := TTntResourceStream.CreateFromID(Instance, iResID, PWideChar(RT_RCDATA));
|
---|
1144 | try
|
---|
1145 | Text_LoadFromStream(Stream, bParamsOnly);
|
---|
1146 | finally
|
---|
1147 | Stream.Free;
|
---|
1148 | end;
|
---|
1149 | end;
|
---|
1150 |
|
---|
1151 | procedure TDKLang_CompTranslations.Text_LoadFromStream(Stream: TStream; bParamsOnly: Boolean = False);
|
---|
1152 | var SL: TTntStringList;
|
---|
1153 |
|
---|
1154 | // Tries to split a line that is neither comment nor section into a name and a value and returns True if succeeded
|
---|
1155 | function ParseValueLine(const wsLine: WideString; out sName: String; out wsValue: WideString): Boolean;
|
---|
1156 | var iEqPos: Integer;
|
---|
1157 | begin
|
---|
1158 | Result := False;
|
---|
1159 | iEqPos := Pos('=', wsLine);
|
---|
1160 | if iEqPos=0 then Exit;
|
---|
1161 | sName := Trim(Copy(wsLine, 1, iEqPos-1)); // Convert name to ANSI
|
---|
1162 | wsValue := Trim(Copy(wsLine, iEqPos+1, MaxInt));
|
---|
1163 | if sName='' then Exit;
|
---|
1164 | Result := True;
|
---|
1165 | end;
|
---|
1166 |
|
---|
1167 | // Extracts and returns the language ID parameter value from the string list, or ILangID_USEnglish if failed
|
---|
1168 | function RetrieveLangID(List: TTntStringList): LANGID;
|
---|
1169 | var
|
---|
1170 | i: Integer;
|
---|
1171 | sName: String;
|
---|
1172 | wsValue: WideString;
|
---|
1173 | begin
|
---|
1174 | Result := ILangID_USEnglish;
|
---|
1175 | for i := 0 to List.Count-1 do
|
---|
1176 | if ParseValueLine(List[i], sName, wsValue) and SameText(sName, SDKLang_TranParam_LangID) then begin
|
---|
1177 | Result := StrToIntDef(wsValue, ILangID_USEnglish);
|
---|
1178 | Break;
|
---|
1179 | end;
|
---|
1180 | end;
|
---|
1181 |
|
---|
1182 | // Loads List from Stream, either ANSI or Unicode
|
---|
1183 | procedure LoadStreamIntoStringList(List: TTntStringList);
|
---|
1184 | var
|
---|
1185 | i64Pos: Int64;
|
---|
1186 | cCodePage: Cardinal;
|
---|
1187 | begin
|
---|
1188 | // Remember the original stream position
|
---|
1189 | i64Pos := Stream.Position;
|
---|
1190 | // Determine whether this is an Unicode source (BEFORE any reading is done)
|
---|
1191 | FIsStreamUnicode := AutoDetectCharacterSet(Stream)=csUnicode;
|
---|
1192 | Stream.Position := i64Pos;
|
---|
1193 | // Load the stream contents into the list
|
---|
1194 | List.LoadFromStream(Stream);
|
---|
1195 | // If this is an ANSI stream
|
---|
1196 | if not FIsStreamUnicode then begin
|
---|
1197 | // Get code page corresponding to the language from the loaded translations
|
---|
1198 | cCodePage := LCIDToCodePage(RetrieveLangID(List));
|
---|
1199 | // Reload the list using this correct code page
|
---|
1200 | Stream.Position := i64Pos;
|
---|
1201 | List.AnsiStrings.LoadFromStreamEx(Stream, cCodePage);
|
---|
1202 | end;
|
---|
1203 | end;
|
---|
1204 |
|
---|
1205 | // Processes the string list, line by line
|
---|
1206 | procedure ProcessStringList(List: TTntStringList);
|
---|
1207 | type
|
---|
1208 | // A translation part (within the Stream)
|
---|
1209 | TTranslationPart = (
|
---|
1210 | tpParam, // A sectionless (parameter) part
|
---|
1211 | tpConstant, // A constant part
|
---|
1212 | tpComponent); // A component part
|
---|
1213 | var
|
---|
1214 | i: Integer;
|
---|
1215 | wsLine: WideString;
|
---|
1216 | CT: TDKLang_CompTranslation;
|
---|
1217 | Part: TTranslationPart;
|
---|
1218 |
|
---|
1219 | // Parses strings starting with '[' and ending with ']'
|
---|
1220 | procedure ProcessSectionLine(const wsSectionName: WideString);
|
---|
1221 | begin
|
---|
1222 | // If it's a constant section
|
---|
1223 | if WideSameText(wsSectionName, SDKLang_ConstSectionName) then
|
---|
1224 | Part := tpConstant
|
---|
1225 | // Else assume this a component name
|
---|
1226 | else begin
|
---|
1227 | Part := tpComponent;
|
---|
1228 | // Try to find the component among previously loaded
|
---|
1229 | CT := FindComponentName(wsSectionName);
|
---|
1230 | // If not found, create new
|
---|
1231 | if CT=nil then begin
|
---|
1232 | CT := TDKLang_CompTranslation.Create(wsSectionName);
|
---|
1233 | Add(CT);
|
---|
1234 | end;
|
---|
1235 | end;
|
---|
1236 | end;
|
---|
1237 |
|
---|
1238 | // Parses a value line and applies the value if succeeded
|
---|
1239 | procedure ProcessValueLine(const wsLine: WideString);
|
---|
1240 | var
|
---|
1241 | sName: String;
|
---|
1242 | wsValue: WideString;
|
---|
1243 | iID: Integer;
|
---|
1244 | begin
|
---|
1245 | // Try to split the line to name and value
|
---|
1246 | if ParseValueLine(wsLine, sName, wsValue) then
|
---|
1247 | // Apply the parsed values
|
---|
1248 | case Part of
|
---|
1249 | tpParam: FParams.Values[sName] := wsValue;
|
---|
1250 | tpConstant: FConstants.Add(sName, DecodeControlChars(wsValue), []);
|
---|
1251 | tpComponent:
|
---|
1252 | if CT<>nil then begin
|
---|
1253 | iID := StrToIntDef(sName, 0);
|
---|
1254 | if iID>0 then CT.Add(iID, DecodeControlChars(wsValue), []);
|
---|
1255 | end;
|
---|
1256 | end;
|
---|
1257 | end;
|
---|
1258 |
|
---|
1259 | begin
|
---|
1260 | Part := tpParam; // Initially we're dealing with the sectionless part
|
---|
1261 | CT := nil;
|
---|
1262 | for i := 0 to List.Count-1 do begin
|
---|
1263 | try
|
---|
1264 | wsLine := Trim(List[i]);
|
---|
1265 | // Skip empty lines
|
---|
1266 | if wsLine<>'' then
|
---|
1267 | case wsLine[1] of
|
---|
1268 | // A comment
|
---|
1269 | ';': ;
|
---|
1270 | // A section
|
---|
1271 | '[': begin
|
---|
1272 | if bParamsOnly then Break;
|
---|
1273 | if (Length(wsLine)>2) and (wsLine[Length(wsLine)]=']') then ProcessSectionLine(Trim(Copy(wsLine, 2, Length(wsLine)-2)));
|
---|
1274 | end;
|
---|
1275 | // Probably an entry of form '<Name or ID>=<Value>'
|
---|
1276 | else ProcessValueLine(wsLine);
|
---|
1277 | end;
|
---|
1278 | except
|
---|
1279 | on e: Exception do DKLangError(SDKLangErrMsg_ErrorLoadingTran, [i, e.Message]);
|
---|
1280 | end;
|
---|
1281 | end;
|
---|
1282 | end;
|
---|
1283 |
|
---|
1284 | begin
|
---|
1285 | // Clear all the lists
|
---|
1286 | Clear;
|
---|
1287 | // Load the stream contents into the string list
|
---|
1288 | SL := TTntStringList.Create;
|
---|
1289 | try
|
---|
1290 | LoadStreamIntoStringList(SL);
|
---|
1291 | // Parse the list line-by-line
|
---|
1292 | ProcessStringList(SL);
|
---|
1293 | finally
|
---|
1294 | SL.Free;
|
---|
1295 | end;
|
---|
1296 | end;
|
---|
1297 |
|
---|
1298 | procedure TDKLang_CompTranslations.Text_SaveToFile(const wsFileName: WideString; bUnicode, bSkipUntranslated: Boolean);
|
---|
1299 | var
|
---|
1300 | Stream: TStream;
|
---|
1301 | begin
|
---|
1302 | Stream := TTntFileStream.Create(wsFileName, fmCreate);
|
---|
1303 | try
|
---|
1304 | Text_SaveToStream(Stream, bUnicode, bSkipUntranslated);
|
---|
1305 | finally
|
---|
1306 | Stream.Free;
|
---|
1307 | end;
|
---|
1308 | end;
|
---|
1309 |
|
---|
1310 | procedure TDKLang_CompTranslations.Text_SaveToStream(Stream: TStream; bUnicode, bSkipUntranslated: Boolean);
|
---|
1311 | var cCodePage: Cardinal;
|
---|
1312 |
|
---|
1313 | procedure DoWriteLine(const ws: WideString); overload;
|
---|
1314 | begin
|
---|
1315 | if bUnicode then StreamWriteLine(Stream, ws) else StreamWriteLine(Stream, WideStringToStringEx(ws, cCodePage));
|
---|
1316 | end;
|
---|
1317 |
|
---|
1318 | procedure DoWriteLine(const ws: WideString; const aParams: Array of const); overload;
|
---|
1319 | begin
|
---|
1320 | DoWriteLine(WideFormat(ws, aParams));
|
---|
1321 | end;
|
---|
1322 |
|
---|
1323 | procedure WriteParams;
|
---|
1324 | var i: Integer;
|
---|
1325 | begin
|
---|
1326 | for i := 0 to FParams.Count-1 do DoWriteLine(FParams[i]);
|
---|
1327 | // Insert an empty line
|
---|
1328 | if FParams.Count>0 then DoWriteLine('');
|
---|
1329 | end;
|
---|
1330 |
|
---|
1331 | procedure WriteComponents;
|
---|
1332 | var
|
---|
1333 | iComp, iEntry: Integer;
|
---|
1334 | CT: TDKLang_CompTranslation;
|
---|
1335 | begin
|
---|
1336 | for iComp := 0 to Count-1 do begin
|
---|
1337 | CT := GetItems(iComp);
|
---|
1338 | // Write component's name
|
---|
1339 | DoWriteLine('[%s]', [CT.ComponentName]);
|
---|
1340 | // Write translated values in the form 'ID=Value'
|
---|
1341 | for iEntry := 0 to CT.Count-1 do
|
---|
1342 | with CT[iEntry]^ do
|
---|
1343 | if not bSkipUntranslated or not (dktsUntranslated in TranStates) then
|
---|
1344 | DoWriteLine('%.8d=%s', [iID, EncodeControlChars(wsValue)]);
|
---|
1345 | // Insert an empty line
|
---|
1346 | DoWriteLine('');
|
---|
1347 | end;
|
---|
1348 | end;
|
---|
1349 |
|
---|
1350 | procedure WriteConstants;
|
---|
1351 | var i: Integer;
|
---|
1352 | begin
|
---|
1353 | // Write constant section name
|
---|
1354 | DoWriteLine('[%s]', [SDKLang_ConstSectionName]);
|
---|
1355 | // Write constant in the form 'Name=Value'
|
---|
1356 | for i := 0 to FConstants.Count-1 do
|
---|
1357 | with FConstants[i]^ do
|
---|
1358 | if not bSkipUntranslated or not (dktsUntranslated in TranStates) then
|
---|
1359 | DoWriteLine('%s=%s', [sName, EncodeControlChars(wsValue)]);
|
---|
1360 | end;
|
---|
1361 |
|
---|
1362 | begin
|
---|
1363 | cCodePage := LCIDToCodePage(GetLangIDCallback);
|
---|
1364 | // If Unicode saving - mark the stream as Unicode
|
---|
1365 | if bUnicode then StreamWriteWord(Stream, Word(UNICODE_BOM));
|
---|
1366 | WriteParams;
|
---|
1367 | WriteComponents;
|
---|
1368 | WriteConstants;
|
---|
1369 | end;
|
---|
1370 |
|
---|
1371 | //===================================================================================================================
|
---|
1372 | // TDKLang_PropEntries
|
---|
1373 | //===================================================================================================================
|
---|
1374 |
|
---|
1375 | function TDKLang_PropEntries.Add(iID: Integer; const sPropName: String; const wsDefLangValue: WideString): Boolean;
|
---|
1376 | var
|
---|
1377 | p: PDKLang_PropEntry;
|
---|
1378 | idx: Integer;
|
---|
1379 | begin
|
---|
1380 | // Try to find the property by its name
|
---|
1381 | Result := not FindPropName(sPropName, idx);
|
---|
1382 | // If not found, create and insert a new entry
|
---|
1383 | if Result then begin
|
---|
1384 | New(p);
|
---|
1385 | Insert(idx, p);
|
---|
1386 | p.iID := iID;
|
---|
1387 | p.sPropName := sPropName;
|
---|
1388 | end else
|
---|
1389 | p := GetItems(idx);
|
---|
1390 | // Assign entry value
|
---|
1391 | p.wsDefLangValue := wsDefLangValue;
|
---|
1392 | // Validate the entry
|
---|
1393 | p.bValidated := True;
|
---|
1394 | end;
|
---|
1395 |
|
---|
1396 | procedure TDKLang_PropEntries.DeleteInvalidEntries;
|
---|
1397 | var i: Integer;
|
---|
1398 | begin
|
---|
1399 | for i := Count-1 downto 0 do
|
---|
1400 | if not GetItems(i).bValidated then Delete(i);
|
---|
1401 | end;
|
---|
1402 |
|
---|
1403 | function TDKLang_PropEntries.FindPropByName(const sPropName: String): PDKLang_PropEntry;
|
---|
1404 | var idx: Integer;
|
---|
1405 | begin
|
---|
1406 | if FindPropName(sPropName, idx) then Result := GetItems(idx) else Result := nil;
|
---|
1407 | end;
|
---|
1408 |
|
---|
1409 | function TDKLang_PropEntries.FindPropName(const sPropName: String; out iIndex: Integer): Boolean;
|
---|
1410 | var iL, iR, i: Integer;
|
---|
1411 | begin
|
---|
1412 | // Since the list is sorted by property name, implement binary search here
|
---|
1413 | Result := False;
|
---|
1414 | iL := 0;
|
---|
1415 | iR := Count-1;
|
---|
1416 | while iL<=iR do begin
|
---|
1417 | i := (iL+iR) shr 1;
|
---|
1418 | // Don't use AnsiCompareText() here as property names are allowed to consist of alphanumeric chars and '_' only
|
---|
1419 | case CompareText(GetItems(i).sPropName, sPropName) of
|
---|
1420 | Low(Integer)..-1: iL := i+1;
|
---|
1421 | 0: begin
|
---|
1422 | Result := True;
|
---|
1423 | iL := i;
|
---|
1424 | Break;
|
---|
1425 | end;
|
---|
1426 | else iR := i-1;
|
---|
1427 | end;
|
---|
1428 | end;
|
---|
1429 | iIndex := iL;
|
---|
1430 | end;
|
---|
1431 |
|
---|
1432 | function TDKLang_PropEntries.GetItems(Index: Integer): PDKLang_PropEntry;
|
---|
1433 | begin
|
---|
1434 | Result := Get(Index);
|
---|
1435 | end;
|
---|
1436 |
|
---|
1437 | function TDKLang_PropEntries.GetMaxID: Integer;
|
---|
1438 | var i: Integer;
|
---|
1439 | begin
|
---|
1440 | Result := 0;
|
---|
1441 | for i := 0 to Count-1 do Result := Max(Result, GetItems(i).iID);
|
---|
1442 | end;
|
---|
1443 |
|
---|
1444 | function TDKLang_PropEntries.IndexOfID(iID: Integer): Integer;
|
---|
1445 | begin
|
---|
1446 | for Result := 0 to Count-1 do
|
---|
1447 | if GetItems(Result).iID=iID then Exit;
|
---|
1448 | Result := -1;
|
---|
1449 | end;
|
---|
1450 |
|
---|
1451 | function TDKLang_PropEntries.IndexOfPropName(const sPropName: String): Integer;
|
---|
1452 | begin
|
---|
1453 | if not FindPropName(sPropName, Result) then Result := -1;
|
---|
1454 | end;
|
---|
1455 |
|
---|
1456 | procedure TDKLang_PropEntries.Invalidate;
|
---|
1457 | var i: Integer;
|
---|
1458 | begin
|
---|
1459 | for i := 0 to Count-1 do GetItems(i).bValidated := False;
|
---|
1460 | end;
|
---|
1461 |
|
---|
1462 | procedure TDKLang_PropEntries.LoadFromDFMResource(Stream: TStream);
|
---|
1463 | var
|
---|
1464 | i, iID: Integer;
|
---|
1465 | sName: String;
|
---|
1466 | begin
|
---|
1467 | Clear;
|
---|
1468 | for i := 0 to StreamReadInt(Stream)-1 do begin
|
---|
1469 | iID := StreamReadInt(Stream);
|
---|
1470 | sName := StreamReadStr(Stream);
|
---|
1471 | Add(iID, sName, '');
|
---|
1472 | end;
|
---|
1473 | end;
|
---|
1474 |
|
---|
1475 | procedure TDKLang_PropEntries.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
1476 | begin
|
---|
1477 | // Don't call inherited Notify() here as it does nothing
|
---|
1478 | if Action=lnDeleted then Dispose(PDKLang_PropEntry(Ptr));
|
---|
1479 | end;
|
---|
1480 |
|
---|
1481 | procedure TDKLang_PropEntries.SaveToDFMResource(Stream: TStream);
|
---|
1482 | var
|
---|
1483 | i: Integer;
|
---|
1484 | p: PDKLang_PropEntry;
|
---|
1485 | begin
|
---|
1486 | StreamWriteInt(Stream, Count);
|
---|
1487 | for i := 0 to Count-1 do begin
|
---|
1488 | p := GetItems(i);
|
---|
1489 | StreamWriteInt(Stream, p.iID);
|
---|
1490 | StreamWriteStr(Stream, p.sPropName);
|
---|
1491 | end;
|
---|
1492 | end;
|
---|
1493 |
|
---|
1494 | //===================================================================================================================
|
---|
1495 | // TDKLang_CompEntry
|
---|
1496 | //===================================================================================================================
|
---|
1497 |
|
---|
1498 | procedure TDKLang_CompEntry.ApplyTranslation(Translation: TDKLang_CompTranslation; cCodePage: Cardinal);
|
---|
1499 |
|
---|
1500 | // Applies translations to component's properties
|
---|
1501 | procedure TranslateProps;
|
---|
1502 |
|
---|
1503 | // Returns translation of a property value in wsTranslation and True if it is present in PropEntries
|
---|
1504 | function GetTranslationUnicode(const sPropName: String; out wsTranslation: WideString): Boolean;
|
---|
1505 | var
|
---|
1506 | PE: PDKLang_PropEntry;
|
---|
1507 | idxTran: Integer;
|
---|
1508 | begin
|
---|
1509 | // Try to locate prop translation entry
|
---|
1510 | PE := FPropEntries.FindPropByName(sPropName);
|
---|
1511 | Result := PE<>nil;
|
---|
1512 | if Result then begin
|
---|
1513 | wsTranslation := PE.wsDefLangValue;
|
---|
1514 | // If actual translation is supplied
|
---|
1515 | if Translation<>nil then begin
|
---|
1516 | // Try to find the appropriate translation by property entry ID
|
---|
1517 | idxTran := Translation.IndexOfID(PE.iID);
|
---|
1518 | if idxTran>=0 then wsTranslation := Translation[idxTran].wsValue;
|
---|
1519 | end;
|
---|
1520 | end else
|
---|
1521 | wsTranslation := '';
|
---|
1522 | end;
|
---|
1523 |
|
---|
1524 | // The same but return translation in ANSI encoding
|
---|
1525 | function GetTranslationAnsi(const sPropName: String; out sTranslation: String): Boolean;
|
---|
1526 | var ws: WideString;
|
---|
1527 | begin
|
---|
1528 | Result := GetTranslationUnicode(sPropName, ws);
|
---|
1529 | sTranslation := WideStringToStringEx(ws, cCodePage);
|
---|
1530 | end;
|
---|
1531 |
|
---|
1532 | procedure ProcessObject(const sPrefix: String; Instance: TObject); forward;
|
---|
1533 |
|
---|
1534 | // Processes the specified property and adds it to PropEntries if it appears suitable
|
---|
1535 | procedure ProcessProp(const sPrefix: String; Instance: TObject; pInfo: PPropInfo);
|
---|
1536 | const asSep: Array[Boolean] of String[1] = ('', '.');
|
---|
1537 | var
|
---|
1538 | i: Integer;
|
---|
1539 | o: TObject;
|
---|
1540 | sFullName, sTranslation: String;
|
---|
1541 | wsTranslation: WideString;
|
---|
1542 | begin
|
---|
1543 | // Test whether property is to be ignored (don't use IgnoreTest interface here)
|
---|
1544 | if ((Instance is TComponent) and (pInfo.Name='Name')) or not (pInfo.PropType^.Kind in [tkClass, tkString, tkLString, tkWString]) then Exit;
|
---|
1545 | sFullName := sPrefix+asSep[sPrefix<>'']+pInfo.Name;
|
---|
1546 | // Assign the new [translated] value to the property
|
---|
1547 | case pInfo.PropType^.Kind of
|
---|
1548 | tkClass:
|
---|
1549 | if Assigned(pInfo.GetProc) and Assigned(pInfo.SetProc) then begin
|
---|
1550 | o := GetObjectProp(Instance, pInfo);
|
---|
1551 | if o<>nil then
|
---|
1552 | // TWideStrings property
|
---|
1553 | if o is TWideStrings then begin
|
---|
1554 | if GetTranslationUnicode(sFullName, wsTranslation) then TWideStrings(o).Text := wsTranslation;
|
---|
1555 | // TStrings property
|
---|
1556 | end else if o is TStrings then begin
|
---|
1557 | if GetTranslationAnsi(sFullName, sTranslation) then TStrings(o).Text := sTranslation;
|
---|
1558 | // TCollection property
|
---|
1559 | end else if o is TCollection then
|
---|
1560 | for i := 0 to TCollection(o).Count-1 do ProcessObject(sFullName+Format('[%d]', [i]), TCollection(o).Items[i])
|
---|
1561 | // TPersistent property. Avoid processing TComponent references which may lead to a circular loop
|
---|
1562 | else if (o is TPersistent) and not (o is TComponent) then
|
---|
1563 | ProcessObject(sFullName, o);
|
---|
1564 | end;
|
---|
1565 | tkString,
|
---|
1566 | tkLString: if GetTranslationAnsi(sFullName, sTranslation) then SetStrProp(Instance, pInfo, sTranslation);
|
---|
1567 | tkWString: if GetTranslationUnicode(sFullName, wsTranslation) then SetWideStrProp(Instance, pInfo, wsTranslation);
|
---|
1568 | end;
|
---|
1569 | end;
|
---|
1570 |
|
---|
1571 | // Iterates through Instance's properties and add them to PropEntries. sPrefix is the object name prefix part
|
---|
1572 | procedure ProcessObject(const sPrefix: String; Instance: TObject);
|
---|
1573 | var
|
---|
1574 | i, iPropCnt: Integer;
|
---|
1575 | pList: PPropList;
|
---|
1576 | begin
|
---|
1577 | // Get property list
|
---|
1578 | iPropCnt := GetPropList(Instance, pList);
|
---|
1579 | // Iterate thru Instance's properties
|
---|
1580 | if iPropCnt>0 then
|
---|
1581 | try
|
---|
1582 | for i := 0 to iPropCnt-1 do ProcessProp(sPrefix, Instance, pList^[i]);
|
---|
1583 | finally
|
---|
1584 | FreeMem(pList);
|
---|
1585 | end;
|
---|
1586 | end;
|
---|
1587 |
|
---|
1588 | begin
|
---|
1589 | if FPropEntries<>nil then ProcessObject('', FComponent);
|
---|
1590 | end;
|
---|
1591 |
|
---|
1592 | // Recursively applies translations to owned components
|
---|
1593 | procedure TranslateComponents;
|
---|
1594 | var i: Integer;
|
---|
1595 | begin
|
---|
1596 | if FOwnedCompEntries<>nil then
|
---|
1597 | for i := 0 to FOwnedCompEntries.Count-1 do FOwnedCompEntries[i].ApplyTranslation(Translation, cCodePage);
|
---|
1598 | end;
|
---|
1599 |
|
---|
1600 | begin
|
---|
1601 | // Translate properties
|
---|
1602 | TranslateProps;
|
---|
1603 | // Translate owned components
|
---|
1604 | TranslateComponents;
|
---|
1605 | end;
|
---|
1606 |
|
---|
1607 | procedure TDKLang_CompEntry.BindComponents(CurComponent: TComponent);
|
---|
1608 | var
|
---|
1609 | i: Integer;
|
---|
1610 | CE: TDKLang_CompEntry;
|
---|
1611 | c: TComponent;
|
---|
1612 | begin
|
---|
1613 | FComponent := CurComponent;
|
---|
1614 | if FComponent<>nil then begin
|
---|
1615 | FName := ''; // Free the memory after the link is established
|
---|
1616 | // Cycle thru component entries
|
---|
1617 | if FOwnedCompEntries<>nil then begin
|
---|
1618 | for i := FOwnedCompEntries.Count-1 downto 0 do begin
|
---|
1619 | CE := FOwnedCompEntries[i];
|
---|
1620 | if CE.FName<>'' then begin
|
---|
1621 | // Try to find the component
|
---|
1622 | c := CurComponent.FindComponent(CE.FName);
|
---|
1623 | // If not found, delete entry. Recursively call BindComponents() otherwise
|
---|
1624 | if c=nil then FOwnedCompEntries.Delete(i) else CE.BindComponents(c);
|
---|
1625 | end;
|
---|
1626 | end;
|
---|
1627 | // Destroy the list once it is empty
|
---|
1628 | if FOwnedCompEntries.Count=0 then FreeAndNil(FOwnedCompEntries);
|
---|
1629 | end;
|
---|
1630 | end;
|
---|
1631 | end;
|
---|
1632 |
|
---|
1633 | constructor TDKLang_CompEntry.Create(AOwner: TDKLang_CompEntry);
|
---|
1634 | begin
|
---|
1635 | inherited Create;
|
---|
1636 | FOwner := AOwner;
|
---|
1637 | end;
|
---|
1638 |
|
---|
1639 | destructor TDKLang_CompEntry.Destroy;
|
---|
1640 | begin
|
---|
1641 | FPropEntries.Free;
|
---|
1642 | FOwnedCompEntries.Free;
|
---|
1643 | inherited Destroy;
|
---|
1644 | end;
|
---|
1645 |
|
---|
1646 | function TDKLang_CompEntry.GetComponentNamePath(bIncludeRoot: Boolean): String;
|
---|
1647 | begin
|
---|
1648 | if FOwner=nil then
|
---|
1649 | if bIncludeRoot then Result := Name else Result := ''
|
---|
1650 | else begin
|
---|
1651 | Result := FOwner.ComponentNamePath[bIncludeRoot];
|
---|
1652 | if Result<>'' then Result := Result+'.';
|
---|
1653 | Result := Result+Name;
|
---|
1654 | end;
|
---|
1655 | end;
|
---|
1656 |
|
---|
1657 | function TDKLang_CompEntry.GetMaxPropEntryID: Integer;
|
---|
1658 | var i: Integer;
|
---|
1659 | begin
|
---|
1660 | if FPropEntries=nil then Result := 0 else Result := FPropEntries.GetMaxID;
|
---|
1661 | if FOwnedCompEntries<>nil then
|
---|
1662 | for i := 0 to FOwnedCompEntries.Count-1 do Result := Max(Result, FOwnedCompEntries[i].GetMaxPropEntryID);
|
---|
1663 | end;
|
---|
1664 |
|
---|
1665 | function TDKLang_CompEntry.GetName: String;
|
---|
1666 | begin
|
---|
1667 | if FComponent=nil then Result := FName else Result := FComponent.Name;
|
---|
1668 | end;
|
---|
1669 |
|
---|
1670 | procedure TDKLang_CompEntry.InternalUpdateEntries(var iFreePropEntryID: Integer; bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps: Boolean; IgnoreMasks, StoreMasks: TDKLang_MaskList);
|
---|
1671 | var sCompPathPrefix: String;
|
---|
1672 |
|
---|
1673 | // Returns True if a property is to be stored according either to its streaming store-flag or to its matching to
|
---|
1674 | // StoreMasks
|
---|
1675 | function IsPropStored(Instance: TObject; pInfo: PPropInfo; const sPropFullName: String): Boolean;
|
---|
1676 | begin
|
---|
1677 | Result := IsStoredProp(Instance, pInfo) or StoreMasks.Matches(sPropFullName);
|
---|
1678 | end;
|
---|
1679 |
|
---|
1680 | // Returns True if a property value is allowed to be stored
|
---|
1681 | function IsPropValueStored(const sFullPropName: String; const wsPropVal: WideString): Boolean;
|
---|
1682 | var i: Integer;
|
---|
1683 | begin
|
---|
1684 | // Check whether the property value contains localizable characters
|
---|
1685 | if bIgnoreNonAlphaProps then begin
|
---|
1686 | Result := False;
|
---|
1687 | for i := 1 to Length(wsPropVal) do
|
---|
1688 | case wsPropVal[i] of
|
---|
1689 | 'A'..'Z', 'a'..'z', #161..High(WideChar): begin
|
---|
1690 | Result := True;
|
---|
1691 | Break;
|
---|
1692 | end;
|
---|
1693 | end;
|
---|
1694 | // Check for emptiness (no need if bIgnoreNonAlphaProps was True)
|
---|
1695 | end else if bIgnoreEmptyProps then
|
---|
1696 | Result := wsPropVal<>''
|
---|
1697 | else
|
---|
1698 | Result := True;
|
---|
1699 | end;
|
---|
1700 |
|
---|
1701 | // Updates the PropEntry value (creates one if needed)
|
---|
1702 | procedure UpdatePropValue(const sFullPropName: String; const wsPropVal: WideString);
|
---|
1703 | var p: PDKLang_PropEntry;
|
---|
1704 | begin
|
---|
1705 | if IsPropValueStored(sFullPropName, wsPropVal) then
|
---|
1706 | // If modifications are allowed
|
---|
1707 | if bModifyList then begin
|
---|
1708 | // Create PropEntries if needed
|
---|
1709 | if FPropEntries=nil then FPropEntries := TDKLang_PropEntries.Create;
|
---|
1710 | // If property is added (rather than replaced), increment the iFreePropEntryID counter; validate the entry
|
---|
1711 | if FPropEntries.Add(iFreePropEntryID, sFullPropName, wsPropVal) then Inc(iFreePropEntryID);
|
---|
1712 | // Otherwise only update the value, if any
|
---|
1713 | end else if FPropEntries<>nil then begin
|
---|
1714 | p := FPropEntries.FindPropByName(sFullPropName);
|
---|
1715 | if p<>nil then p.wsDefLangValue := wsPropVal;
|
---|
1716 | end;
|
---|
1717 | end;
|
---|
1718 |
|
---|
1719 | // Updates property entries
|
---|
1720 | procedure UpdateProps;
|
---|
1721 |
|
---|
1722 | procedure ProcessObject(const sPrefix: String; Instance: TObject); forward;
|
---|
1723 |
|
---|
1724 | // Processes the specified property and adds it to PropEntries if it appears suitable
|
---|
1725 | procedure ProcessProp(const sPrefix: String; Instance: TObject; pInfo: PPropInfo);
|
---|
1726 | const asSep: Array[Boolean] of String[1] = ('', '.');
|
---|
1727 | var
|
---|
1728 | i: Integer;
|
---|
1729 | o: TObject;
|
---|
1730 | sPropInCompName, sPropFullName: String;
|
---|
1731 | begin
|
---|
1732 | sPropInCompName := sPrefix+asSep[sPrefix<>'']+pInfo.Name;
|
---|
1733 | sPropFullName := sCompPathPrefix+sPropInCompName;
|
---|
1734 | // Test whether property is to be ignored
|
---|
1735 | if ((Instance is TComponent) and (pInfo.Name='Name')) or
|
---|
1736 | not (pInfo.PropType^.Kind in [tkClass, tkString, tkLString, tkWString]) or
|
---|
1737 | IgnoreMasks.Matches(sPropFullName) then Exit;
|
---|
1738 | // Obtain and store property value
|
---|
1739 | case pInfo.PropType^.Kind of
|
---|
1740 | tkClass:
|
---|
1741 | if Assigned(pInfo.GetProc) and Assigned(pInfo.SetProc) and IsPropStored(Instance, pInfo, sPropFullName) then begin
|
---|
1742 | o := GetObjectProp(Instance, pInfo);
|
---|
1743 | if o<>nil then
|
---|
1744 | // TWideStrings property
|
---|
1745 | if o is TWideStrings then
|
---|
1746 | UpdatePropValue(sPropInCompName, TWideStrings(o).Text)
|
---|
1747 | // TStrings property
|
---|
1748 | else if o is TStrings then
|
---|
1749 | UpdatePropValue(sPropInCompName, TStrings(o).Text)
|
---|
1750 | // TCollection property
|
---|
1751 | else if o is TCollection then
|
---|
1752 | for i := 0 to TCollection(o).Count-1 do ProcessObject(sPropInCompName+Format('[%d]', [i]), TCollection(o).Items[i])
|
---|
1753 | // TPersistent property. Avoid processing TComponent references which may lead to a circular loop. Also
|
---|
1754 | // filter TFont property values if needed (use name comparison instead of inheritance operator to
|
---|
1755 | // eliminate dependency on Graphics unit)
|
---|
1756 | else if (o is TPersistent) and not (o is TComponent) and (not bIgnoreFontProps or (o.ClassName<>'TFont')) then
|
---|
1757 | ProcessObject(sPropInCompName, o);
|
---|
1758 | end;
|
---|
1759 | tkString,
|
---|
1760 | tkLString: if IsPropStored(Instance, pInfo, sPropFullName) then UpdatePropValue(sPropInCompName, GetStrProp(Instance, pInfo));
|
---|
1761 | tkWString: if IsPropStored(Instance, pInfo, sPropFullName) then UpdatePropValue(sPropInCompName, GetWideStrProp(Instance, pInfo));
|
---|
1762 | end;
|
---|
1763 | end;
|
---|
1764 |
|
---|
1765 | // Iterates through Instance's properties and add them to PropEntries. sPrefix is the object name prefix part
|
---|
1766 | procedure ProcessObject(const sPrefix: String; Instance: TObject);
|
---|
1767 | var
|
---|
1768 | i, iPropCnt: Integer;
|
---|
1769 | pList: PPropList;
|
---|
1770 | begin
|
---|
1771 | // Get property list
|
---|
1772 | iPropCnt := GetPropList(Instance, pList);
|
---|
1773 | // Iterate thru Instance's properties
|
---|
1774 | if iPropCnt>0 then
|
---|
1775 | try
|
---|
1776 | for i := 0 to iPropCnt-1 do ProcessProp(sPrefix, Instance, pList^[i]);
|
---|
1777 | finally
|
---|
1778 | FreeMem(pList);
|
---|
1779 | end;
|
---|
1780 | end;
|
---|
1781 |
|
---|
1782 | begin
|
---|
1783 | ProcessObject('', FComponent);
|
---|
1784 | // Erase all properties not validated yet
|
---|
1785 | if bModifyList and (FPropEntries<>nil) then begin
|
---|
1786 | FPropEntries.DeleteInvalidEntries;
|
---|
1787 | // If property list is empty, erase it
|
---|
1788 | if FPropEntries.Count=0 then FreeAndNil(FPropEntries);
|
---|
1789 | end;
|
---|
1790 | end;
|
---|
1791 |
|
---|
1792 | // Synchronizes component list and updates each component's property entries
|
---|
1793 | procedure UpdateComponents;
|
---|
1794 | var
|
---|
1795 | i: Integer;
|
---|
1796 | c: TComponent;
|
---|
1797 | CE: TDKLang_CompEntry;
|
---|
1798 | begin
|
---|
1799 | for i := 0 to FComponent.ComponentCount-1 do begin
|
---|
1800 | c := FComponent.Components[i];
|
---|
1801 | if (c.Name<>'') and not (c is TDKLanguageController) then begin
|
---|
1802 | // Try to find the corresponding component entry
|
---|
1803 | if FOwnedCompEntries=nil then begin
|
---|
1804 | if bModifyList then FOwnedCompEntries := TDKLang_CompEntries.Create(Self);
|
---|
1805 | CE := nil;
|
---|
1806 | end else
|
---|
1807 | CE := FOwnedCompEntries.FindComponent(c);
|
---|
1808 | // If not found, and modifications are allowed, create the new entry
|
---|
1809 | if (CE=nil) and bModifyList then begin
|
---|
1810 | CE := TDKLang_CompEntry.Create(Self);
|
---|
1811 | CE.FComponent := c;
|
---|
1812 | FOwnedCompEntries.Add(CE);
|
---|
1813 | end;
|
---|
1814 | // Update the component's property entries
|
---|
1815 | if CE<>nil then CE.InternalUpdateEntries(iFreePropEntryID, bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps, IgnoreMasks, StoreMasks);
|
---|
1816 | end;
|
---|
1817 | end;
|
---|
1818 | end;
|
---|
1819 |
|
---|
1820 | begin
|
---|
1821 | sCompPathPrefix := ComponentNamePath[False]+'.'; // Root prop names will start with '.'
|
---|
1822 | // Update property entries
|
---|
1823 | UpdateProps;
|
---|
1824 | // Update component entries
|
---|
1825 | UpdateComponents;
|
---|
1826 | end;
|
---|
1827 |
|
---|
1828 | procedure TDKLang_CompEntry.InvalidateProps;
|
---|
1829 | var i: Integer;
|
---|
1830 | begin
|
---|
1831 | if FPropEntries<>nil then FPropEntries.Invalidate;
|
---|
1832 | if FOwnedCompEntries<>nil then
|
---|
1833 | for i := 0 to FOwnedCompEntries.Count-1 do FOwnedCompEntries[i].InvalidateProps;
|
---|
1834 | end;
|
---|
1835 |
|
---|
1836 | procedure TDKLang_CompEntry.LoadFromDFMResource(Stream: TStream);
|
---|
1837 | begin
|
---|
1838 | // Read component name
|
---|
1839 | FName := StreamReadStr(Stream);
|
---|
1840 | // Load props, if any
|
---|
1841 | if StreamReadBool(Stream) then begin
|
---|
1842 | if FPropEntries=nil then FPropEntries := TDKLang_PropEntries.Create;
|
---|
1843 | FPropEntries.LoadFromDFMResource(Stream);
|
---|
1844 | end;
|
---|
1845 | // Load owned components, if any (read component existence flag)
|
---|
1846 | if StreamReadBool(Stream) then begin
|
---|
1847 | if FOwnedCompEntries=nil then FOwnedCompEntries := TDKLang_CompEntries.Create(Self);
|
---|
1848 | FOwnedCompEntries.LoadFromDFMResource(Stream);
|
---|
1849 | end;
|
---|
1850 | end;
|
---|
1851 |
|
---|
1852 | procedure TDKLang_CompEntry.RemoveComponent(AComponent: TComponent; bRecursive: Boolean);
|
---|
1853 | var i, idx: Integer;
|
---|
1854 | begin
|
---|
1855 | if FOwnedCompEntries<>nil then begin
|
---|
1856 | // Try to find the component by reference
|
---|
1857 | idx := FOwnedCompEntries.IndexOfComponent(AComponent);
|
---|
1858 | // If found, delete it
|
---|
1859 | if idx>=0 then begin
|
---|
1860 | FOwnedCompEntries.Delete(idx);
|
---|
1861 | // Destroy the list once it is empty
|
---|
1862 | if FOwnedCompEntries.Count=0 then FreeAndNil(FOwnedCompEntries);
|
---|
1863 | end;
|
---|
1864 | // The same for owned entries
|
---|
1865 | if bRecursive and (FOwnedCompEntries<>nil) then
|
---|
1866 | for i := 0 to FOwnedCompEntries.Count-1 do FOwnedCompEntries[i].RemoveComponent(AComponent, True);
|
---|
1867 | end;
|
---|
1868 | end;
|
---|
1869 |
|
---|
1870 | procedure TDKLang_CompEntry.SaveToDFMResource(Stream: TStream);
|
---|
1871 | begin
|
---|
1872 | // Save component name
|
---|
1873 | StreamWriteStr(Stream, Name);
|
---|
1874 | // Store component properties
|
---|
1875 | StreamWriteBool(Stream, FPropEntries<>nil);
|
---|
1876 | if FPropEntries<>nil then FPropEntries.SaveToDFMResource(Stream);
|
---|
1877 | // Store owned components
|
---|
1878 | StreamWriteBool(Stream, FOwnedCompEntries<>nil);
|
---|
1879 | if FOwnedCompEntries<>nil then FOwnedCompEntries.SaveToDFMResource(Stream);
|
---|
1880 | end;
|
---|
1881 |
|
---|
1882 | procedure TDKLang_CompEntry.StoreLangSource(Strings: TWideStrings);
|
---|
1883 | var
|
---|
1884 | i: Integer;
|
---|
1885 | PE: PDKLang_PropEntry;
|
---|
1886 | sCompPath: String;
|
---|
1887 | begin
|
---|
1888 | // Store the properties
|
---|
1889 | if FPropEntries<>nil then begin
|
---|
1890 | // Find the component path, if any
|
---|
1891 | sCompPath := ComponentNamePath[False];
|
---|
1892 | if sCompPath<>'' then sCompPath := sCompPath+'.';
|
---|
1893 | // Iterate through the property entries
|
---|
1894 | for i := 0 to FPropEntries.Count-1 do begin
|
---|
1895 | PE := FPropEntries[i];
|
---|
1896 | Strings.Add(WideFormat('%s%s=%.8d,%s', [sCompPath, PE.sPropName, PE.iID, EncodeControlChars(PE.wsDefLangValue)]));
|
---|
1897 | end;
|
---|
1898 | end;
|
---|
1899 | // Recursively call the method for owned entries
|
---|
1900 | if FOwnedCompEntries<>nil then
|
---|
1901 | for i := 0 to FOwnedCompEntries.Count-1 do FOwnedCompEntries[i].StoreLangSource(Strings);
|
---|
1902 | end;
|
---|
1903 |
|
---|
1904 | procedure TDKLang_CompEntry.UpdateEntries(bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps: Boolean; IgnoreMasks, StoreMasks: TDKLang_MaskList);
|
---|
1905 | var iFreePropEntryID: Integer;
|
---|
1906 | begin
|
---|
1907 | // If modifications allowed
|
---|
1908 | if bModifyList then begin
|
---|
1909 | // Invalidate all property entries
|
---|
1910 | InvalidateProps;
|
---|
1911 | // Compute next free property entry ID
|
---|
1912 | iFreePropEntryID := GetMaxPropEntryID+1;
|
---|
1913 | end else
|
---|
1914 | iFreePropEntryID := 0;
|
---|
1915 | // Call recursive update routine
|
---|
1916 | InternalUpdateEntries(iFreePropEntryID, bModifyList, bIgnoreEmptyProps, bIgnoreNonAlphaProps, bIgnoreFontProps, IgnoreMasks, StoreMasks);
|
---|
1917 | end;
|
---|
1918 |
|
---|
1919 | //===================================================================================================================
|
---|
1920 | // TDKLang_CompEntries
|
---|
1921 | //===================================================================================================================
|
---|
1922 |
|
---|
1923 | function TDKLang_CompEntries.Add(Item: TDKLang_CompEntry): Integer;
|
---|
1924 | begin
|
---|
1925 | Result := inherited Add(Item);
|
---|
1926 | end;
|
---|
1927 |
|
---|
1928 | constructor TDKLang_CompEntries.Create(AOwner: TDKLang_CompEntry);
|
---|
1929 | begin
|
---|
1930 | inherited Create;
|
---|
1931 | FOwner := AOwner;
|
---|
1932 | end;
|
---|
1933 |
|
---|
1934 | function TDKLang_CompEntries.FindComponent(CompReference: TComponent): TDKLang_CompEntry;
|
---|
1935 | var idx: Integer;
|
---|
1936 | begin
|
---|
1937 | idx := IndexOfComponent(CompReference);
|
---|
1938 | if idx<0 then Result := nil else Result := GetItems(idx);
|
---|
1939 | end;
|
---|
1940 |
|
---|
1941 | function TDKLang_CompEntries.GetItems(Index: Integer): TDKLang_CompEntry;
|
---|
1942 | begin
|
---|
1943 | Result := Get(Index);
|
---|
1944 | end;
|
---|
1945 |
|
---|
1946 | function TDKLang_CompEntries.IndexOfCompName(const sCompName: String): Integer;
|
---|
1947 | begin
|
---|
1948 | for Result := 0 to Count-1 do
|
---|
1949 | // Don't use AnsiSameText() here as component names are allowed to consist of alphanumeric chars and '_' only
|
---|
1950 | if SameText(GetItems(Result).Name, sCompName) then Exit;
|
---|
1951 | Result := -1;
|
---|
1952 | end;
|
---|
1953 |
|
---|
1954 | function TDKLang_CompEntries.IndexOfComponent(CompReference: TComponent): Integer;
|
---|
1955 | begin
|
---|
1956 | for Result := 0 to Count-1 do
|
---|
1957 | if GetItems(Result).Component=CompReference then Exit;
|
---|
1958 | Result := -1;
|
---|
1959 | end;
|
---|
1960 |
|
---|
1961 | procedure TDKLang_CompEntries.LoadFromDFMResource(Stream: TStream);
|
---|
1962 | var
|
---|
1963 | i: Integer;
|
---|
1964 | CE: TDKLang_CompEntry;
|
---|
1965 | begin
|
---|
1966 | Clear;
|
---|
1967 | for i := 0 to StreamReadInt(Stream)-1 do begin
|
---|
1968 | CE := TDKLang_CompEntry.Create(FOwner);
|
---|
1969 | Add(CE);
|
---|
1970 | CE.LoadFromDFMResource(Stream);
|
---|
1971 | end;
|
---|
1972 | end;
|
---|
1973 |
|
---|
1974 | procedure TDKLang_CompEntries.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
1975 | begin
|
---|
1976 | // Don't call inherited Notify() here as it does nothing
|
---|
1977 | if Action=lnDeleted then TDKLang_CompEntry(Ptr).Free;
|
---|
1978 | end;
|
---|
1979 |
|
---|
1980 | procedure TDKLang_CompEntries.SaveToDFMResource(Stream: TStream);
|
---|
1981 | var i: Integer;
|
---|
1982 | begin
|
---|
1983 | StreamWriteInt(Stream, Count);
|
---|
1984 | for i := 0 to Count-1 do GetItems(i).SaveToDFMResource(Stream);
|
---|
1985 | end;
|
---|
1986 |
|
---|
1987 | //===================================================================================================================
|
---|
1988 | // TDKLang_Constants
|
---|
1989 | //===================================================================================================================
|
---|
1990 |
|
---|
1991 | function TDKLang_Constants.Add(const sName: String; const wsValue: WideString; TranStates: TDKLang_TranslationStates): Integer;
|
---|
1992 | var p: PDKLang_Constant;
|
---|
1993 | begin
|
---|
1994 | if not IsValidIdent(sName) then DKLangError(SDKLangErrMsg_InvalidConstName, [sName]);
|
---|
1995 | // Find insertion point and check name uniqueness
|
---|
1996 | if FindName(sName, Result) then DKLangError(SDKLangErrMsg_DuplicateConstName, [sName]);
|
---|
1997 | // Create and insert a new entry
|
---|
1998 | New(p);
|
---|
1999 | Insert(Result, p);
|
---|
2000 | // Initialize entry
|
---|
2001 | p.sName := sName;
|
---|
2002 | p.wsValue := wsValue;
|
---|
2003 | p.wsDefValue := wsValue;
|
---|
2004 | p.TranStates := TranStates;
|
---|
2005 | end;
|
---|
2006 |
|
---|
2007 | constructor TDKLang_Constants.Create(AGetLangIDCallback: TDKLang_GetLangIDCallback);
|
---|
2008 | begin
|
---|
2009 | inherited Create;
|
---|
2010 | FAutoSaveLangSource := True;
|
---|
2011 | FGetLangIDCallback := AGetLangIDCallback;
|
---|
2012 | end;
|
---|
2013 |
|
---|
2014 | function TDKLang_Constants.FindConstName(const sName: String): PDKLang_Constant;
|
---|
2015 | var idx: Integer;
|
---|
2016 | begin
|
---|
2017 | if FindName(sName, idx) then Result := GetItems(idx) else Result := nil;
|
---|
2018 | end;
|
---|
2019 |
|
---|
2020 | function TDKLang_Constants.FindName(const sName: String; out iIndex: Integer): Boolean;
|
---|
2021 | var iL, iR, i: Integer;
|
---|
2022 | begin
|
---|
2023 | // Since the list is sorted by constant name, implement binary search here
|
---|
2024 | Result := False;
|
---|
2025 | iL := 0;
|
---|
2026 | iR := Count-1;
|
---|
2027 | while iL<=iR do begin
|
---|
2028 | i := (iL+iR) shr 1;
|
---|
2029 | // Don't use AnsiCompareText()/WideCompareText() here as constant names are allowed to consist of alphanumeric
|
---|
2030 | // chars and '_' only
|
---|
2031 | case CompareText(GetItems(i).sName, sName) of
|
---|
2032 | Low(Integer)..-1: iL := i+1;
|
---|
2033 | 0: begin
|
---|
2034 | Result := True;
|
---|
2035 | iL := i;
|
---|
2036 | Break;
|
---|
2037 | end;
|
---|
2038 | else iR := i-1;
|
---|
2039 | end;
|
---|
2040 | end;
|
---|
2041 | iIndex := iL;
|
---|
2042 | end;
|
---|
2043 |
|
---|
2044 | function TDKLang_Constants.GetAsRawString: String;
|
---|
2045 | var Stream: TStringStream;
|
---|
2046 | begin
|
---|
2047 | Stream := TStringStream.Create('');
|
---|
2048 | try
|
---|
2049 | SaveToStream(Stream);
|
---|
2050 | Result := Stream.DataString;
|
---|
2051 | finally
|
---|
2052 | Stream.Free;
|
---|
2053 | end;
|
---|
2054 | end;
|
---|
2055 |
|
---|
2056 | function TDKLang_Constants.GetItems(Index: Integer): PDKLang_Constant;
|
---|
2057 | begin
|
---|
2058 | Result := Get(Index);
|
---|
2059 | end;
|
---|
2060 |
|
---|
2061 | function TDKLang_Constants.GetItemsByName(const sName: String): PDKLang_Constant;
|
---|
2062 | var idx: Integer;
|
---|
2063 | begin
|
---|
2064 | if not FindName(sName, idx) then DKLangError(SDKLangErrMsg_ConstantNotFound, [sName]);
|
---|
2065 | Result := GetItems(idx);
|
---|
2066 | end;
|
---|
2067 |
|
---|
2068 | function TDKLang_Constants.GetValues(const sName: String): WideString;
|
---|
2069 | begin
|
---|
2070 | Result := ItemsByName[sName].wsValue;
|
---|
2071 | end;
|
---|
2072 |
|
---|
2073 | function TDKLang_Constants.IndexOfName(const sName: String): Integer;
|
---|
2074 | begin
|
---|
2075 | if not FindName(sName, Result) then Result := -1;
|
---|
2076 | end;
|
---|
2077 |
|
---|
2078 | function TDKLang_Constants.LoadFromResource(Instance: HINST; const wsResName: WideString): Boolean;
|
---|
2079 | var Stream: TStream;
|
---|
2080 | begin
|
---|
2081 | // Check resource existence
|
---|
2082 | Result := FindResourceW(Instance, PWideChar(wsResName), PWideChar(RT_RCDATA))<>0;
|
---|
2083 | // If succeeded, load the list from resource
|
---|
2084 | if Result then begin
|
---|
2085 | Stream := TTntResourceStream.Create(Instance, wsResName, PWideChar(RT_RCDATA));
|
---|
2086 | try
|
---|
2087 | LoadFromStream(Stream);
|
---|
2088 | finally
|
---|
2089 | Stream.Free;
|
---|
2090 | end;
|
---|
2091 | end;
|
---|
2092 | end;
|
---|
2093 |
|
---|
2094 | procedure TDKLang_Constants.LoadFromStream(Stream: TStream);
|
---|
2095 | var b: Byte;
|
---|
2096 |
|
---|
2097 | // Implements loading from stream of version 1
|
---|
2098 | procedure Load_v1(bAutoSaveLangSource: Boolean);
|
---|
2099 | var
|
---|
2100 | i: Integer;
|
---|
2101 | sName: String;
|
---|
2102 | wsValue: WideString;
|
---|
2103 | cCodePage: Cardinal;
|
---|
2104 | begin
|
---|
2105 | cCodePage := LCIDToCodePage(FGetLangIDCallback);
|
---|
2106 | // AutoSaveLangSource is already read (while determining stream version)
|
---|
2107 | FAutoSaveLangSource := bAutoSaveLangSource;
|
---|
2108 | // Read item count, then read the constant names and values
|
---|
2109 | for i := 0 to StreamReadInt(Stream)-1 do begin
|
---|
2110 | sName := StreamReadStr(Stream);
|
---|
2111 | wsValue := StringToWideStringEx(StreamReadStr(Stream), cCodePage);
|
---|
2112 | Add(sName, wsValue, []);
|
---|
2113 | end;
|
---|
2114 | end;
|
---|
2115 |
|
---|
2116 | // Implements loading from stream of version 2
|
---|
2117 | procedure Load_v2;
|
---|
2118 | var
|
---|
2119 | i: Integer;
|
---|
2120 | sName: String;
|
---|
2121 | wsValue: WideString;
|
---|
2122 | begin
|
---|
2123 | // Read props
|
---|
2124 | FAutoSaveLangSource := StreamReadBool(Stream);
|
---|
2125 | // Read item count, then read the constant names and values
|
---|
2126 | for i := 0 to StreamReadInt(Stream)-1 do begin
|
---|
2127 | sName := StreamReadStr (Stream);
|
---|
2128 | wsValue := StreamReadWideStr(Stream);
|
---|
2129 | Add(sName, wsValue, []);
|
---|
2130 | end;
|
---|
2131 | end;
|
---|
2132 |
|
---|
2133 | begin
|
---|
2134 | // Clear the list
|
---|
2135 | Clear;
|
---|
2136 | // Read the first byte of the stream
|
---|
2137 | b := StreamReadByte(Stream);
|
---|
2138 | case b of
|
---|
2139 | // If it is 0 or 1, we're dealing with the very first version of the stream, and b is just boolean
|
---|
2140 | // AutoSaveLangSource flag
|
---|
2141 | 0, 1: Load_v1(b<>0);
|
---|
2142 | 2: Load_v2;
|
---|
2143 | else DKLangError(SDKLangErrMsg_StreamVersionTooHigh, [b, IDKLang_StreamVersion]);
|
---|
2144 | end;
|
---|
2145 | end;
|
---|
2146 |
|
---|
2147 | function TDKLang_Constants.LSO_CanStore: Boolean;
|
---|
2148 | begin
|
---|
2149 | Result := True;
|
---|
2150 | end;
|
---|
2151 |
|
---|
2152 | function TDKLang_Constants.LSO_GetSectionName: WideString;
|
---|
2153 | begin
|
---|
2154 | // Constants always use the predefined section name
|
---|
2155 | Result := SDKLang_ConstSectionName;
|
---|
2156 | end;
|
---|
2157 |
|
---|
2158 | procedure TDKLang_Constants.LSO_StoreLangSource(Strings: TWideStrings; StateFilter: TDKLang_TranslationStates);
|
---|
2159 | var i: Integer;
|
---|
2160 | begin
|
---|
2161 | for i := 0 to Count-1 do
|
---|
2162 | with GetItems(i)^ do
|
---|
2163 | if TranStates*StateFilter=[] then Strings.Add(sName+'='+EncodeControlChars(wsValue));
|
---|
2164 | end;
|
---|
2165 |
|
---|
2166 | procedure TDKLang_Constants.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
2167 | begin
|
---|
2168 | // Don't call inherited Notify() here as it does nothing
|
---|
2169 | if Action=lnDeleted then Dispose(PDKLang_Constant(Ptr));
|
---|
2170 | end;
|
---|
2171 |
|
---|
2172 | function TDKLang_Constants.QueryInterface(const IID: TGUID; out Obj): HResult;
|
---|
2173 | begin
|
---|
2174 | if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
|
---|
2175 | end;
|
---|
2176 |
|
---|
2177 | procedure TDKLang_Constants.SaveToStream(Stream: TStream);
|
---|
2178 | var
|
---|
2179 | i: Integer;
|
---|
2180 | p: PDKLang_Constant;
|
---|
2181 | begin
|
---|
2182 | // Write the stream version
|
---|
2183 | StreamWriteStreamVersion(Stream);
|
---|
2184 | // Store props
|
---|
2185 | StreamWriteBool(Stream, FAutoSaveLangSource);
|
---|
2186 | // Store count
|
---|
2187 | StreamWriteInt(Stream, Count);
|
---|
2188 | // Store the constants
|
---|
2189 | for i := 0 to Count-1 do begin
|
---|
2190 | p := GetItems(i);
|
---|
2191 | StreamWriteStr (Stream, p.sName);
|
---|
2192 | StreamWriteWideStr(Stream, p.wsValue);
|
---|
2193 | end;
|
---|
2194 | end;
|
---|
2195 |
|
---|
2196 | procedure TDKLang_Constants.SetAsRawString(const Value: String);
|
---|
2197 | var Stream: TStringStream;
|
---|
2198 | begin
|
---|
2199 | Stream := TStringStream.Create(Value);
|
---|
2200 | try
|
---|
2201 | LoadFromStream(Stream);
|
---|
2202 | finally
|
---|
2203 | Stream.Free;
|
---|
2204 | end;
|
---|
2205 | end;
|
---|
2206 |
|
---|
2207 | procedure TDKLang_Constants.SetValues(const sName: String; const wsValue: WideString);
|
---|
2208 | begin
|
---|
2209 | ItemsByName[sName].wsValue := wsValue;
|
---|
2210 | end;
|
---|
2211 |
|
---|
2212 | procedure TDKLang_Constants.TranslateFrom(Constants: TDKLang_Constants);
|
---|
2213 | var
|
---|
2214 | i, idx: Integer;
|
---|
2215 | pc: PDKLang_Constant;
|
---|
2216 | begin
|
---|
2217 | for i := 0 to Count-1 do begin
|
---|
2218 | pc := GetItems(i);
|
---|
2219 | // If Constants=nil this means reverting to defaults
|
---|
2220 | if Constants=nil then pc.wsValue := pc.wsDefValue
|
---|
2221 | // Else try to find the constant in Constants. Update the value if found
|
---|
2222 | else if Constants.FindName(pc.sName, idx) then pc.wsValue := Constants[idx].wsValue;
|
---|
2223 | end;
|
---|
2224 | end;
|
---|
2225 |
|
---|
2226 | function TDKLang_Constants._AddRef: Integer;
|
---|
2227 | begin
|
---|
2228 | // No refcounting applicable
|
---|
2229 | Result := -1;
|
---|
2230 | end;
|
---|
2231 |
|
---|
2232 | function TDKLang_Constants._Release: Integer;
|
---|
2233 | begin
|
---|
2234 | // No refcounting applicable
|
---|
2235 | Result := -1;
|
---|
2236 | end;
|
---|
2237 |
|
---|
2238 | //===================================================================================================================
|
---|
2239 | // TDKLanguageController
|
---|
2240 | //===================================================================================================================
|
---|
2241 |
|
---|
2242 | constructor TDKLanguageController.Create(AOwner: TComponent);
|
---|
2243 | begin
|
---|
2244 | inherited Create(AOwner);
|
---|
2245 | // Initialize IgnoreList
|
---|
2246 | FIgnoreList := TStringList.Create;
|
---|
2247 | TStringList(FIgnoreList).Duplicates := dupIgnore;
|
---|
2248 | TStringList(FIgnoreList).Sorted := True;
|
---|
2249 | // Initialize StoreList
|
---|
2250 | FStoreList := TStringList.Create;
|
---|
2251 | TStringList(FStoreList).Duplicates := dupIgnore;
|
---|
2252 | TStringList(FStoreList).Sorted := True;
|
---|
2253 | // Initialize other props
|
---|
2254 | FRootCompEntry := TDKLang_CompEntry.Create(nil);
|
---|
2255 | FOptions := DKLang_DefaultControllerOptions;
|
---|
2256 | if not (csLoading in ComponentState) then FRootCompEntry.BindComponents(Owner);
|
---|
2257 | if not (csDesigning in ComponentState) then LangManager.AddLangController(Self);
|
---|
2258 | end;
|
---|
2259 |
|
---|
2260 | procedure TDKLanguageController.DefineProperties(Filer: TFiler);
|
---|
2261 |
|
---|
2262 | function DoStore: Boolean;
|
---|
2263 | begin
|
---|
2264 | Result := (FRootCompEntry.Component<>nil) and (FRootCompEntry.Component.Name<>'');
|
---|
2265 | end;
|
---|
2266 |
|
---|
2267 | begin
|
---|
2268 | inherited DefineProperties(Filer);
|
---|
2269 | Filer.DefineBinaryProperty('LangData', LangData_Load, LangData_Store, DoStore);
|
---|
2270 | end;
|
---|
2271 |
|
---|
2272 | destructor TDKLanguageController.Destroy;
|
---|
2273 | begin
|
---|
2274 | if not (csDesigning in ComponentState) then LangManager.RemoveLangController(Self);
|
---|
2275 | FRootCompEntry.Free;
|
---|
2276 | FIgnoreList.Free;
|
---|
2277 | FStoreList.Free;
|
---|
2278 | inherited Destroy;
|
---|
2279 | end;
|
---|
2280 |
|
---|
2281 | procedure TDKLanguageController.DoLanguageChanged;
|
---|
2282 | begin
|
---|
2283 | if Assigned(FOnLanguageChanged) then FOnLanguageChanged(Self);
|
---|
2284 | end;
|
---|
2285 |
|
---|
2286 | procedure TDKLanguageController.DoLanguageChanging;
|
---|
2287 | begin
|
---|
2288 | if Assigned(FOnLanguageChanging) then FOnLanguageChanging(Self);
|
---|
2289 | end;
|
---|
2290 |
|
---|
2291 | function TDKLanguageController.GetActualSectionName: WideString;
|
---|
2292 | begin
|
---|
2293 | if FSectionName='' then Result := Owner.Name else Result := FSectionName;
|
---|
2294 | end;
|
---|
2295 |
|
---|
2296 | procedure TDKLanguageController.LangData_Load(Stream: TStream);
|
---|
2297 | begin
|
---|
2298 | FRootCompEntry.LoadFromDFMResource(Stream);
|
---|
2299 | end;
|
---|
2300 |
|
---|
2301 | procedure TDKLanguageController.LangData_Store(Stream: TStream);
|
---|
2302 | begin
|
---|
2303 | UpdateComponents(True);
|
---|
2304 | FRootCompEntry.SaveToDFMResource(Stream);
|
---|
2305 | end;
|
---|
2306 |
|
---|
2307 | procedure TDKLanguageController.Loaded;
|
---|
2308 | begin
|
---|
2309 | inherited Loaded;
|
---|
2310 | // Bind the components and refresh the properties
|
---|
2311 | if Owner<>nil then begin
|
---|
2312 | FRootCompEntry.BindComponents(Owner);
|
---|
2313 | UpdateComponents(False);
|
---|
2314 | // If at runtime, apply the language currently selected in the LangManager, to the controller itself
|
---|
2315 | if not (csDesigning in ComponentState) then LangManager.TranslateController(Self);
|
---|
2316 | end;
|
---|
2317 | end;
|
---|
2318 |
|
---|
2319 | function TDKLanguageController.LSO_CanStore: Boolean;
|
---|
2320 | begin
|
---|
2321 | Result := (Owner<>nil) and (Owner.Name<>'');
|
---|
2322 | // Update the entries
|
---|
2323 | if Result then UpdateComponents(True);
|
---|
2324 | end;
|
---|
2325 |
|
---|
2326 | procedure TDKLanguageController.LSO_StoreLangSource(Strings: TWideStrings; StateFilter: TDKLang_TranslationStates);
|
---|
2327 | begin
|
---|
2328 | FRootCompEntry.StoreLangSource(Strings); // StateFilter is not applicable
|
---|
2329 | end;
|
---|
2330 |
|
---|
2331 | procedure TDKLanguageController.Notification(AComponent: TComponent; Operation: TOperation);
|
---|
2332 | begin
|
---|
2333 | inherited Notification(AComponent, Operation);
|
---|
2334 | // Instantly remove any component that might be contained within entries
|
---|
2335 | if (Operation=opRemove) and (AComponent<>Self) then FRootCompEntry.RemoveComponent(AComponent, True);
|
---|
2336 | end;
|
---|
2337 |
|
---|
2338 | procedure TDKLanguageController.SetIgnoreList(Value: TStrings);
|
---|
2339 | begin
|
---|
2340 | FIgnoreList.Assign(Value);
|
---|
2341 | end;
|
---|
2342 |
|
---|
2343 | procedure TDKLanguageController.SetStoreList(Value: TStrings);
|
---|
2344 | begin
|
---|
2345 | FStoreList.Assign(Value);
|
---|
2346 | end;
|
---|
2347 |
|
---|
2348 | procedure TDKLanguageController.UpdateComponents(bModifyList: Boolean);
|
---|
2349 | var IgnoreMasks, StoreMasks: TDKLang_MaskList;
|
---|
2350 | begin
|
---|
2351 | // Create mask lists for testing property names
|
---|
2352 | IgnoreMasks := TDKLang_MaskList.Create(FIgnoreList);
|
---|
2353 | try
|
---|
2354 | StoreMasks := TDKLang_MaskList.Create(FStoreList);
|
---|
2355 | try
|
---|
2356 | FRootCompEntry.UpdateEntries(bModifyList, dklcoIgnoreEmptyProps in FOptions, dklcoIgnoreNonAlphaProps in FOptions, dklcoIgnoreFontProps in FOptions, IgnoreMasks, StoreMasks);
|
---|
2357 | finally
|
---|
2358 | StoreMasks.Free;
|
---|
2359 | end;
|
---|
2360 | finally
|
---|
2361 | IgnoreMasks.Free;
|
---|
2362 | end;
|
---|
2363 | end;
|
---|
2364 |
|
---|
2365 | //===================================================================================================================
|
---|
2366 | // TDKLang_LangResources
|
---|
2367 | //===================================================================================================================
|
---|
2368 |
|
---|
2369 | function TDKLang_LangResources.Add(Kind: TDKLang_LangResourceKind; Instance: HINST; const wsName: WideString; iResID: Integer; wLangID: LANGID): Integer;
|
---|
2370 | var p: PDKLang_LangResource;
|
---|
2371 | begin
|
---|
2372 | // First try to find the same language already registered
|
---|
2373 | Result := IndexOfLangID(wLangID);
|
---|
2374 | // If not found, create new
|
---|
2375 | if Result<0 then begin
|
---|
2376 | New(p);
|
---|
2377 | Result := inherited Add(p);
|
---|
2378 | p.wLangID := wLangID;
|
---|
2379 | // Else get the existing record
|
---|
2380 | end else
|
---|
2381 | p := GetItems(Result);
|
---|
2382 | // Update the resource properties
|
---|
2383 | p.Kind := Kind;
|
---|
2384 | p.Instance := Instance;
|
---|
2385 | p.wsName := wsName;
|
---|
2386 | p.iResID := iResID;
|
---|
2387 | end;
|
---|
2388 |
|
---|
2389 | function TDKLang_LangResources.FindLangID(wLangID: LANGID): PDKLang_LangResource;
|
---|
2390 | var idx: Integer;
|
---|
2391 | begin
|
---|
2392 | idx := IndexOfLangID(wLangID);
|
---|
2393 | if idx<0 then Result := nil else Result := GetItems(idx);
|
---|
2394 | end;
|
---|
2395 |
|
---|
2396 | function TDKLang_LangResources.GetItems(Index: Integer): PDKLang_LangResource;
|
---|
2397 | begin
|
---|
2398 | Result := Get(Index);
|
---|
2399 | end;
|
---|
2400 |
|
---|
2401 | function TDKLang_LangResources.IndexOfLangID(wLangID: LANGID): Integer;
|
---|
2402 | begin
|
---|
2403 | for Result := 0 to Count-1 do
|
---|
2404 | if GetItems(Result).wLangID=wLangID then Exit;
|
---|
2405 | Result := -1;
|
---|
2406 | end;
|
---|
2407 |
|
---|
2408 | procedure TDKLang_LangResources.Notify(Ptr: Pointer; Action: TListNotification);
|
---|
2409 | begin
|
---|
2410 | // Don't call inherited Notify() here as it does nothing
|
---|
2411 | if Action=lnDeleted then Dispose(PDKLang_LangResource(Ptr));
|
---|
2412 | end;
|
---|
2413 |
|
---|
2414 | //===================================================================================================================
|
---|
2415 | // TDKLanguageManager
|
---|
2416 | //===================================================================================================================
|
---|
2417 |
|
---|
2418 | procedure TDKLanguageManager.AddLangController(Controller: TDKLanguageController);
|
---|
2419 | begin
|
---|
2420 | FSynchronizer.BeginWrite;
|
---|
2421 | try
|
---|
2422 | FLangControllers.Add(Controller);
|
---|
2423 | finally
|
---|
2424 | FSynchronizer.EndWrite;
|
---|
2425 | end;
|
---|
2426 | end;
|
---|
2427 |
|
---|
2428 | procedure TDKLanguageManager.ApplyTran(Translations: TDKLang_CompTranslations);
|
---|
2429 | var
|
---|
2430 | i: Integer;
|
---|
2431 | Consts: TDKLang_Constants;
|
---|
2432 | begin
|
---|
2433 | FSynchronizer.BeginRead;
|
---|
2434 | try
|
---|
2435 | // First apply the language to constants as they may be used in controllers' OnLanguageChanged event handlers
|
---|
2436 | if Translations=nil then Consts := nil else Consts := Translations.Constants;
|
---|
2437 | FConstants.TranslateFrom(Consts);
|
---|
2438 | // Apply translation to the controllers
|
---|
2439 | for i := 0 to FLangControllers.Count-1 do ApplyTranToController(Translations, FLangControllers[i]);
|
---|
2440 | finally
|
---|
2441 | FSynchronizer.EndRead;
|
---|
2442 | end;
|
---|
2443 | end;
|
---|
2444 |
|
---|
2445 | procedure TDKLanguageManager.ApplyTranToController(Translations: TDKLang_CompTranslations; Controller: TDKLanguageController);
|
---|
2446 | var
|
---|
2447 | CE: TDKLang_CompEntry;
|
---|
2448 | CT: TDKLang_CompTranslation;
|
---|
2449 | begin
|
---|
2450 | Controller.DoLanguageChanging;
|
---|
2451 | try
|
---|
2452 | // Get the controller's root component entry
|
---|
2453 | CE := Controller.RootCompEntry;
|
---|
2454 | // If Translations supplied, try to find the translation for the entry
|
---|
2455 | if Translations=nil then CT := nil else CT := Translations.FindComponentName(Controller.ActualSectionName);
|
---|
2456 | // Finally apply the translation, either found or default
|
---|
2457 | CE.ApplyTranslation(CT, CodePage);
|
---|
2458 | finally
|
---|
2459 | Controller.DoLanguageChanged;
|
---|
2460 | end;
|
---|
2461 | end;
|
---|
2462 |
|
---|
2463 | constructor TDKLanguageManager.Create;
|
---|
2464 | begin
|
---|
2465 | inherited Create;
|
---|
2466 | FSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;
|
---|
2467 | FConstants := TDKLang_Constants.Create(GetLanguageID);
|
---|
2468 | FLangControllers := TList.Create;
|
---|
2469 | FLangResources := TDKLang_LangResources.Create;
|
---|
2470 | FDefaultLanguageID := ILangID_USEnglish;
|
---|
2471 | FLanguageID := FDefaultLanguageID;
|
---|
2472 | UpdateCodePage;
|
---|
2473 | // Load the constants from the executable's resources
|
---|
2474 | FConstants.LoadFromResource(HInstance, SDKLang_ConstResourceName);
|
---|
2475 | // Load the default translations
|
---|
2476 | ApplyTran(nil);
|
---|
2477 | end;
|
---|
2478 |
|
---|
2479 | destructor TDKLanguageManager.Destroy;
|
---|
2480 | begin
|
---|
2481 | FConstants.Free;
|
---|
2482 | FLangControllers.Free;
|
---|
2483 | FLangResources.Free;
|
---|
2484 | FSynchronizer.Free;
|
---|
2485 | inherited Destroy;
|
---|
2486 | end;
|
---|
2487 |
|
---|
2488 | function TDKLanguageManager.GetConstantValue(const sName: String): WideString;
|
---|
2489 | begin
|
---|
2490 | FSynchronizer.BeginRead;
|
---|
2491 | try
|
---|
2492 | Result := FConstants.Values[sName];
|
---|
2493 | finally
|
---|
2494 | FSynchronizer.EndRead;
|
---|
2495 | end;
|
---|
2496 | end;
|
---|
2497 |
|
---|
2498 | function TDKLanguageManager.GetConstantValueA(const sName: String): String;
|
---|
2499 | begin
|
---|
2500 | Result := WideStringToStringEx(GetConstantValue(sName), CodePage);
|
---|
2501 | end;
|
---|
2502 |
|
---|
2503 | function TDKLanguageManager.GetDefaultLanguageID: LANGID;
|
---|
2504 | begin
|
---|
2505 | FSynchronizer.BeginRead;
|
---|
2506 | Result := FDefaultLanguageID;
|
---|
2507 | FSynchronizer.EndRead;
|
---|
2508 | end;
|
---|
2509 |
|
---|
2510 | function TDKLanguageManager.GetLanguageCount: Integer;
|
---|
2511 | begin
|
---|
2512 | FSynchronizer.BeginRead;
|
---|
2513 | try
|
---|
2514 | Result := FLangResources.Count+1; // Increment by 1 for the default language
|
---|
2515 | finally
|
---|
2516 | FSynchronizer.EndRead;
|
---|
2517 | end;
|
---|
2518 | end;
|
---|
2519 |
|
---|
2520 | function TDKLanguageManager.GetLanguageID: LANGID;
|
---|
2521 | begin
|
---|
2522 | FSynchronizer.BeginRead;
|
---|
2523 | Result := FLanguageID;
|
---|
2524 | FSynchronizer.EndRead;
|
---|
2525 | end;
|
---|
2526 |
|
---|
2527 | function TDKLanguageManager.GetLanguageIDs(Index: Integer): LANGID;
|
---|
2528 | begin
|
---|
2529 | FSynchronizer.BeginRead;
|
---|
2530 | try
|
---|
2531 | // Index=0 always means the default language
|
---|
2532 | if Index=0 then
|
---|
2533 | Result := FDefaultLanguageID
|
---|
2534 | else
|
---|
2535 | Result := FLangResources[Index-1].wLangID;
|
---|
2536 | finally
|
---|
2537 | FSynchronizer.EndRead;
|
---|
2538 | end;
|
---|
2539 | end;
|
---|
2540 |
|
---|
2541 | function TDKLanguageManager.GetLanguageIndex: Integer;
|
---|
2542 | begin
|
---|
2543 | FSynchronizer.BeginRead;
|
---|
2544 | try
|
---|
2545 | Result := IndexOfLanguageID(FLanguageID);
|
---|
2546 | finally
|
---|
2547 | FSynchronizer.EndRead;
|
---|
2548 | end;
|
---|
2549 | end;
|
---|
2550 |
|
---|
2551 | function TDKLanguageManager.GetLanguageNames(Index: Integer): WideString;
|
---|
2552 | var wLangID: LANGID;
|
---|
2553 | begin
|
---|
2554 | FSynchronizer.BeginRead;
|
---|
2555 | try
|
---|
2556 | wLangID := GetLanguageIDs(Index);
|
---|
2557 | finally
|
---|
2558 | FSynchronizer.EndRead;
|
---|
2559 | end;
|
---|
2560 | Result := WideGetLocaleStr(wLangID, LOCALE_SLANGUAGE, IntToStr(wLangID));
|
---|
2561 | end;
|
---|
2562 |
|
---|
2563 | function TDKLanguageManager.GetLanguageResources(Index: Integer): PDKLang_LangResource;
|
---|
2564 | begin
|
---|
2565 | FSynchronizer.BeginRead;
|
---|
2566 | try
|
---|
2567 | // Index=0 always means the default language
|
---|
2568 | if Index=0 then Result := nil else Result := FLangResources[Index-1];
|
---|
2569 | finally
|
---|
2570 | FSynchronizer.EndRead;
|
---|
2571 | end;
|
---|
2572 | end;
|
---|
2573 |
|
---|
2574 | function TDKLanguageManager.GetTranslationsForLang(wLangID: LANGID): TDKLang_CompTranslations;
|
---|
2575 | var plr: PDKLang_LangResource;
|
---|
2576 | begin
|
---|
2577 | Result := nil;
|
---|
2578 | if wLangID<>DefaultLanguageID then begin
|
---|
2579 | // Try to locate the appropriate resource entry
|
---|
2580 | plr := FLangResources.FindLangID(wLangID);
|
---|
2581 | if plr<>nil then begin
|
---|
2582 | Result := TDKLang_CompTranslations.Create;
|
---|
2583 | try
|
---|
2584 | case plr.Kind of
|
---|
2585 | dklrkResName: Result.Text_LoadFromResource(plr.Instance, plr.wsName);
|
---|
2586 | dklrkResID: Result.Text_LoadFromResource(plr.Instance, plr.iResID);
|
---|
2587 | dklrkFile: Result.Text_LoadFromFile(plr.wsName);
|
---|
2588 | end;
|
---|
2589 | except
|
---|
2590 | Result.Free;
|
---|
2591 | raise;
|
---|
2592 | end;
|
---|
2593 | end;
|
---|
2594 | end;
|
---|
2595 | end;
|
---|
2596 |
|
---|
2597 | function TDKLanguageManager.IndexOfLanguageID(wLangID: LANGID): Integer;
|
---|
2598 | begin
|
---|
2599 | FSynchronizer.BeginRead;
|
---|
2600 | try
|
---|
2601 | if wLangID=FDefaultLanguageID then Result := 0 else Result := FLangResources.IndexOfLangID(wLangID)+1;
|
---|
2602 | finally
|
---|
2603 | FSynchronizer.EndRead;
|
---|
2604 | end;
|
---|
2605 | end;
|
---|
2606 |
|
---|
2607 | function TDKLanguageManager.RegisterLangFile(const wsFileName: WideString): Boolean;
|
---|
2608 | var
|
---|
2609 | Tran: TDKLang_CompTranslations;
|
---|
2610 | wLangID: LANGID;
|
---|
2611 | begin
|
---|
2612 | Result := False;
|
---|
2613 | FSynchronizer.BeginWrite;
|
---|
2614 | try
|
---|
2615 | // Create and load the component translations object
|
---|
2616 | if WideFileExists(wsFileName) then begin
|
---|
2617 | Tran := TDKLang_CompTranslations.Create;
|
---|
2618 | try
|
---|
2619 | Tran.Text_LoadFromFile(wsFileName, True);
|
---|
2620 | // Try to obtain LangID parameter
|
---|
2621 | wLangID := StrToIntDef(Tran.Params.Values[SDKLang_TranParam_LangID], 0);
|
---|
2622 | // If succeeded, add the file as a resource
|
---|
2623 | if wLangID>0 then begin
|
---|
2624 | // But only if it isn't default language
|
---|
2625 | if wLangID<>FDefaultLanguageID then FLangResources.Add(dklrkFile, 0, wsFileName, 0, wLangID);
|
---|
2626 | Result := True;
|
---|
2627 | end;
|
---|
2628 | finally
|
---|
2629 | Tran.Free;
|
---|
2630 | end;
|
---|
2631 | end;
|
---|
2632 | finally
|
---|
2633 | FSynchronizer.EndWrite;
|
---|
2634 | end;
|
---|
2635 | end;
|
---|
2636 |
|
---|
2637 | procedure TDKLanguageManager.RegisterLangResource(Instance: HINST; const wsResourceName: WideString; wLangID: LANGID);
|
---|
2638 | begin
|
---|
2639 | FSynchronizer.BeginWrite;
|
---|
2640 | try
|
---|
2641 | if wLangID<>FDefaultLanguageID then FLangResources.Add(dklrkResName, Instance, wsResourceName, 0, wLangID);
|
---|
2642 | finally
|
---|
2643 | FSynchronizer.EndWrite;
|
---|
2644 | end;
|
---|
2645 | end;
|
---|
2646 |
|
---|
2647 | procedure TDKLanguageManager.RegisterLangResource(Instance: HINST; iResID: Integer; wLangID: LANGID);
|
---|
2648 | begin
|
---|
2649 | FSynchronizer.BeginWrite;
|
---|
2650 | try
|
---|
2651 | if wLangID<>FDefaultLanguageID then FLangResources.Add(dklrkResID, Instance, '', iResID, wLangID);
|
---|
2652 | finally
|
---|
2653 | FSynchronizer.EndWrite;
|
---|
2654 | end;
|
---|
2655 | end;
|
---|
2656 |
|
---|
2657 | procedure TDKLanguageManager.RemoveLangController(Controller: TDKLanguageController);
|
---|
2658 | begin
|
---|
2659 | FSynchronizer.BeginWrite;
|
---|
2660 | try
|
---|
2661 | FLangControllers.Remove(Controller);
|
---|
2662 | finally
|
---|
2663 | FSynchronizer.EndWrite;
|
---|
2664 | end;
|
---|
2665 | end;
|
---|
2666 |
|
---|
2667 | function TDKLanguageManager.ScanForLangFiles(const wsDir, wsMask: WideString; bRecursive: Boolean): Integer;
|
---|
2668 | var
|
---|
2669 | wsPath: WideString;
|
---|
2670 | SRec: TSearchRecW;
|
---|
2671 | begin
|
---|
2672 | Result := 0;
|
---|
2673 | // Determine the path
|
---|
2674 | wsPath := WideIncludeTrailingPathDelimiter(wsDir);
|
---|
2675 | // Scan the directory
|
---|
2676 | if WideFindFirst(wsPath+wsMask, faAnyFile, SRec)=0 then
|
---|
2677 | try
|
---|
2678 | repeat
|
---|
2679 | // Plain file. Try to register it
|
---|
2680 | if SRec.Attr and faDirectory=0 then begin
|
---|
2681 | if RegisterLangFile(wsPath+SRec.Name) then Inc(Result);
|
---|
2682 | // Directory. Recurse if needed
|
---|
2683 | end else if bRecursive and (SRec.Name[1]<>'.') then
|
---|
2684 | Inc(Result, ScanForLangFiles(wsPath+SRec.Name, wsMask, True));
|
---|
2685 | until WideFindNext(SRec)<>0;
|
---|
2686 | finally
|
---|
2687 | WideFindClose(SRec);
|
---|
2688 | end;
|
---|
2689 | end;
|
---|
2690 |
|
---|
2691 | procedure TDKLanguageManager.SetDefaultLanguageID(Value: LANGID);
|
---|
2692 | begin
|
---|
2693 | FSynchronizer.BeginWrite;
|
---|
2694 | if FDefaultLanguageID<>Value then FDefaultLanguageID := Value;
|
---|
2695 | FSynchronizer.EndWrite;
|
---|
2696 | end;
|
---|
2697 |
|
---|
2698 | procedure TDKLanguageManager.SetLanguageID(Value: LANGID);
|
---|
2699 | var
|
---|
2700 | bChanged: Boolean;
|
---|
2701 | Tran: TDKLang_CompTranslations;
|
---|
2702 | begin
|
---|
2703 | Tran := nil;
|
---|
2704 | try
|
---|
2705 | FSynchronizer.BeginWrite;
|
---|
2706 | try
|
---|
2707 | // Try to obtain the Translations object
|
---|
2708 | Tran := GetTranslationsForLang(Value);
|
---|
2709 | // If nil returned, assume this a default language
|
---|
2710 | if Tran=nil then Value := FDefaultLanguageID;
|
---|
2711 | // If something changed, update the property
|
---|
2712 | bChanged := FLanguageID<>Value;
|
---|
2713 | if bChanged then begin
|
---|
2714 | FLanguageID := Value;
|
---|
2715 | UpdateCodePage;
|
---|
2716 | end;
|
---|
2717 | finally
|
---|
2718 | FSynchronizer.EndWrite;
|
---|
2719 | end;
|
---|
2720 | // Apply the language change after synchronizing ends because applying might require constants etc.
|
---|
2721 | if bChanged then ApplyTran(Tran);
|
---|
2722 | finally
|
---|
2723 | Tran.Free;
|
---|
2724 | end;
|
---|
2725 | end;
|
---|
2726 |
|
---|
2727 | procedure TDKLanguageManager.SetLanguageIndex(Value: Integer);
|
---|
2728 | begin
|
---|
2729 | SetLanguageID(GetLanguageIDs(Value));
|
---|
2730 | end;
|
---|
2731 |
|
---|
2732 | procedure TDKLanguageManager.TranslateController(Controller: TDKLanguageController);
|
---|
2733 | var Tran: TDKLang_CompTranslations;
|
---|
2734 | begin
|
---|
2735 | FSynchronizer.BeginRead;
|
---|
2736 | try
|
---|
2737 | // If current language is not default, the translation is required
|
---|
2738 | if FLanguageID<>FDefaultLanguageID then begin
|
---|
2739 | Tran := GetTranslationsForLang(FLanguageID);
|
---|
2740 | try
|
---|
2741 | if Tran<>nil then ApplyTranToController(Tran, Controller);
|
---|
2742 | finally
|
---|
2743 | Tran.Free;
|
---|
2744 | end;
|
---|
2745 | end;
|
---|
2746 | finally
|
---|
2747 | FSynchronizer.EndRead;
|
---|
2748 | end;
|
---|
2749 | end;
|
---|
2750 |
|
---|
2751 | procedure TDKLanguageManager.UnregisterLangResource(wLangID: LANGID);
|
---|
2752 | var idx: Integer;
|
---|
2753 | begin
|
---|
2754 | FSynchronizer.BeginWrite;
|
---|
2755 | try
|
---|
2756 | if wLangID<>FDefaultLanguageID then begin
|
---|
2757 | idx := FLangResources.IndexOfLangID(wLangID);
|
---|
2758 | if idx>=0 then FLangResources.Delete(idx);
|
---|
2759 | end;
|
---|
2760 | finally
|
---|
2761 | FSynchronizer.EndWrite;
|
---|
2762 | end;
|
---|
2763 | end;
|
---|
2764 |
|
---|
2765 | procedure TDKLanguageManager.UpdateCodePage;
|
---|
2766 | begin
|
---|
2767 | FCodePage := LCIDToCodePage(FLanguageID);
|
---|
2768 | end;
|
---|
2769 |
|
---|
2770 | initialization
|
---|
2771 | finalization
|
---|
2772 | _LangManager.Free;
|
---|
2773 | end.
|
---|