source: cprs/branches/tmg-cprs/dklang-package-3.01/DKL_ConstEditor.pas

Last change on this file was 468, checked in by Kevin Toppenberg, 16 years ago

CPRS v1.0.26.76
File size: 15.2 KB
Line 
1///*********************************************************************************************************************
2/// $Id: DKL_ConstEditor.pas,v 1.13 2006/08/05 21:42:34 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///
23///**********************************************************************************************************************
24// Designtime project constant editor dialog declaration
25//
26unit DKL_ConstEditor;
27
28interface
29
30uses
31 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TntDialogs, DKLang,
32 StdCtrls,
33 TntGrids, Grids;
34
35type
36 TdDKL_ConstEditor = class(TForm)
37 bCancel: TButton;
38 bErase: TButton;
39 bLoad: TButton;
40 bOK: TButton;
41 bSave: TButton;
42 cbSaveToLangSource: TCheckBox;
43 gMain: TTntStringGrid;
44 lCount: TLabel;
45 lDeleteHint: TLabel;
46 procedure bEraseClick(Sender: TObject);
47 procedure bLoadClick(Sender: TObject);
48 procedure bOKClick(Sender: TObject);
49 procedure bSaveClick(Sender: TObject);
50 procedure gMainKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
51 procedure gMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
52 procedure gMainSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
53 private
54 // The constants being edited
55 FConsts: TDKLang_Constants;
56 // True if the constants are to be erased from the project resources
57 FErase: Boolean;
58 // Initializes the dialog
59 procedure InitializeDialog(AConsts: TDKLang_Constants; bEraseAllowed: Boolean);
60 // Updates the count info
61 procedure UpdateCount;
62 // Storing/restoring the settings
63 procedure SaveSettings;
64 procedure LoadSettings;
65 // Updates gMain columns' widths so that they both fit into the client area
66 procedure UpdateGridColumnWidths;
67 // Raises an exception if entry (constant) index is not valid
68 procedure CheckEntryIndexValidity(iIndex: Integer);
69 // Ensures a virtual row is available at the end of the table
70 procedure EnsureVirtualRowExists;
71 // Returns True if the specified row has neither name nor value
72 function IsRowEmpty(iRow: Integer): Boolean;
73 // Raises an exception if constant names are not valid (includes uniqueness checking)
74 procedure CheckNamesValid;
75 // Deletes the specified entry
76 procedure DeleteEntry(iIndex: Integer);
77 // Prop handlers
78 function GetEntryCount: Integer;
79 function GetEntryNames(Index: Integer): String;
80 function GetEntryValues(Index: Integer; bEncoded: Boolean): WideString;
81 procedure SetEntryCount(iCount: Integer);
82 procedure SetEntryNames(Index: Integer; const sValue: String);
83 procedure SetEntryValues(Index: Integer; bEncoded: Boolean; const wsValue: WideString);
84 protected
85 procedure DoClose(var Action: TCloseAction); override;
86 procedure DoShow; override;
87 procedure Resize; override;
88 public
89 // Props
90 // -- Entry (constant) count
91 property EntryCount: Integer read GetEntryCount write SetEntryCount;
92 // -- Constant names by index
93 property EntryNames[Index: Integer]: String read GetEntryNames write SetEntryNames;
94 // -- Constant names by index. If bEncoded=True, the constant value is represented 'encoded', with no literal
95 // control chars; if bEncoded=False, the value is represented 'as is', with linebreaks, tabs, etc. in it
96 property EntryValues[Index: Integer; bEncoded: Boolean]: WideString read GetEntryValues write SetEntryValues;
97 end;
98
99const
100 SRegKey_DKLangConstEditor = 'Software\DKSoftware\DKLang\ConstEditor';
101
102 // Show constant editor dialog
103 // AConsts - The constants being edited
104 // bEraseAllowed - Entry: is erase allowed (ie constant resource exists); return: True if user has pressed Erase
105 // button
106 function EditConstants(AConsts: TDKLang_Constants; var bEraseAllowed: Boolean): Boolean;
107
108implementation
109{$R *.dfm}
110uses Registry, TntClasses;
111
112const
113 // gMain's column indexes
114 IColIdx_Name = 0;
115 IColIdx_Value = 1;
116
117 function EditConstants(AConsts: TDKLang_Constants; var bEraseAllowed: Boolean): Boolean;
118 begin
119 with TdDKL_ConstEditor.Create(Application) do
120 try
121 InitializeDialog(AConsts, bEraseAllowed);
122 Result := ShowModal=mrOK;
123 bEraseAllowed := FErase;
124 finally
125 Free;
126 end;
127 end;
128
129 //===================================================================================================================
130 // TdDKL_ConstEditor
131 //===================================================================================================================
132
133 procedure TdDKL_ConstEditor.bEraseClick(Sender: TObject);
134 begin
135 if Application.MessageBox('Are you sure you want to delete the constants from project resources?', 'Confirm', MB_ICONEXCLAMATION or MB_OKCANCEL)=IDOK then begin
136 FErase := True;
137 ModalResult := mrOK;
138 end;
139 end;
140
141 procedure TdDKL_ConstEditor.bLoadClick(Sender: TObject);
142
143 procedure DoLoad(const wsFileName: WideString);
144 var
145 SL: TTntStringList;
146 i: Integer;
147 begin
148 SL := TTntStringList.Create;
149 try
150 SL.LoadFromFile(wsFileName);
151 EntryCount := SL.Count;
152 for i := 0 to SL.Count-1 do begin
153 EntryNames [i] := SL.Names[i];
154 EntryValues[i, True] := SL.ValueFromIndex[i]; // Assume the value is already encoded in the file
155 end;
156 finally
157 SL.Free;
158 end;
159 end;
160
161 begin
162 with TTntOpenDialog.Create(Self) do
163 try
164 DefaultExt := 'txt';
165 Filter := 'All files (*.*)|*.*';
166 Options := [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing];
167 Title := 'Select a text file to load from';
168 if Execute then DoLoad(FileName);
169 finally
170 Free;
171 end;
172 end;
173
174 procedure TdDKL_ConstEditor.bOKClick(Sender: TObject);
175 var i: Integer;
176 begin
177 // Check that all names are valid
178 CheckNamesValid;
179 // Copy the constans from the editor back into FConsts
180 FConsts.Clear;
181 FConsts.AutoSaveLangSource := cbSaveToLangSource.Checked;
182 for i := 0 to EntryCount-1 do FConsts.Add(EntryNames[i], EntryValues[i, False], []);
183 ModalResult := mrOK;
184 end;
185
186 procedure TdDKL_ConstEditor.bSaveClick(Sender: TObject);
187
188 procedure DoSave(const wsFileName: WideString);
189 var
190 SL: TTntStringList;
191 i: Integer;
192 begin
193 SL := TTntStringList.Create;
194 try
195 for i := 0 to EntryCount-1 do SL.Add(EntryNames[i]+'='+EntryValues[i, True]);
196 SL.SaveToFile(wsFileName);
197 finally
198 SL.Free;
199 end;
200 end;
201
202 begin
203 with TTntSaveDialog.Create(Self) do
204 try
205 DefaultExt := 'txt';
206 Filter := 'All files (*.*)|*.*';
207 Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing];
208 Title := 'Select a text file to save to';
209 if Execute then DoSave(FileName);
210 finally
211 Free;
212 end;
213 end;
214
215 procedure TdDKL_ConstEditor.CheckEntryIndexValidity(iIndex: Integer);
216 begin
217 if (iIndex<0) or (iIndex>=EntryCount) then DKLangError('Invalid entry index (%d)', [iIndex]);
218 end;
219
220 procedure TdDKL_ConstEditor.CheckNamesValid;
221 var
222 SL: TStringList; // No need to deal with wide strings here
223 s: String;
224 i: Integer;
225 begin
226 SL := TStringList.Create;
227 try
228 SL.Sorted := True;
229 for i := 0 to EntryCount-1 do begin
230 s := EntryNames[i];
231 if s='' then DKLangError('Constant name cannot be empty');
232 if not IsValidIdent(s) then DKLangError('Invalid constant name: "%s"', [s]);
233 if SL.IndexOf(s)<0 then SL.Add(s) else DKLangError('Duplicate constant name: "%s"', [s]);
234 end;
235 finally
236 SL.Free;
237 end;
238 end;
239
240 procedure TdDKL_ConstEditor.DeleteEntry(iIndex: Integer);
241 var i: Integer;
242 begin
243 CheckEntryIndexValidity(iIndex);
244 // Shift the grid contents
245 for i := iIndex to EntryCount-2 do begin
246 EntryNames [i] := EntryNames [i+1];
247 EntryValues[i, True] := EntryValues[i+1, True];
248 end;
249 // Remove the last row
250 EntryCount := EntryCount-1;
251 end;
252
253 procedure TdDKL_ConstEditor.DoClose(var Action: TCloseAction);
254 begin
255 inherited DoClose(Action);
256 SaveSettings;
257 end;
258
259 procedure TdDKL_ConstEditor.DoShow;
260 begin
261 inherited DoShow;
262 LoadSettings;
263 end;
264
265 procedure TdDKL_ConstEditor.EnsureVirtualRowExists;
266 var i: Integer;
267 begin
268 // Determine the index of last non-empty row
269 i := gMain.RowCount-1;
270 while (i>0) and IsRowEmpty(i) do Dec(i);
271 // Set the number of rows
272 EntryCount := i;
273 end;
274
275 function TdDKL_ConstEditor.GetEntryCount: Integer;
276 begin
277 Result := gMain.RowCount-2; // One for the header, one more for the virtual row
278 end;
279
280 function TdDKL_ConstEditor.GetEntryNames(Index: Integer): String;
281 begin
282 CheckEntryIndexValidity(Index);
283 Result := Trim(gMain.Cells[IColIdx_Name, Index+1]); // One more row to skip the header
284 end;
285
286 function TdDKL_ConstEditor.GetEntryValues(Index: Integer; bEncoded: Boolean): WideString;
287 begin
288 CheckEntryIndexValidity(Index);
289 Result := Trim(gMain.Cells[IColIdx_Value, Index+1]); // One more row to skip the header
290 if not bEncoded then Result := DecodeControlChars(Result);
291 end;
292
293 procedure TdDKL_ConstEditor.gMainKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
294 begin
295 if (Key=VK_DELETE) and (Shift=[ssCtrl]) and (gMain.Row<gMain.RowCount-1) then begin
296 DeleteEntry(gMain.Row-1);
297 Key := 0;
298 end;
299 end;
300
301 procedure TdDKL_ConstEditor.gMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
302 begin
303 // Believe mouse up is linked to column resizing...
304 UpdateGridColumnWidths;
305 end;
306
307 procedure TdDKL_ConstEditor.gMainSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
308 begin
309 EnsureVirtualRowExists;
310 CheckNamesValid;
311 UpdateCount;
312 end;
313
314 procedure TdDKL_ConstEditor.InitializeDialog(AConsts: TDKLang_Constants; bEraseAllowed: Boolean);
315 var i: Integer;
316 begin
317 FConsts := AConsts;
318 cbSaveToLangSource.Checked := FConsts.AutoSaveLangSource;
319 bErase.Enabled := bEraseAllowed;
320 FErase := False;
321 // Setup the editor
322 gMain.Cells[IColIdx_Name, 0] := 'Constant name';
323 gMain.Cells[IColIdx_Value, 0] := 'Constant value';
324 // Copy the constans into the editor
325 EntryCount := FConsts.Count;
326 for i := 0 to FConsts.Count-1 do begin
327 EntryNames [i] := FConsts[i].sName;
328 EntryValues[i, False] := FConsts[i].wsValue;
329 end;
330 // Update count info
331 UpdateCount;
332 end;
333
334 function TdDKL_ConstEditor.IsRowEmpty(iRow: Integer): Boolean;
335 begin
336 Result := (Trim(gMain.Cells[IColIdx_Name, iRow])='') and (Trim(gMain.Cells[IColIdx_Value, iRow])='');
337 end;
338
339 procedure TdDKL_ConstEditor.LoadSettings;
340 var
341 rif: TRegIniFile;
342 rBounds: TRect;
343 begin
344 rif := TRegIniFile.Create(SRegKey_DKLangConstEditor);
345 try
346 // Restore form bounds
347 rBounds := Rect(
348 rif.ReadInteger('', 'Left', MaxInt),
349 rif.ReadInteger('', 'Top', MaxInt),
350 rif.ReadInteger('', 'Right', MaxInt),
351 rif.ReadInteger('', 'Bottom', MaxInt));
352 // If all the coords are valid
353 if (rBounds.Left<MaxInt) and (rBounds.Top<MaxInt) and (rBounds.Right<MaxInt) and (rBounds.Bottom<MaxInt) then
354 BoundsRect := rBounds;
355 // Load other settings
356 gMain.ColWidths[IColIdx_Name] := rif.ReadInteger('', 'NameColWidth', gMain.ClientWidth div 2);
357 UpdateGridColumnWidths;
358 finally
359 rif.Free;
360 end;
361 end;
362
363 procedure TdDKL_ConstEditor.Resize;
364 begin
365 inherited Resize;
366 UpdateGridColumnWidths;
367 end;
368
369 procedure TdDKL_ConstEditor.SaveSettings;
370 var
371 rif: TRegIniFile;
372 rBounds: TRect;
373 begin
374 rif := TRegIniFile.Create(SRegKey_DKLangConstEditor);
375 try
376 // Store form bounds
377 rBounds := BoundsRect;
378 rif.WriteInteger('', 'Left', rBounds.Left);
379 rif.WriteInteger('', 'Top', rBounds.Top);
380 rif.WriteInteger('', 'Right', rBounds.Right);
381 rif.WriteInteger('', 'Bottom', rBounds.Bottom);
382 // Store other settings
383 rif.WriteInteger('', 'NameColWidth', gMain.ColWidths[IColIdx_Name]);
384 finally
385 rif.Free;
386 end;
387 end;
388
389 procedure TdDKL_ConstEditor.SetEntryCount(iCount: Integer);
390 begin
391 gMain.RowCount := iCount+2; // One for the header, one more for the virtual row
392 // Cleanup the virtual row
393 gMain.Cells[IColIdx_Name, iCount+1] := '';
394 gMain.Cells[IColIdx_Value, iCount+1] := '';
395 end;
396
397 procedure TdDKL_ConstEditor.SetEntryNames(Index: Integer; const sValue: String);
398 begin
399 CheckEntryIndexValidity(Index);
400 gMain.Cells[IColIdx_Name, Index+1] := sValue; // One more row to skip the header
401 end;
402
403 procedure TdDKL_ConstEditor.SetEntryValues(Index: Integer; bEncoded: Boolean; const wsValue: WideString);
404 var ws: WideString;
405 begin
406 CheckEntryIndexValidity(Index);
407 ws := wsValue;
408 if not bEncoded then ws := EncodeControlChars(ws);
409 gMain.Cells[IColIdx_Value, Index+1] := ws; // One more row to skip the header
410 end;
411
412 procedure TdDKL_ConstEditor.UpdateCount;
413 begin
414 lCount.Caption := Format('%d constants', [EntryCount]);
415 end;
416
417 procedure TdDKL_ConstEditor.UpdateGridColumnWidths;
418 var iwClient, iwName: Integer;
419 begin
420 iwClient := gMain.ClientWidth;
421 iwName := gMain.ColWidths[IColIdx_Name];
422 // Do not allow columns be narrower than 20 pixels
423 if iwName<20 then iwName := 20
424 else if iwName>iwClient-20 then iwName := iwClient-22;
425 // Update column widths
426 gMain.ColWidths[IColIdx_Name] := iwName;
427 gMain.ColWidths[IColIdx_Value] := iwClient-iwName-2;
428 end;
429
430end.
Note: See TracBrowser for help on using the repository browser.