source: cprs/branches/tmg-cprs/dklang-package-3.01/Examples/Notepad/Main.pas@ 1800

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

CPRS v1.0.26.76
File size: 11.0 KB
Line 
1//**********************************************************************************************************************
2// $Id: Main.pas,v 1.2 2006/08/11 12:15:51 dale Exp $
3//----------------------------------------------------------------------------------------------------------------------
4// DKLang Localization Package
5// Copyright 2002-2006 DK Software, http://www.dk-soft.org
6//**********************************************************************************************************************
7unit Main;
8
9{$INCLUDE TntCompilers.inc}
10
11interface
12
13uses
14 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TntForms,
15 StdCtrls, DKLang, TntDialogs, ActnList, TntActnList, Menus, TntMenus,
16 TntStdCtrls, ComCtrls, TntComCtrls;
17
18type
19 TfMain = class(TTntForm)
20 aEditCopy: TTntAction;
21 aEditCut: TTntAction;
22 aEditDateAndTime: TTntAction;
23 aEditFind: TTntAction;
24 aEditFindNext: TTntAction;
25 aEditGoToLine: TTntAction;
26 aEditPaste: TTntAction;
27 aEditReplace: TTntAction;
28 aEditSelectAll: TTntAction;
29 aEditUndo: TTntAction;
30 aFileExit: TTntAction;
31 aFileNew: TTntAction;
32 aFileOpen: TTntAction;
33 aFileSave: TTntAction;
34 aFileSaveAs: TTntAction;
35 aFormatFont: TTntAction;
36 aFormatWordWrap: TTntAction;
37 aHelpAbout: TTntAction;
38 alMain: TTntActionList;
39 aViewStatusBar: TTntAction;
40 dklcMain: TDKLanguageController;
41 fdMain: TFontDialog;
42 iEditCopy: TTntMenuItem;
43 iEditCut: TTntMenuItem;
44 iEditDateAndTime: TTntMenuItem;
45 iEditFind: TTntMenuItem;
46 iEditFindNext: TTntMenuItem;
47 iEditGoToLine: TTntMenuItem;
48 iEditPaste: TTntMenuItem;
49 iEditReplace: TTntMenuItem;
50 iEditSelectAll: TTntMenuItem;
51 iEditUndo: TTntMenuItem;
52 iFileExit: TTntMenuItem;
53 iFileNew: TTntMenuItem;
54 iFileOpen: TTntMenuItem;
55 iFileSave: TTntMenuItem;
56 iFileSaveAs: TTntMenuItem;
57 iFormatFont: TTntMenuItem;
58 iFormatWordWrap: TTntMenuItem;
59 iHelpAbout: TTntMenuItem;
60 iSepEditCut: TTntMenuItem;
61 iSepEditFind: TTntMenuItem;
62 iSepEditSelectAll: TTntMenuItem;
63 iSepFileExit: TTntMenuItem;
64 iSepViewLanguage: TTntMenuItem;
65 iViewStatusBar: TTntMenuItem;
66 mMain: TTntMemo;
67 mmMain: TTntMainMenu;
68 odMain: TTntOpenDialog;
69 sdMain: TTntSaveDialog;
70 smEdit: TTntMenuItem;
71 smFile: TTntMenuItem;
72 smFormat: TTntMenuItem;
73 smHelp: TTntMenuItem;
74 smView: TTntMenuItem;
75 smViewLanguage: TTntMenuItem;
76 TheStatusBar: TTntStatusBar;
77 procedure aEditCopyExecute(Sender: TObject);
78 procedure aEditCutExecute(Sender: TObject);
79 procedure aEditDateAndTimeExecute(Sender: TObject);
80 procedure aEditFindExecute(Sender: TObject);
81 procedure aEditFindNextExecute(Sender: TObject);
82 procedure aEditGoToLineExecute(Sender: TObject);
83 procedure aEditPasteExecute(Sender: TObject);
84 procedure aEditReplaceExecute(Sender: TObject);
85 procedure aEditSelectAllExecute(Sender: TObject);
86 procedure aEditUndoExecute(Sender: TObject);
87 procedure aFileExitExecute(Sender: TObject);
88 procedure aFileNewExecute(Sender: TObject);
89 procedure aFileOpenExecute(Sender: TObject);
90 procedure aFileSaveAsExecute(Sender: TObject);
91 procedure aFileSaveExecute(Sender: TObject);
92 procedure aFormatFontExecute(Sender: TObject);
93 procedure aFormatWordWrapExecute(Sender: TObject);
94 procedure aHelpAboutExecute(Sender: TObject);
95 procedure aViewStatusBarExecute(Sender: TObject);
96 procedure TntFormCreate(Sender: TObject);
97 procedure TntFormCloseQuery(Sender: TObject; var CanClose: Boolean);
98 procedure UpdateStateNotify(Sender: TObject);
99 private
100 // True if open file is Unicode
101 FIsUnicodeFile: Boolean;
102 // Prop storage
103 FFileName: WideString;
104 // Updates form interface
105 procedure UpdateState;
106 // Language item click handler
107 procedure LanguageItemClick(Sender: TObject);
108 // Loads the specified file
109 procedure DoLoadFile(const wsFileName: WideString);
110 // Saves the text into the specified file
111 procedure DoSaveFile(const wsFileName: WideString; bUnicode: Boolean);
112 // Returns True if text can be discarded
113 function CanDiscardText: Boolean;
114 // Prop handlers
115 function GetDisplayFileName: WideString;
116 public
117 // Props
118 // -- Name of the file being edited, always not empty
119 property DisplayFileName: WideString read GetDisplayFileName;
120 end;
121
122var
123 fMain: TfMain;
124
125implementation
126{$R *.dfm}
127uses
128 StrUtils, TntSystem, TntClasses, TntSysUtils
129 {$IFDEF COMPILER_7_UP}
130 , XPMan
131 {$ENDIF}
132 ;
133
134 procedure TfMain.aEditCopyExecute(Sender: TObject);
135 begin
136 mMain.CopyToClipboard;
137 end;
138
139 procedure TfMain.aEditCutExecute(Sender: TObject);
140 begin
141 mMain.CutToClipboard;
142 end;
143
144 procedure TfMain.aEditDateAndTimeExecute(Sender: TObject);
145 begin
146 mMain.SelText := DateTimeToStr(Now);
147 end;
148
149 procedure TfMain.aEditFindExecute(Sender: TObject);
150 begin
151 { Find not implemented since there's no TTntFindDialog yet }
152 end;
153
154 procedure TfMain.aEditFindNextExecute(Sender: TObject);
155 begin
156 { Find not implemented since there's no TTntFindDialog yet }
157 end;
158
159 procedure TfMain.aEditGoToLineExecute(Sender: TObject);
160 var ws: WideString;
161 begin
162 ws := IntToStr(mMain.CaretPos.y+1);
163 if WideInputQuery(DKLangConstW('SDlgTitle_GoToLine'), DKLangConstW('SGoToLinePrompt'), ws) then begin
164 mMain.CaretPos := Point(0, StrToInt(ws)-1);
165 mMain.Perform(EM_SCROLLCARET, 0, 0);
166 end;
167 end;
168
169 procedure TfMain.aEditPasteExecute(Sender: TObject);
170 begin
171 mMain.PasteFromClipboard;
172 end;
173
174 procedure TfMain.aEditReplaceExecute(Sender: TObject);
175 begin
176 { Replace not implemented since there's no TTntReplaceDialog yet }
177 end;
178
179 procedure TfMain.aEditSelectAllExecute(Sender: TObject);
180 begin
181 mMain.SelectAll;
182 end;
183
184 procedure TfMain.aEditUndoExecute(Sender: TObject);
185 begin
186 mMain.Undo;
187 end;
188
189 procedure TfMain.aFileExitExecute(Sender: TObject);
190 begin
191 Close;
192 end;
193
194 procedure TfMain.aFileNewExecute(Sender: TObject);
195 begin
196 if CanDiscardText then begin
197 mMain.Clear;
198 mMain.Modified := False;
199 FIsUnicodeFile := True;
200 FFileName := '';
201 UpdateState;
202 end;
203 end;
204
205 procedure TfMain.aFileOpenExecute(Sender: TObject);
206 begin
207 odMain.FileName := FFileName;
208 if odMain.Execute and CanDiscardText then DoLoadFile(odMain.FileName);
209 end;
210
211 procedure TfMain.aFileSaveAsExecute(Sender: TObject);
212 begin
213 sdMain.FileName := FFileName;
214 if FIsUnicodeFile then sdMain.FilterIndex := 2 else sdMain.FilterIndex := 1;
215 if sdMain.Execute then DoSaveFile(sdMain.FileName, sdMain.FilterIndex=2);
216 end;
217
218 procedure TfMain.aFileSaveExecute(Sender: TObject);
219 begin
220 if FFileName='' then aFileSaveAs.Execute else DoSaveFile(FFileName, FIsUnicodeFile);
221 end;
222
223 procedure TfMain.aFormatFontExecute(Sender: TObject);
224 begin
225 fdMain.Font.Assign(mMain.Font);
226 if fdMain.Execute then mMain.Font.Assign(fdMain.Font);
227 end;
228
229 procedure TfMain.aFormatWordWrapExecute(Sender: TObject);
230 begin
231 mMain.WordWrap := not mMain.WordWrap;
232 UpdateState;
233 end;
234
235 procedure TfMain.aHelpAboutExecute(Sender: TObject);
236 begin
237 MessageBoxW(
238 Application.Handle,
239 PWideChar(WideFormat(
240 '%s v1.00'#13#10'%s', [DKLangConstW('SApplicationName'), DKLangConstW('SCopyright')])),
241 PWideChar(DKLangConstW('SDlgTitle_About')),
242 MB_ICONINFORMATION or MB_OK);
243 end;
244
245 procedure TfMain.aViewStatusBarExecute(Sender: TObject);
246 begin
247 TheStatusBar.Visible := not TheStatusBar.Visible;
248 UpdateState;
249 end;
250
251 function TfMain.CanDiscardText: Boolean;
252 begin
253 Result := True;
254 if mMain.Modified then
255 case MessageBoxW(
256 Application.Handle,
257 PWideChar(DKLangConstW('SMsg_ConfirmFileDiscard', [DisplayFileName])),
258 PWideChar(DKLangConstW('SDlgTitle_Warning')),
259 MB_ICONWARNING or MB_YESNOCANCEL) of
260 IDYES: Result := aFileSave.Execute and not mMain.Modified;
261 IDNO: { nothing };
262 else Result := False;
263 end;
264 end;
265
266 procedure TfMain.DoLoadFile(const wsFileName: WideString);
267 begin
268 mMain.Lines.LoadFromFile(wsFileName);
269 mMain.Modified := False;
270 FIsUnicodeFile := mMain.Lines.LastFileCharSet in [csUnicode, csUnicodeSwapped];
271 FFileName := wsFileName;
272 UpdateState;
273 end;
274
275 procedure TfMain.DoSaveFile(const wsFileName: WideString; bUnicode: Boolean);
276 begin
277 if bUnicode then
278 mMain.Lines.SaveToFile(wsFileName)
279 else
280 mMain.Lines.AnsiStrings.SaveToFile(wsFileName);
281 mMain.Modified := False;
282 FIsUnicodeFile := bUnicode;
283 FFileName := wsFileName;
284 UpdateState;
285 end;
286
287 function TfMain.GetDisplayFileName: WideString;
288 begin
289 Result := FFileName;
290 if Result='' then Result := DKLangConstW('SDefaultFileName');
291 end;
292
293 procedure TfMain.LanguageItemClick(Sender: TObject);
294 begin
295 // We stored language ID in Tag of each menu item (which is Sender here)
296 LangManager.LanguageID := (Sender as TComponent).Tag;
297 UpdateState;
298 end;
299
300 procedure TfMain.TntFormCloseQuery(Sender: TObject; var CanClose: Boolean);
301 begin
302 CanClose := CanDiscardText;
303 end;
304
305 procedure TfMain.TntFormCreate(Sender: TObject);
306
307 procedure CreateLanguageMenu;
308 var
309 i: Integer;
310 mi: TTntMenuItem;
311 begin
312 for i := 0 to LangManager.LanguageCount-1 do begin
313 mi := WideNewItem(LangManager.LanguageNames[i], 0, False, True, LanguageItemClick, 0, '');
314 mi.Tag := LangManager.LanguageIDs[i];
315 smViewLanguage.Add(mi);
316 end;
317 end;
318
319 begin
320 // Initially we prefer Unicode files
321 FIsUnicodeFile := True;
322 // Scan for language files in the app directory and register them in the LangManager object
323 LangManager.ScanForLangFiles(WideExtractFileDir(WideParamStr(0)), '*.lng', False);
324 // Create available languages menu
325 CreateLanguageMenu;
326 // Update interface elements
327 UpdateState;
328 end;
329
330 procedure TfMain.UpdateState;
331 const awsModified: Array[Boolean] of WideString = ('', '*');
332
333 procedure UpdateLanguageMark;
334 var
335 i: Integer;
336 CurLang: LANGID;
337 begin
338 CurLang := LangManager.LanguageID; // To avoid excess synch calls
339 for i := 0 to smViewLanguage.Count-1 do
340 with smViewLanguage[i] do Checked := Tag=CurLang;
341 end;
342
343 begin
344 // Update form caption
345 Caption := WideFormat(
346 '[%s%s] - %s', [DisplayFileName, awsModified[mMain.Modified], DKLangConstW('SApplicationName')]);
347 Application.Title := Caption;
348 // Update language menu
349 UpdateLanguageMark;
350 // Update misc
351 aFormatWordWrap.Checked := mMain.WordWrap;
352 if mMain.WordWrap then mMain.ScrollBars := ssVertical else mMain.ScrollBars := ssBoth;
353 aViewStatusBar.Checked := TheStatusBar.Visible;
354 end;
355
356 procedure TfMain.UpdateStateNotify(Sender: TObject);
357 begin
358 UpdateState;
359 end;
360
361end.
Note: See TracBrowser for help on using the repository browser.