source: trunk/ae/MainFormUnit.pas

Last change on this file was 491, checked in by ataylor, 22 months ago

Support drop of locale (only works if DragText not enabled)
File size: 61.9 KB
RevLine 
[454]1Unit MainFormUnit;
2
3Interface
4
5Uses
6 Classes, Forms, ComCtrls, StdCtrls, Dialogs, Messages, CustomMemo, OS2Def, Sysutils,
7 AutoSaveFormUnit, ACLLanguageUnit, CustomFontDialog, SystemIconUnit,
8 ReplaceFormUnit;
9
10Const
[474]11 AppVersion = 'v1.9.9'; // $SS_REQUIRE_NEW_VERSION$
12 BldLevelVersion = '1.9.9';
[454]13
14{ Todo:
15 Crashes with Freetype?
16 dbcs status bar
17 Insert time/date/filename/text...
18 Ctrl+drop, inserts file
19 (need large paste first)
20 Backup?
21 Message if nothing found instead of dialog box
22 Position find/replace dialog to not obscure word?
23 Switch proportional/nonprop font
24 Print tabs
25 Hide save/update language unless using cmdline
26 MRU files
27 live scrolling?
28 grab handle of vert scroll bar from memo (child)
29 subclass
30 receive scroll updates
31 post "scroll finished" messages back.
32 ugly problems?
33
34 don't print full path of file in header
35}
36
37 WM_UPDATEPOSITION = WM_USER + 100;
38 WM_FOCUSMEMO = WM_USER + 101;
39 WM_MEMOCHANGE = WM_USER + 102;
40 WM_OPENDROPPEDFILE = WM_USER + 103;
41 WM_OPENED = WM_USER + 104;
42
43Type
44 TTextFormat =
45 (
46 tfDOS,
47 tfUnix
48 );
49
50Type
51 TMainForm = Class (TForm)
52 MainMenu: TMainMenu;
53 StatusBar: TStatusBar;
54 OpenDialog: TSystemOpenDialog;
55 OptionsReadOnlyMI: TMenuItem;
56 SaveDialog: TSystemSaveDialog;
57 AutosaveTimer: TTimer;
58 EditPopupMenu: TPopupMenu;
59 EditCutPMI: TMenuItem;
60 EditCopyPMI: TMenuItem;
61 EditPastePMI: TMenuItem;
62 MenuItem10: TMenuItem;
63 EditSelectAllPMI: TMenuItem;
64 FontDialog: TCustomFontDialog;
65 MenuItem8: TMenuItem;
66 MenuItem5: TMenuItem;
67 OptionsColorsMI: TMenuItem;
68 MenuItem4: TMenuItem;
69 SaveLanguageMI: TMenuItem;
70 HelpKeysMI: TMenuItem;
71 OptionsF3FindAgainMI: TMenuItem;
72 OptionsF3ExitMI: TMenuItem;
73 FileAutosaveMI: TMenuItem;
74 OptionsF3KeyActionMI: TMenuItem;
75 OptionsFontMI: TMenuItem;
76 MenuItem1: TMenuItem;
77 FileNewMI: TMenuItem;
78 MenuItem2: TMenuItem;
79 EditUndoMI: TMenuItem;
80 FileOpenMI: TMenuItem;
81 MenuItem3: TMenuItem;
82 FileSaveMI: TMenuItem;
83 FileSaveAsMI: TMenuItem;
84 MenuItem6: TMenuItem;
85 FileExitMI: TMenuItem;
86 OptionsMenu: TMenuItem;
87 HelpMenu: TMenuItem;
88 FilePrintMI: TMenuItem;
89 MenuItem12: TMenuItem;
90 EditCopyMI: TMenuItem;
91 EditPasteMI: TMenuItem;
92 MenuItem16: TMenuItem;
93 EditSelectAllMI: TMenuItem;
94 MenuItem18: TMenuItem;
95 EditFindMI: TMenuItem;
96 EditFindAgainMI: TMenuItem;
97 EditReplaceMI: TMenuItem;
98 MenuItem22: TMenuItem;
99 HelpProductInformationMI: TMenuItem;
100 MenuItem29: TMenuItem;
101 HelpContentsMI: TMenuItem;
102 OptionsWrapMI: TMenuItem;
103 EditCutMI: TMenuItem;
104 EditMenu: TMenuItem;
105 FileMenu: TMenuItem;
106 Procedure OptionsColorsMIOnClick (Sender: TObject);
107 Procedure OptionsFontMIOnClick (Sender: TObject);
108 Procedure EditSelectAllPMIOnClick (Sender: TObject);
109 Procedure EditPastePMIOnClick (Sender: TObject);
110 Procedure EditCopyPMIOnClick (Sender: TObject);
111 Procedure EditCutPMIOnClick (Sender: TObject);
112 Procedure SaveLanguageMIOnClick (Sender: TObject);
113 Procedure HelpKeysMIOnClick (Sender: TObject);
114 Procedure AutosaveTimerOnTimer (Sender: TObject);
115 Procedure FileAutosaveMIOnClick (Sender: TObject);
116 Procedure OptionsF3FindAgainMIOnClick (Sender: TObject);
117 Procedure OptionsF3ExitMIOnClick (Sender: TObject);
118 Procedure OptionsExitOnF3MIOnClick (Sender: TObject);
119 Procedure HelpContentsMIOnClick (Sender: TObject);
120 Procedure FilePrintMIOnClick (Sender: TObject);
121 Procedure MainFormOnCreate (Sender: TObject);
122 Procedure EditReplaceMIOnClick (Sender: TObject);
123 Procedure MainFormOnActivate (Sender: TObject);
124 Procedure EditFindAgainMIOnClick (Sender: TObject);
125 Procedure EditFindMIOnClick (Sender: TObject);
126 Procedure HelpProductInformationMIOnClick (Sender: TObject);
127 Procedure MainFormOnClose (Sender: TObject; Var Action: TCloseAction);
128 Procedure OptionsWrapMIOnClick (Sender: TObject);
129 Procedure EditSelectAllMIOnClick (Sender: TObject);
130 Procedure EditPasteMIOnClick (Sender: TObject);
131 Procedure EditCopyMIOnClick (Sender: TObject);
132 Procedure EditCutMIOnClick (Sender: TObject);
133 Procedure EditUndoMIOnClick (Sender: TObject);
134 Procedure OptionsReadOnlyMIOnClick (Sender: TObject);
135 Procedure FileSaveAsMIOnClick (Sender: TObject);
136 Procedure FileSaveMIOnClick (Sender: TObject);
137 Procedure MainFormOnCloseQuery (Sender: TObject; Var CanClose: Boolean);
138 Procedure FileNewMIOnClick (Sender: TObject);
139 Procedure MainFormOnResize (Sender: TObject);
140 Procedure MainFormOnSetupShow (Sender: TObject);
141 Procedure MainFormOnShow (Sender: TObject);
142 Procedure FileOpenMIOnClick (Sender: TObject);
143 Procedure FileExitMIOnClick (Sender: TObject);
144 Protected
145 FFilename: string;
146 FTextFormat: TTextFormat;
147
148 FSettingText: boolean; // whilst loading etc so we don't think it changed...
149
150 Memo: TCustomMemo;
151 FMemoFont: TFont;
152 FMemoPenColor: TColor;
153 FMemoColor: TColor;
154
155 FWrap: boolean;
156 FReadOnly: boolean;
157 FExitOnF3: boolean;
158
159 FShowUsage: boolean;
160
161 FLastDirectory: string;
162
163 FFindText: string;
164 FFindCaseSensitive: boolean;
165 FFindFromTop: boolean; // this find
166 FReplaceText: string;
167
168 FPrintHeader: boolean;
169
170 FAutoSaveType: TAutoSaveType;
171 FAutoSaveMinutes: longint;
172 FAutoSaveChanges: longint;
173 FRequireManualSave: boolean;
174
175 FChangeCount: longint;
176
177 FWarnLargeFiles: boolean;
178
179 Procedure OnLanguageEvent( Language: TLanguageFile;
180 const Apply: boolean );
181
182 Procedure MemoOnFontChange( Sender: TObject );
183 Procedure MemoOnDragDrop( Sender: TObject;
184 Source: TObject;
185 X, Y: LongInt );
186 Procedure MemoOnDragOver( Sender: TObject;
187 Source: TObject;
188 X, Y: LongInt;
189 State: TDragState;
190 var Accept: boolean );
191 Procedure MemoOnMouseUp( Sender: TObject;
192 Button: TMouseButton;
193 Shift: TShiftState;
194 X: LongInt;
195 Y: LongInt );
196 Procedure MemoOnChange( Sender: TObject );
197 Procedure MemoOnScan( Sender: TObject;
198 Var KeyCode: TKeyCode );
199
200 Procedure InitAutoSave;
201 Procedure AutoSave;
202
203 procedure CreateMemo;
204
205 Procedure SetExitOnF3( Value: boolean );
206
207 Procedure RedisplayText;
208
209 Procedure TextToMemo( Text: pchar;
210 TextLength: longint );
211 Procedure MemoToText( Var Text: pchar;
212 Var TextLength: longint;
213 SelectionOnly: boolean );
214
215
216 function OpenFile( const Filename: string;
217 ComplainIfMissing: boolean ): boolean;
218 function SaveFileTo( const Filename: string ): boolean;
219
220 function CloseFile: boolean;
221 function SaveFile: boolean;
222 function SaveFileAs: boolean;
223
224 procedure DetectTextFormat( Text: pchar;
225 TextLength: ULONG );
226
227 Procedure PostUpdatePosition;
228
229 Procedure WMUpdatePosition( Var Msg: TMessage ); message WM_UPDATEPOSITION;
230 Procedure WMMemoChange( Var Msg: TMessage ); message WM_MEMOCHANGE;
231 Procedure WMFocusMemo( Var Msg: TMessage ); message WM_FOCUSMEMO;
232
233 Procedure WMOpenDroppedFile( Var Msg: TMessage ); message WM_OPENDROPPEDFILE;
234
235 procedure WMOpened( Var Msg: TMessage ); message WM_OPENED;
236
237 Procedure UpdateMode;
238 Procedure UpdateCaption;
239 Procedure UpdatePosition;
240 Procedure EnableControls;
241 Procedure UpdateStatus;
242
243 Procedure SetMessage( const Message: string );
244
245 Procedure Find;
246
247 // callbacks for the replace and find commands.
248 Procedure OnReplaceCommand( Sender: TObject;
249 Command: TReplaceCommand );
250 Procedure OnFindCommand( Sender: TObject );
251
252 Procedure PrintPageHeader( X: longint;
253 Y: longint;
254 Width: longint );
255
256 Function GetChanged: boolean;
257 Procedure SetChanged( Value: boolean );
258
259 procedure SetReadOnly( Value: boolean );
260 Procedure SetWrap( Value: boolean );
261
262 procedure OnHint( Sender: TObject );
263
264 Function HaveSelection: boolean;
265 Procedure SelectNone;
266
267 Protected
268 // language strings
269 SaveLanguageTitle: string;
270 SaveLanguageError: string;
271 SavedMsg: string;
272 AutosaveDoneMsg: string;
273 PrintTitle: string;
274 NoPrinterError: string;
275 PrintDoneMsg1: string;
276 PrintDoneMsg2: string;
277 HelpTitle: string;
278 ReplaceDoneMsg1: string;
279 ReplaceDoneMsg2: string;
280 NoReplacementsMsg: string;
281 MatchMsg: string;
282 NoMatchMsg: string;
283 ReadOnlyStatus: string;
284 ModifiedStatus: string;
285 NewStatus: string;
286 UntitledTitle: string;
287 AppTitle: string;
288 InsertStatus: string;
289 OverwriteStatus: string;
290 SaveTitle: string;
291 SaveReadonlyError: string;
292 SaveAccessDeniedError: string;
293 FileInUseError: string;
294 FileDoesNotExistError: string;
295 OpenAccessDeniedError: string;
296 OpenFileInUseError: string;
297 SaveError: string;
298 ReplacePrompt: string;
299 NewFileMsg: string;
300 OpenTitle: string;
301 OpenError: string;
302 OpenedMsg: string;
303 UsageTitle: string;
304 Usage1: string;
305 Usage2: string;
306 Usage3: string;
307 PrintingPageMsg: string;
308 End;
309
310
311Var
312 MainForm: TMainForm;
313
314Imports
315FUNCTION _WinNextChar(ahab:HAB;idcp,idcc:ULONG;apsz:PChar):PChar;
316 APIENTRY; 'PMWIN' index 791;
317FUNCTION _WinPrevChar(ahab:HAB;idcp,idcc:ULONG;pszStart,apsz:PChar):PChar;
318 APIENTRY; 'PMWIN' index 795;
319
320end;
321
322Implementation
323
324uses
325 BseDos, BseErr, PMWin, Dos, PMGPI, PMWP, PmStdDlg, BseSub,
326 SysUtils, IniFiles, Printers,
327 ACLStringUtility, ACLFileUtility, ACLUtility,
328 ACLDialogs,
329 ControlsUtility,
330 SaveQueryFormUnit, FindFormUnit,
331 AEPrintDialogUnit, ProductInformationFormUnit, ColorsFormUnit,
332 LargeFileWarningFormUnit;
333
334 {$r ae}
335
336var
337 g_DroppedFileName: string;
338
339function GetIniFilePath( const FilePart: string ): string;
340var
341 UserIniPath: string;
342 IniFileDir: string;
343begin
344 UserIniPath := GetEnv( 'USER_INI' );
345 IniFileDir := ExtractFilePath( UserIniPath );
346 if IniFileDir = '' then
347 IniFileDir := GetApplicationDir;
348
349 Result := AddSlash( IniFileDir )
350 + FilePart;
351end;
352
353Procedure TMainForm.OptionsColorsMIOnClick (Sender: TObject);
354Begin
355 ColorsForm.TextColor := SysColorToRGB( FMemoPenColor );
356 ColorsForm.BackgroundColor := SysColorToRGB( FMemoColor );
357
358 ColorsForm.ShowModal;
359 if ColorsForm.ModalResult <> mrOK then
360 exit;
361
362 FMemoPenColor := ColorsForm.TextColor;
363 FMemoColor := ColorsForm.BackgroundColor;
364
365 Memo.PenColor := FMemoPenColor;
366 Memo.Color := FMemoColor;
367
368End;
369
370Procedure TMainForm.OptionsFontMIOnClick (Sender: TObject);
371var
372 DialogSetup: FONTDLG;
373 SelectedFont: cstring;
374Begin
375 FontDialog.AllowSimulations := false;
376 FontDialog.EditFont := FMemoFont;
377 if FontDialog.Execute then
378 begin
379 FMemoFont := FontDialog.EditFont;
380 Memo.Font := FMemoFont;
381 end;
382
383 exit;
384
385 SelectedFont := FMemoFont.Family;
386
387 FillChar( DialogSetup, sizeof( DialogSetup ), #0 );
388 with DialogSetup do
389 begin
390 cbSize := sizeof( DialogSetup );
391 hpsScreen := Screen.Canvas.Handle;
392 pszFamilyName := Addr( SelectedFont );
393 usFamilyBufLen := sizeof( SelectedFont );
394 fxPointSize := FMemoFont.PointSize shl 16; // FIXED
395 clrBack := SYSCLR_WINDOW;
396 clrFore := SYSCLR_WINDOWTEXT;
397 fl := FNTS_CENTER;
398 end;
399
400 WinFontDlg( HWND_DESKTOP,
401 Frame.Handle,
402 DialogSetup );
403 if DialogSetup.lReturn = DID_OK then
404 begin
405 FMemoFont := Screen.GetFontFromPointSize( SelectedFont,
406 DialogSetup.fxPointSize shr 16 );
407 Memo.Font := FMemoFont;
408 end;
409End;
410
411Procedure TMainForm.EditSelectAllPMIOnClick (Sender: TObject);
412Begin
413 Memo.SelectAll;
414End;
415
416Procedure TMainForm.EditPastePMIOnClick (Sender: TObject);
417Begin
418 SendMsg( Memo.Handle, MLM_PASTE, 0, 0 );
419End;
420
421Procedure TMainForm.EditCopyPMIOnClick (Sender: TObject);
422Begin
423 SendMsg( Memo.Handle, MLM_COPY, 0, 0 );
424End;
425
426Procedure TMainForm.EditCutPMIOnClick (Sender: TObject);
427Begin
428 SendMsg( Memo.Handle, MLM_CUT, 0, 0 );
429
430End;
431
432Procedure TMainForm.SaveLanguageMIOnClick (Sender: TObject);
433Var
434 LanguageFile: TLanguageFile;
435Begin
436 SaveDialog.Title := SaveLanguageTitle;
437 SaveDialog.Filename := GetApplicationDir + 'new.lng';
438 if not SaveDialog.Execute then
439 exit;
440
441 Caption := '';
442 try
443 LanguageFile := TLanguageFile.Create( SaveDialog.Filename );
444
445 UpdateLanguage( LanguageFile );
446 except
447 on E: Exception do
448 begin
449 DoErrorDlg( SaveLanguageTitle,
450 SaveLanguageError + E.Message );
451 exit;
452 end;
453 end;
454 LanguageFile.Destroy;
455
456 UpdateCaption;
457
458 SetMessage( SavedMsg + SaveDialog.Filename );
459End;
460
461Procedure TMainForm.OnLanguageEvent( Language: TLanguageFile;
462 const Apply: boolean );
463begin
464 Language.LoadComponentLanguage( self, Apply );
465
466 // Load strings referred to by code...
467 // ----------------------------------------------------------
468
469 Language.LL( Apply, SaveLanguageError, 'SaveLanguageError', 'Error saving language file ' );
470 Language.LL( Apply, SavedMsg, 'SavedMsg', 'Saved: ' );
471 Language.LL( Apply, AutosaveDoneMsg, 'AutosaveDoneMsg', 'Auto-saved ' );
472 Language.LL( Apply, PrintTitle, 'PrintTitle', 'Print' );
473 Language.LL( Apply, NoPrinterError, 'NoPrinterError', 'You don''t have a printer configured.' );
474 Language.LL( Apply, PrintDoneMsg1, 'PrintDoneMsg1', 'Printing complete (' );
475 Language.LL( Apply, PrintDoneMsg2, 'PrintDoneMsg2', ' pages)' );
476 Language.LL( Apply, HelpTitle, 'HelpTitle', 'Text Editor Help' );
477 Language.LL( Apply, ReplaceDoneMsg1, 'ReplaceDoneMsg1', 'Replaced ' );
478 Language.LL( Apply, ReplaceDoneMsg2, 'ReplaceDoneMsg2', ' occurrence(s)' );
479 Language.LL( Apply, NoReplacementsMsg, 'NoReplacementsMsg', 'No replacements made' );
480 Language.LL( Apply, MatchMsg, 'MatchMsg', 'Found' );
481 Language.LL( Apply, NoMatchMsg, 'NoMatchMsg', 'No match found' );
482 Language.LL( Apply, ReadOnlyStatus, 'ReadOnlyStatus', 'Read-only' );
483 Language.LL( Apply, ModifiedStatus, 'ModifiedStatus', 'Modified' );
484 Language.LL( Apply, NewStatus, 'NewStatus', 'New' );
485 Language.LL( Apply, UntitledTitle, 'UntitledTitle', '(Untitled)' );
486 Language.LL( Apply, AppTitle, 'AppTitle', 'Text Editor' );
487 Language.LL( Apply, InsertStatus, 'InsertStatus', 'INS' );
488 Language.LL( Apply, OverwriteStatus, 'OverwriteStatus', 'OVR' );
489 Language.LL( Apply, SaveTitle, 'SaveTitle', 'Save File' );
490 Language.LL( Apply, SaveReadonlyError, 'SaveReadonlyError', 'Cannot save to read-only file: ' );
491 Language.LL( Apply, SaveAccessDeniedError, 'SaveAccessDeniedError', 'Access denied saving file: ' );
492 Language.LL( Apply, FileInUseError, 'FileInUseError', 'File in use by another program: ' );
493 Language.LL( Apply, FileDoesNotExistError, 'FileDoesNotExistError', 'File does not exist: ' );
494 Language.LL( Apply, OpenAccessDeniedError, 'OpenAccessDeniedError', 'Access denied: ' );
495 Language.LL( Apply, OpenFileInUseError, 'OpenFileInUseError', 'File in use by another program: ' );
496 Language.LL( Apply, SaveError, 'SaveError', 'Error saving file: ' );
497 Language.LL( Apply, ReplacePrompt, 'ReplacePrompt', 'Are you sure you want to replace this file?' );
498 Language.LL( Apply, NewFileMsg, 'NewFileMsg', 'New file' );
499 Language.LL( Apply, OpenTitle, 'OpenTitle', 'Open File' );
500 Language.LL( Apply, OpenError, 'OpenError', 'Error opening file: ' );
501 Language.LL( Apply, OpenedMsg, 'OpenedMsg', 'Opened: ' );
502 Language.LL( Apply, UsageTitle, 'Usage', 'Usage' );
503 Language.LL( Apply, Usage1, 'Usage1', 'Usage: ae [/read] [<filename>]' );
504 Language.LL( Apply, Usage2, 'Usage2', ' /read: set read-only' );
505 Language.LL( Apply, Usage3, 'Usage3', 'Displays or edits text files' );
506 Language.LL( Apply, PrintingPageMsg, 'PrintingPageMsg', 'Printing: page ' );
507end;
508
509Procedure TMainForm.HelpKeysMIOnClick (Sender: TObject);
510Begin
511 Application.Help( 6 ); // Keyboard shortcuts topic
512End;
513
514Procedure TMainForm.InitAutoSave;
515begin
516 FChangeCount := 0;
517 AutosaveTimer.Interval := FAutoSaveMinutes
518 * 60 // secs/min
519 * 1000; // ms/sec
520 AutoSaveTimer.Stop;
521end;
522
523Procedure TMainForm.AutoSave;
524Begin
525 InitAutoSave; // reset counter/timer
526
527 if FRequireManualSave then
528 if FFilename = '' then
529 // filename not specified yet.
530 exit;
531
532 if not SaveFile then
533 exit;
534
535 SetMessage( AutosaveDoneMsg
536 + FFilename
537 + ' ('
538 + FormatDateTime( 'tt', Now )
539 + ')' );
540end;
541
542Procedure TMainForm.AutosaveTimerOnTimer (Sender: TObject);
543Begin
544 if FAutoSaveType <> asTimed then
545 begin
546 // what are we doing here??
547 AutosaveTimer.Stop;
548 exit;
549 end;
550 Autosave;
551End;
552
553Procedure TMainForm.FileAutosaveMIOnClick (Sender: TObject);
554Begin
555 AutoSaveForm.FAutoSaveType := FAutoSaveType;
556 AutoSaveForm.FMinutes := FAutoSaveMinutes;
557 AutoSaveForm.FChanges := FAutoSaveChanges;
558 AutoSaveForm.RequireManualSaveCheckBox.Checked := FRequireManualSave;
559
560 AutoSaveForm.ShowModal;
561 if AutoSaveForm.ModalResult <> mrOK then
562 exit;
563
564 // start counting now
565 InitAutoSave;
566
567 FAutoSaveType := AutoSaveForm.FAutoSaveType;
568 FAutoSaveMinutes := AutoSaveForm.FMinutes;
569 FAutoSaveChanges := AutoSaveForm.FChanges;
570 FRequireManualSave := AutoSaveForm.RequireManualSaveCheckBox.Checked;
571End;
572
573Procedure TMainForm.OptionsF3FindAgainMIOnClick (Sender: TObject);
574Begin
575 SetExitOnF3( false );
576End;
577
578Procedure TMainForm.OptionsF3ExitMIOnClick (Sender: TObject);
579Begin
580 SetExitOnF3( true );
581End;
582
583Procedure TMainForm.SetExitOnF3( Value: boolean );
584begin
585 FExitOnF3 := Value;
586 OptionsF3ExitMI.Checked := Value; // check the selected option
587 OptionsF3FindAgainMI.Checked := not Value; // unchecked the other option
588end;
589
590Procedure TMainForm.OptionsExitOnF3MIOnClick (Sender: TObject);
591Begin
592 SetExitOnF3( not FExitOnF3 );
593End;
594
595Procedure TMainForm.EnableControls;
596begin
597 EditReplaceMI.Enabled := not FReadOnly;
598 EditCutMI.Enabled := not FReadOnly;
599 EditPasteMI.Enabled := not FReadOnly;
600
601 EditCutPMI.Enabled := not FReadOnly;
602 EditPastePMI.Enabled := not FReadOnly;
603
604end;
605
606Procedure TMainForm.WMOpenDroppedFile( Var Msg: TMessage );
607begin
608 OpenFile( g_DroppedFileName, true );
609end;
610
611Procedure TMainForm.MemoOnDragOver( Sender: TObject;
612 Source: TObject;
613 X, Y: LongInt;
614 State: TDragState;
615 var Accept: boolean );
616begin
617 if Source is TExternalDragDropObject then
618 Accept := true;
619end;
620
621Procedure TMainForm.MemoOnDragDrop( Sender: TObject;
622 Source: TObject;
623 X, Y: LongInt );
624var
625 DropObject: TExternalDragDropObject;
[491]626 LocaleName: String;
627 MajorLanguage: String;
628 MinorLanguage: String;
[454]629Begin
630 if not ( Source is TExternalDragDropObject ) then
631 // probably not needed, but crashes during drag drop completely
632 // screw PM, so best to be sure!
633 exit;
634
635 DropObject := Source as TExternalDragDropObject;
636
[491]637 // See if it's a locale name (which reports as a bitmap file for some reason)
638 if ( DropObject.ContainerName = '.') and
639 ( DropObject.RenderString = '< DRM_OS2FILE, DRF_BITMAP >')
640 then
641 begin
642 LocaleName := DropObject.SourceFilename;
643 MajorLanguage := ExtractNextValue( LocaleName, '_' );
644 if MajorLanguage <> '' then
645 begin
646 if MajorLanguage = 'en' then
647 begin
648 LoadLanguage('');
649 exit;
650 end;
651 MinorLanguage := ExtractNextValue( LocaleName, '.' );
652 if ( MinorLanguage <> '') and
653 ( LoadAutoLanguage('ae', MajorLanguage + '_' + MinorLanguage ))
654 then
655 exit;
656 if not LoadAutoLanguage('ae', MajorLanguage ) then
657 LoadDefaultLanguage('ae');
658 exit;
659 end;
660 end;
661
[454]662 g_DroppedFileName := AddSlash( DropObject.ContainerName )
663 + DropObject.SourceFilename;
664 // can't process synchronously, cause we need to destroy the memo
665 // that's handling the drop event
666 PostMsg( Self.Handle,
667 WM_OPENDROPPEDFILE,
668 0,
669 0 );
670end;
671
672Procedure TMainForm.MemoOnFontChange( Sender: TObject );
673begin
674 FMemoFont := Memo.Font;
675end;
676
677Procedure TMainForm.HelpContentsMIOnClick (Sender: TObject);
678Begin
679 Application.HelpContents;
680End;
681
682Procedure TMainForm.PrintPageHeader( X: longint;
683 Y: longint;
684 Width: longint );
685var
686 DateTimeStr: string;
687 DateTimeX: longint;
688 PageNumberStr: string;
689begin
690
691 // Filename top left
692 Printer.Canvas.TextOut( X,
693 Y,
694 ExtractFileName( FFilename ) );
695
[471]696 // centred date/time, if it fits
697 // (using system short format crashes on some systems, use ISO8601 style instead)
698 DateTimeStr := FormatDateTime( 'yyyy/mm/dd hh:nn:ss',
[454]699 Now );
700
701 DateTimeX := X
702 + Width div 2
703 - Printer.Canvas.TextWidth( DateTimeStr ) div 2;
704
705 if DateTimeX > Printer.Canvas.PenPos.X then
706 // datetime starts after end of filename
707 Printer.Canvas.TextOut( DateTimeX,
708 Y,
709 DateTimeStr );
710
711 // page number, top right
712 PageNumberStr := IntToStr( Printer.PageNumber );
713
714 Printer.Canvas.TextOut( Width
715 - Printer.Canvas.TextWidth( PageNumberStr ),
716 Y,
717 PageNumberStr );
[469]718
[454]719end;
720
721type
722 TCharWidthArray = array[ #0..#255 ] of longint;
723
724Procedure TMainForm.SelectNone;
725var
726 CursorPosition: ULONG;
727begin
728 CursorPosition := SendMsg( Memo.Handle,
729 MLM_QUERYSEL,
730 MLFQS_CURSORSEL,
731 0 );
732
733 SendMsg( Memo.Handle,
734 MLM_SETSEL,
735 CursorPosition,
736 CursorPosition );
737end;
738
739Function TMainForm.HaveSelection: boolean;
740begin
741 result := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MAXSEL, 0 )
742 - WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MINSEL, 0 )
743 > 0;
744end;
745
746Procedure TMainForm.FilePrintMIOnClick (Sender: TObject);
747var
748 MarginSize: longint;
749 RightMargin: longint;
750 TopMargin: longint;
751 p: pchar;
752 EndP: Pchar;
753 Text: pchar;
754 Size: longint;
755 c: char;
756 TextHeight: longint;
757
758 pLineStart: pchar;
759 pLineEnd: pchar;
760 pLastBreak: pchar;
761
762 CharWidths: TCharWidthArray;
763 X: longint;
764 Y: longint;
765 DrawPoint: POINTL;
766
767 NumberOfPages: longint;
768Begin
769 if Printer.Printers.Count = 0 then
770 begin
771 DoErrorDlg( PrintTitle,
772 NoPrinterError );
773 exit;
774 end;
775
776 AEPrintDialog.HeaderCheckBox.Checked := FPrintHeader;
777
778 if HaveSelection then
779 // there's a selection - use that
780 AEPrintDialog.SelectionRadioButton.Checked := true
781 else
782 AEPrintDialog.AllRadioButton.Checked := true;
783
784 AEPrintDialog.ShowModal;
785 if AEPrintDialog.ModalResult <> mrOK then
786 exit;
787
788 FPrintHeader := AEPrintDialog.HeaderCheckBox.Checked;
789
790 Screen.Cursor := crHourglass;
791
792 Printer.Title := FFilename;
793
794 Printer.BeginDoc;
795
796 // Pick the printer font.
797 if FMemoFont.FontType = ftBitmap then
798 begin
799 // pick an appropriate outline font
800 if FMemoFont.Pitch = fpFixed then
801 begin
802 Printer.Canvas.Font :=
[469]803 Screen.GetFontFromPointSize( 'Courier',
[454]804 FMemoFont.PointSize );
805 end
806 else
807 begin
808 Printer.Canvas.Font :=
809 Screen.GetFontFromPointSize( 'Helvetica',
810 FMemoFont.PointSize );
811 end
812 end
813 else
814 begin
815 // the selected memo font is an outline font so use it as is.
816 Printer.Canvas.Font := FMemoFont;
817 end;
818
819 MarginSize := Printer.Canvas.HorizontalResolution // pixels per meter
820 * 0.0125; // 12.5 mm = 0.5 inch
821
822 RightMargin := Printer.PageWidth - MarginSize;
823 TopMargin := Printer.PageHeight - MarginSize;
824
825 TextHeight := Printer.Canvas.TextHeight( 'm' );
826
827 MemoToText( Text,
828 Size,
829 AEPrintDialog.SelectionRadioButton.Checked );
830
831 p := Text;
832 EndP := Text + Size;
833
834 // Retrieve all character widths
835 if not GpiQueryWidthTable( Printer.Canvas.Handle,
836 0, 256,
837 CharWidths[ #0 ] ) then
838 begin
839 raise Exception.Create( 'Error getting character width table: '
840 + 'GpiQueryWidthTable error '
841 + IntToStr( WinGetLastError( AppHandle ) ) );
842 end;
843
844 // Convert all widths to positive!
845 // For unknown reason, sometimes GPI returns negative values...
846 for c := #0 to #255 do
847 begin
848 CharWidths[ c ] := Abs( CharWidths[ c ] );
849 end;
850
851 while p < EndP do
852 begin
853 // Print a page
854
855 SetMessage( PrintingPageMsg
856 + IntToStr( Printer.PageNumber ) );
857
858 Y := TopMargin - TextHeight;
859
860 if FPrintHeader then
861 begin
862 PrintPageHeader( MarginSize, // X
863 Y, // Y
864 RightMargin - MarginSize ); // width
865
866 dec( Y, TextHeight * 2 ); // space for header
867 end;
868
869 // print text that fits on this page
870 while P < EndP do
871 begin
872 // print a line
873
874 // move to start of text area.
875 X := MarginSize;
876
877 pLineStart := p;
878 pLineEnd := nil;
879 pLastBreak := nil;
880
881 // work out how much text fits on the line ie. do wrapping
882 while true do
883 begin
884 if p >= EndP then
885 begin
886 pLineEnd := p;
887 break;
888 end;
889
890 c := p[ 0 ];
891
892 case c of
893 #13: // carriage return
894 begin
895 pLineEnd := p;
896 inc( p );
897 if p[ 0 ] = #10 then
898 // skip following LF
899 inc( p );
900 break;
901 end;
902
903 #10: // linefeed
904 begin
905 pLineEnd := p;
906 inc( p );
907 break;
908 end;
909
910 ' ', #9: // space, tab
911 begin
912 pLastBreak := p;
913 end;
914
915 end;
916
917 // add size of this char
918 inc( X, CharWidths[ c ] );
919
920 if X > RightMargin then
921 begin
922 // need to wrap
923 if pLastBreak <> nil then
924 begin
925 pLineEnd := pLastBreak;
926 p := pLastBreak + 1;
927
928 // skip extra spaces
929 while p < EndP do
930 begin
931 if p[ 0 ] <> ' ' then
932 break;
933 inc( p );
934 end;
935
936 end
937 else
938 begin
939 // no word break, just truncate at this char
940 pLineEnd := p;
941 if p = pLineStart then
942 // draw at least 1 char
943 inc( p );
944 end;
945 break;
946 end;
947 inc( p );
948 end;
949
950 // print the line
951
952 DrawPoint.X := MarginSize;
953 DrawPoint.Y := Y;
954
955 // note: max 512 chars, thanks GPI :(
956 GpiCharStringPosAt( Printer.Canvas.Handle,
957 DrawPoint,
958 nil, // text rect - not used
959 0, // no options
960 PCharDiff( pLineEnd, pLineStart ),
961 pLineStart[ 0 ],
962 nil // no vector of increments
963 );
964 // subtract line height from vertical position
965 dec( Y, TextHeight );
966
967 if P < EndP then
968 begin
969 if Y - TextHeight < MarginSize then
970 begin
971 // next line won't fit on page, new page
972 Printer.NewPage;
973 break;
974 end;
975 end;
976 end;
977 end;
978
979 StrDispose( Text );
980
981 NumberOfPages := Printer.PageNumber;
982
983 Printer.EndDoc;
984
985 Screen.Cursor := crDefault;
986
987 SetMessage( PrintDoneMsg1
988 + IntToStr( NumberOfPages )
989 + PrintDoneMsg2 );
990
991End;
992
993Procedure TMainForm.MainFormOnCreate (Sender: TObject);
994Begin
995 Application.ShowHint := true;
996
997 RegisterForLanguages( OnLanguageEvent );
998
999 LoadDefaultLanguage( 'ae' );
1000
1001 Font := GetNiceDefaultFont;
1002 FPrintHeader := true;
1003
1004 // set up form icons
1005 FormIconResourceID := 1;
1006
1007 Application.HelpFile := FindDefaultLanguageHelpFile( 'ae' );
1008 Application.HelpWindowTitle := HelpTitle;
1009
1010 Application.OnHint := OnHint;
1011End;
1012
1013Procedure TMainForm.EditReplaceMIOnClick (Sender: TObject);
1014Begin
1015
1016 // load existing preferences to replace dialog
1017 ReplaceForm.TextToFindEdit.Text := FFindText;
1018 ReplaceForm.ReplaceTextEdit.Text := FReplaceText;
1019 ReplaceForm.CaseSensitiveCheckBox.Checked := FFindCaseSensitive;
1020 ReplaceForm.FromTopCheckBox.Checked := false;
1021
1022 ReplaceForm.OnReplaceCommand := OnReplaceCommand;
1023
1024 SelectNone;
1025
1026 ReplaceForm.Show;
1027 WinSetOwner( ReplaceForm.Frame.Handle, Frame.Handle );
1028end;
1029
1030Procedure TMainForm.OnReplaceCommand( Sender: TObject;
1031 Command: TReplaceCommand );
1032var
1033 szFindText: cstring;
1034 szReplaceText: cstring;
1035 SearchData: MLE_SEARCHDATA;
1036 Flags: ULONG;
1037 CursorPosition: ULONG;
1038 CursorLine: ULONG;
1039 CursorLineScreenBottom: ULONG;
1040 TopPosition: ULONG;
1041 TopLine: ULONG;
1042 ReplaceCount: longint;
1043 MatchFound: boolean;
1044begin
1045 // get preferences back from dialog
1046 FFindText := ReplaceForm.TextToFindEdit.Text;
1047 FReplaceText := ReplaceForm.ReplaceTextEdit.Text;
1048 FFindCaseSensitive := ReplaceForm.CaseSensitiveCheckBox.Checked;
1049 FFindFromTop := ReplaceForm.FromTopCheckBox.Checked;
1050 ReplaceForm.FromTopCheckBox.Checked := false; // uncheck after one use
1051
1052 szFindText := FFindText; // convert to null terminated
1053 szReplaceText := FReplaceText; // convert to null terminated
1054
1055 if ( Command = rcReplaceSelectionThenFind )
1056 or ( Command = rcReplaceSelectionAndAll ) then
1057 begin
1058 // first replace selection, if any, with replace text.
1059 // NOTE: Original e.exe actually does another search, and only replaces
1060 // matches regardless of current selection.
1061 // I think this behaviour is perhaps reasonable and even useful.
1062 // Of course most people will not be modifying selection so it is an obscure point.
1063 if HaveSelection then
1064 begin
1065 SendMsg( Memo.Handle,
1066 MLM_INSERT,
1067 MPARAM( Addr( szReplaceText ) ),
1068 0 );
1069 end;
1070 end;
1071 // Set up search data
1072 SearchData.cb := sizeof( SearchData );
1073 SearchData.pchFind := Addr( szFindText );
1074 SearchData.cchFind := Length( FFindText );
1075
1076 // set up flags
1077 Flags := MLFSEARCH_SELECTMATCH; // select the matching text
1078 if FFindCaseSensitive then
1079 Flags := Flags + MLFSEARCH_CASESENSITIVE; // want case sensitive search
1080
1081 ReplaceCount := 0;
1082 MatchFound := false;
1083
1084 while true do
1085 begin
1086 // set search start and end positions
1087 if FFindFromTop then
1088 SearchData.iptStart := 0 // start
1089 else
1090 SearchData.iptStart := -1; // current cursor
1091 FFindFromTop := false;
1092
1093 SearchData.iptStop := -1; // end
1094
1095 // do the search
1096 if SendMsg( Memo.Handle,
1097 MLM_SEARCH,
1098 Flags,
1099 MParam( Addr( SearchData ) ) ) = 0 then
1100 // no (more) matches found
1101 break;
1102
1103 MatchFound := true;
1104
1105 if ( Command = rcFindOnly )
1106 or ( Command = rcReplaceSelectionThenFind ) then
1107 // only doing a single find.
1108 break;
1109
1110 // do the replacement
1111 SendMsg( Memo.Handle,
1112 MLM_INSERT,
1113 MParam( Addr( szReplaceText ) ),
1114 0 );
1115 inc( ReplaceCount );
1116
1117 CursorPosition := SendMsg( Memo.Handle,
1118 MLM_QUERYSEL,
1119 MLFQS_CURSORSEL,
1120 0 );
1121
1122 // move past previous match
1123 SendMsg( Memo.Handle,
1124 MLM_SETSEL,
1125 CursorPosition,
1126 CursorPosition );
1127 end;
1128
1129 if Command = rcFindOnly then
1130 begin
1131 if MatchFound then
1132 SetMessage( MatchMsg )
1133 else
1134// SetMessage( NoMatchMsg )
1135 DoMessageDlg( FindForm.Caption, NoMatchMsg );
1136 end
1137 else
1138 begin
1139 if ReplaceCount > 0 then
1140 SetMessage( ReplaceDoneMsg1
1141 + IntToStr( ReplaceCount )
1142 + ReplaceDoneMsg2 )
1143 else if MatchFound then
1144 SetMessage( NoReplacementsMsg )
1145 else
1146 DoMessageDlg( ReplaceForm.Caption, NoMatchMsg );
1147// SetMessage( NoMatchMsg )
1148 end;
1149End;
1150
1151Procedure TMainForm.MainFormOnActivate (Sender: TObject);
1152Begin
1153 UpdateMode;
1154End;
1155
1156Procedure TMainForm.EditFindAgainMIOnClick (Sender: TObject);
1157Begin
1158 if FFindText = '' then
1159 EditFindMIOnClick( Sender )
1160 else
1161 Find;
1162
1163End;
1164
1165Procedure TMainForm.SetMessage( const Message: string );
1166begin
1167 StatusBar.Panels[ 0 ].Text := Message;
1168end;
1169
1170Procedure TMainForm.Find;
1171var
1172 szFindText: cstring;
1173 SearchData: MLE_SEARCHDATA;
1174 Flags: ULONG;
1175begin
1176 szFindText := FFindText;
1177 SearchData.cb := sizeof( SearchData );
1178 SearchData.pchFind := Addr( szFindText );
1179 SearchData.cchFind := Length( FFindText );
1180 if FFindFromTop then
1181 SearchData.iptStart := 0 // start
1182 else
1183 SearchData.iptStart := -1; // current cursor
1184 FFindFromTop := false;
1185 SearchData.iptStop := -1; // end
1186
1187 Flags := MLFSEARCH_SELECTMATCH;
1188 if FFindCaseSensitive then
1189 Flags := Flags + MLFSEARCH_CASESENSITIVE;
1190
1191 if SendMsg( Memo.Handle,
1192 MLM_SEARCH,
1193 Flags,
1194 MParam( Addr( SearchData ) ) ) <> 0 then
1195 begin
1196 SetMessage( MatchMsg )
1197 end
1198 else
1199 begin
1200 // no match - put focus back on find form, edit box
1201 FindForm.Focus;
1202 FindForm.TextToFindEdit.Focus;
1203 DoMessageDlg( FindForm.Caption, NoMatchMsg );
1204 end;
1205 // SetMessage( NoMatchMsg )
1206end;
1207
1208Procedure TMainForm.EditFindMIOnClick (Sender: TObject);
1209Begin
1210 FindForm.TextToFindEdit.Text := FFindText;
1211 FindForm.CaseSensitiveCheckBox.Checked := FFindCaseSensitive;
1212 FindForm.OnFindClicked := OnFindCommand;
1213 FindForm.FromTopCheckBox.Checked := false;
1214
1215 SelectNone;
1216
1217 FindForm.Show;
1218 WinSetOwner( FindForm.Frame.Handle, Frame.Handle );
1219end;
1220
1221Procedure TMainForm.OnFindCommand;
1222begin
1223 FFindText := FindForm.TextToFindEdit.Text;
1224 FFindCaseSensitive := FindForm.CaseSensitiveCheckBox.Checked;
1225
1226 FFindFromTop := FindForm.FromTopCheckBox.Checked;
1227 FindForm.FromTopCheckBox.Checked := false; // uncheck after one use
1228
1229 Find;
1230End;
1231
1232Procedure TMainForm.HelpProductInformationMIOnClick (Sender: TObject);
1233Begin
1234 ProductInformationForm.NameAndVersionEdit.Text := 'AE ' + AppVersion;
1235 ProductInformationForm.ShowModal;
1236End;
1237
1238Procedure TMainForm.MainFormOnClose (Sender: TObject;
1239 Var Action: TCloseAction);
1240var
1241 IniFile: TMyIniFile;
1242Begin
1243 try
1244 IniFile := TMyIniFile.Create( GetIniFilePath( 'ae.ini' ) );
1245
1246 IniFile.WriteBool( 'General', 'FindCaseSensitive', FFindCaseSensitive );
1247 IniFile.WriteString( 'General', 'FindText', FFindText );
1248 IniFile.WriteString( 'General', 'ReplaceText', FReplaceText );
1249 IniFile.WriteString( 'General', 'LastDirectory', FLastDirectory );
1250
1251 IniFile.WriteBool( 'General', 'WordWrap', FWrap );
1252 IniFile.WriteBool( 'General', 'ExitOnF3', FExitOnF3 );
1253
1254 IniFile.WriteBool( 'General', 'PrintHeader', FPrintHeader );
1255
1256 SaveFormSizePosition( self, IniFile );
1257
1258 // save memo font
1259 IniFile.WriteString( 'Font', 'Face', FMemoFont.FaceName );
1260 IniFile.WriteInteger( 'Font', 'Size', FMemoFont.PointSize );
1261 IniFile.Erase( 'Font', 'Bold' ); // no longer used
1262
1263 IniFile.WriteInteger( 'Color', 'Foreground', FMemoPenColor );
1264 IniFile.WriteInteger( 'Color', 'Background', FMemoColor );
1265
1266 IniFile.WriteString( 'AutoSave', 'Type', AutoSaveTypeStrings[ FAutoSaveType ] );
1267 IniFile.WriteInteger( 'AutoSave', 'Minutes', FAutoSaveMinutes );
1268 IniFile.WriteInteger( 'AutoSave', 'Changes', FAutoSaveChanges );
1269 IniFile.WriteBool( 'AutoSave', 'RequireManualSave', FRequireManualSave );
1270
1271 IniFile.WriteBool( 'General', 'WarnLargeFiles', FWarnLargeFiles );
1272
1273 // Old keys, no longer applicable
1274 IniFile.Erase( 'General', 'ConfirmReplace' );
1275 IniFile.Erase( 'General', 'FindFromTop' );
1276 IniFile.Erase( 'General', 'ModalFindReplace' );
1277
1278 IniFile.Destroy;
1279 except
1280 end;
1281End;
1282
1283Function MLMFormat( TextFormat: TTextFormat ): MPARAM;
1284begin
1285 if TextFormat = tfDOS then
1286 result := MLFIE_CFTEXT
1287 else
1288 result := MLFIE_NOTRANS;
1289end;
1290
1291// Insert specified text into memo. Handles any length
1292// the string is not zero terminated.
1293Procedure TMainForm.TextToMemo( Text: pchar;
1294 TextLength: longint );
1295var
1296 InsertPoint: IPT;
1297 ImportSize: longint;
1298 ImportStart: pchar;
1299 ImportEnd: pchar;
1300 MaxImportEnd: pchar;
1301 TextEnd: pchar;
1302begin
1303 FSettingText := true;
1304
1305 CreateMemo;
1306
1307 Memo.BeginUpdate;
1308
1309 // set import format as appropriate
1310 WinSendMsg( Memo.Handle,
1311 MLM_FORMAT,
1312 MLMFormat( FTextFormat ),
1313 0 );
1314
1315 // start at the start
1316 ImportStart := Text;
1317 InsertPoint := 0;
1318
1319 // calculate end address
1320 TextEnd := Text + TextLength;
1321
1322 // loop until end reached...
1323 while ImportStart < TextEnd do
1324 begin
1325 // Work out the block to import.
1326 // We can import up to 64kB at a time;
1327 // and we must make sure to import CR+LF pairs,
1328 // and DBCS characters, as a whole.
1329 ImportEnd := ImportStart;
1330
1331 MaxImportEnd := ImportStart + $FF00; // a bit less than 64k
1332 if MaxImportEnd > TextEnd then
1333 MaxImportEnd := TextEnd;
1334
1335 // Now loop thru the block. Blech! Recode in assembler?
1336 while ImportEnd < MaxImportEnd do
1337 begin
1338 if ImportEnd[ 0 ] = #13 then
1339 begin
1340 // CR
1341 inc( ImportEnd );
1342 if ImportEnd < TextEnd then
1343 if ImportEnd[ 0 ] = #10 then
1344 // and LF.
1345 inc( ImportEnd );
1346 end
1347 else if ImportEnd[ 0 ] < #128 then
1348 begin
1349 // can't be a DBCS char
1350 inc( ImportEnd );
1351 end
1352 else
1353 begin
1354 ImportEnd := _WinNextChar( AppHandle,
1355 0, // system codepage
1356 0, // reserved
1357 ImportEnd );
1358 end;
1359 end;
1360
1361 // Work out size
1362 ImportSize := PCharDiff( ImportEnd, ImportStart );
1363
1364 // set import buffer
1365 WinSendMsg( Memo.Handle,
1366 MLM_SETIMPORTEXPORT,
1367 LongWord( ImportStart ),
1368 ImportSize );
1369
1370 Screen.Cursor := crHourGlass;
1371
1372 // do the import
1373 WinSendMsg( Memo.Handle,
1374 MLM_IMPORT,
1375 ULONG( @InsertPoint ),
1376 ImportSize );
1377
1378 // next block. (MLM_IMPORT adjusts the insertpoint itself)
1379 inc( ImportStart, ImportSize );
1380 end;
1381
1382 Memo.EndUpdate;
1383
1384 Screen.Cursor := crDefault;
1385
1386 FSettingText := false;
1387end;
1388
1389// Insert specified text into memo. Handles any length
1390// the string is not zero terminated.
1391Procedure TMainForm.MemoToText( Var Text: pchar;
1392 Var TextLength: longint;
1393 SelectionOnly: boolean );
1394Var
1395 Start: IPT;
1396 NumCharacters: longint;
1397 ExportStart: pchar;
1398 ExportLength: longint;
1399 BytesExported: longint;
1400 SelEnd: IPT;
1401
1402begin
1403 WinSendMsg( Memo.Handle,
1404 MLM_FORMAT,
1405 MLMFormat( FTextFormat ),
1406 0 ); // set format as appropriate
1407
1408 if SelectionOnly then
1409 begin
1410 // get start and end of selection
1411 Start := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MINSEL, 0 );
1412 SelEnd := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MAXSEL, 0 );
1413 NumCharacters := SelEnd - Start;
1414 end
1415 else
1416 begin
1417 // all the text
1418 NumCharacters := WinSendMsg( Memo.Handle,
1419 MLM_QUERYTEXTLENGTH,
1420 0,
1421 0 );
1422 Start := 0;
1423 end;
1424
1425 // convert to formatted size
1426 TextLength := WinSendMsg( Memo.Handle,
1427 MLM_QUERYFORMATTEXTLENGTH,
1428 Start,
1429 NumCharacters );
1430
1431 // allocate memory for the text
1432 Text := StrAlloc( TextLength );
1433
1434 ExportStart := Text;
1435
1436 BytesExported := 0;
1437 while BytesExported < TextLength do
1438 begin
1439 // how much to export in this block?
1440 ExportLength := $ff00;
1441 if BytesExported + ExportLength > TextLength then
1442 // last block - take remainder
1443 ExportLength := TextLength - BytesExported;
1444
1445 // set buffer
1446 WinSendMsg( Memo.Handle,
1447 MLM_SETIMPORTEXPORT,
1448 LongWord( ExportStart + BytesExported ),
1449 ExportLength );
1450 // do the export
1451 BytesExported :=
1452 BytesExported
1453 + WinSendMsg( Memo.Handle,
1454 MLM_EXPORT,
1455 ULONG( @Start ),
1456 ULONG( @ExportLength ) );
1457 end;
1458end;
1459
1460Procedure TMainForm.RedisplayText;
1461var
1462 Text: PChar;
1463 Size: longint;
1464 OldChanged: boolean;
1465begin
1466 OldChanged := GetChanged;
1467
1468 // save text cause setting scrollbars clears the window.
1469 // normally it would store it into a TStringList but we don't
1470 // want that as it is limited to 255; so StoreLines is set to false.
1471
1472 MemoToText( Text, Size, false );
1473
1474 // now restore the text. This will setup the memo etc.
1475 TextToMemo( Text, Size );
1476
1477 StrDispose( Text );
1478
1479 SetChanged( OldChanged );
1480end;
1481
1482Procedure TMainForm.SetWrap( Value: boolean );
1483var
1484 OldCursor: IPT;
1485 OldAnchor: IPT;
1486begin
1487 OptionsWrapMI.Checked := Value;
1488
1489 if FWrap = Value then
1490 exit;
1491 FWrap := Value;
1492
1493 if Assigned( Memo ) then
1494 begin
1495 // preserve cursor/selection
1496 OldCursor := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_CURSORSEL, 0 );
1497 OldAnchor := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_ANCHORSEL, 0 );
1498 end
1499 else
1500 begin
1501 OldCursor := 0;
1502 OldAnchor := 0;
1503 end;
1504
1505 RedisplayText;
1506
1507 WinSendMsg( Memo.Handle, MLM_SETSEL, OldAnchor, OldCursor );
1508
1509 UpdatePosition;
1510
1511 PostMsg( Handle, WM_FOCUSMEMO, 0, 0 );
1512end;
1513
1514Procedure TMainForm.OptionsWrapMIOnClick (Sender: TObject);
1515Begin
1516 SetWrap( not FWrap );
1517End;
1518
1519Procedure TMainForm.EditSelectAllMIOnClick (Sender: TObject);
1520Begin
1521 Memo.SelectAll;
1522End;
1523
1524Procedure TMainForm.EditPasteMIOnClick (Sender: TObject);
1525Begin
1526 SendMsg( Memo.Handle, MLM_PASTE, 0, 0 );
1527End;
1528
1529Procedure TMainForm.EditCopyMIOnClick (Sender: TObject);
1530Begin
1531 SendMsg( Memo.Handle, MLM_COPY, 0, 0 );
1532End;
1533
1534Procedure TMainForm.EditCutMIOnClick (Sender: TObject);
1535Begin
1536 SendMsg( Memo.Handle, MLM_CUT, 0, 0 );
1537End;
1538
1539Procedure TMainForm.EditUndoMIOnClick (Sender: TObject);
1540Begin
1541 SendMsg( Memo.Handle, MLM_UNDO, 0, 0 );
1542End;
1543
1544Procedure TMainForm.OptionsReadOnlyMIOnClick (Sender: TObject);
1545Begin
1546 SetReadOnly( not FReadOnly );
1547End;
1548
1549procedure TMainForm.SetReadOnly( Value: boolean );
1550begin
1551 FReadOnly := Value;
1552 if Assigned( Memo ) then
1553 Memo.ReadOnly := Value;
1554
1555 OptionsReadOnlyMI.Checked := Value;
1556
1557 UpdateStatus;
1558 EnableControls;
1559end;
1560
1561Procedure TMainForm.UpdateStatus;
1562var
1563 Status: string;
1564begin
1565 if FReadOnly then
1566 begin
1567 Status := ReadOnlyStatus
1568 end
1569 else if GetChanged then
1570 begin
1571 if FFilename = '' then
1572 Status := NewStatus
1573 else
1574 Status := ModifiedStatus
1575 end
1576 else
1577 begin
1578 Status := '';
1579 end;
1580
1581 if Status <> StatusBar.Panels[ 3 ].Text then
1582 begin
1583 // only redraw if needed. (StatusBar is not smart enough to do this)
1584 StatusBar.Panels[ 3 ].Text := Status;
1585 StatusBar.Refresh;
1586 end;
1587end;
1588
1589Procedure TMainForm.FileSaveAsMIOnClick (Sender: TObject);
1590Begin
1591 SaveFileAs;
1592End;
1593
1594Procedure TMainForm.FileSaveMIOnClick (Sender: TObject);
1595Begin
1596 SaveFile;
1597End;
1598
1599Procedure TMainForm.MainFormOnCloseQuery (Sender: TObject;
1600 Var CanClose: Boolean);
1601Begin
1602 if GetChanged then
1603 begin
1604 // check whether user wants to save, discard or stop closing
1605 if not CloseFile then
1606 begin
1607 // cancel close
1608 CanClose := false;
1609 end;
1610 end
1611 else
1612 begin
1613 CloseFile; // mainly to get colors back from memo
1614 end;
1615End;
1616
1617Procedure TMainForm.FileNewMIOnClick (Sender: TObject);
1618Begin
1619 CloseFile;
1620End;
1621
1622Procedure TMainForm.MemoOnMouseUp (Sender: TObject; Button: TMouseButton;
1623 Shift: TShiftState; X: LongInt; Y: LongInt);
1624Begin
1625 PostUpdatePosition;
1626End;
1627
1628Procedure TMainForm.MemoOnChange (Sender: TObject);
1629Begin
1630 if FSettingText then
1631 exit;
1632
1633 PostMsg( Handle, WM_MEMOCHANGE, 0, 0 );
1634end;
1635
1636Procedure TMainForm.WMMemoChange( Var Msg: TMessage );
1637begin
1638 UpdatePosition;
1639 UpdateStatus;
1640 SetMessage( '' );
1641
1642 if FAutoSaveType = asChanges then
1643 begin
1644 inc( FChangeCount );
1645 if FChangeCount > FAutoSaveChanges then
1646 begin
1647 AutoSave;
1648 end;
1649 end
1650 else if FAutoSaveType = asTimed then
1651 begin
1652 if not AutoSaveTimer.Running then
1653 // start timing...
1654 AutoSaveTimer.Start;
1655 end;
1656End;
1657
1658Procedure TMainForm.WMFocusMemo( Var Msg: TMessage );
1659begin
1660 Memo.Focus;
1661end;
1662
1663Procedure TMainForm.WMUpdatePosition( Var Msg: TMessage );
1664begin
1665 UpdatePosition;
1666end;
1667
1668Procedure TMainForm.UpdateCaption;
1669begin
1670 if FFilename = '' then
1671 Caption := AppTitle + '-' + UntitledTitle
1672 else
1673 Caption := AppTitle + '-' + FFilename;
1674end;
1675
1676Procedure TMainForm.UpdatePosition;
1677var
1678 CursorPosition: longint;
1679 Row: longint;
1680 Column: longint;
1681 RowStartPosition: longint;
1682begin
1683 if Memo.WordWrap then
1684 begin
1685 // MLE doesn't report line/col usefully in wrap mode
1686 StatusBar.Panels[ 2 ].Text := '';
1687 exit;
1688 end;
1689
1690 CursorPosition := SendMsg( Memo.Handle,
1691 MLM_QUERYSEL,
1692 MLFQS_CURSORSEL,
1693 0 );
1694 Row := SendMsg( Memo.Handle,
1695 MLM_LINEFROMCHAR,
1696 CursorPosition,
1697 0 );
1698
1699 RowStartPosition := SendMsg( Memo.Handle,
1700 MLM_CHARFROMLINE,
1701 Row,
1702 0 );
1703
1704 Column := CursorPosition - RowStartPosition;
1705 StatusBar.Panels[ 2 ].Text := IntToStr( Row + 1 )
1706 + ': '
1707 + IntToStr( Column + 1 );
1708 StatusBar.Refresh;
1709end;
1710
1711Procedure TMainForm.PostUpdatePosition;
1712begin
1713 PostMsg( Handle, WM_UPDATEPOSITION, 0, 0 );
1714end;
1715
1716Procedure TMainForm.UpdateMode;
1717begin
1718 if WinQuerySysValue( HWND_DESKTOP, SV_INSERTMODE ) <> 0 then
1719 StatusBar.Panels[ 1 ].Text := InsertStatus
1720 else
1721 StatusBar.Panels[ 1 ].Text := OverwriteStatus
1722end;
1723
1724Procedure TMainForm.MemoOnScan (Sender: TObject; Var KeyCode: TKeyCode);
1725Begin
1726 case KeyCode of
1727 kbCtrlZ:
1728 SendMsg( Memo.Handle, MLM_UNDO, 0, 0 );
1729
1730 kbF3:
1731 // a contentious issue: old timers would prefer this to be exit...
1732 // But Windows Notepad and other applications use it as find next
1733 if FExitOnF3 then
1734 Close
1735 else
1736 Find;
1737
1738 kbF2:
1739 SaveFile; // EPM compatibility
1740 end;
1741 PostUpdatePosition;
1742 UpdateMode;
1743End;
1744
1745Procedure TMainForm.MainFormOnResize (Sender: TObject);
1746var
1747 i: longint;
1748 FirstPanelWidth: longint;
1749Begin
[467]1750 StatusBar.Height := Canvas.TextHeight( 'S' ) + Font.InternalLeading + 2;
[454]1751 if Assigned( Memo ) then
1752 begin
1753 Memo.Left := 0;
1754 Memo.Bottom := StatusBar.Height + 2;
1755 Memo.Width := ClientWidth;
1756 Memo.Height := ClientHeight - ( StatusBar.Height + 2 );
1757 end;
1758
1759 FirstPanelWidth := ClientWidth;
1760
1761 for i := 1 to StatusBar.Panels.Count - 1 do
1762 dec( FirstPanelWidth,
1763 StatusBar.Panels[ i ].Width
1764 + StatusBar.Spacing );
1765
1766 StatusBar.Panels[ 0 ].Width := FirstPanelWidth;
1767End;
1768
1769Procedure TMainForm.MainFormOnSetupShow (Sender: TObject);
1770Begin
1771End;
1772
1773Procedure TMainForm.MainFormOnShow (Sender: TObject);
1774var
1775 IniFile: TMyIniFile;
1776 AutoSaveTypeString: string;
1777 ParamIndex: longint;
1778 Param: string;
1779 ReadOnlyFlag: boolean;
1780 Filename: string;
1781Begin
1782 // ValidateSPCCObjects;
1783
1784 // Set the menu fonts, because they remember their own specific one
1785 MainMenu.Font := Screen.MenuFont;
1786
1787 // get default font
1788 FMemoFont := Screen.GetFontFromPointSize( 'System VIO', 10 );
1789 if FMemoFont = nil then
1790 FMemoFont := Screen.GetFontFromPointSize( 'Courier', 10 );
1791 if FMemoFont = nil then
1792 FMemoFont := Screen.DefaultFont;
1793
1794 try
1795 IniFile := TMyIniFile.Create( GetIniFilePath( 'ae.ini' ) );
1796 FFindCaseSensitive := IniFile.ReadBool( 'General', 'FindCaseSensitive', false );
1797 FFindText := IniFile.ReadString( 'General', 'FindText', '' );
1798 FReplaceText := IniFile.ReadString( 'General', 'ReplaceText', '' );
1799 FLastDirectory := IniFile.ReadString( 'General',
1800 'LastDirectory',
1801 GetBootDrive + ':\' );
1802 FWrap := IniFile.ReadBool( 'General', 'WordWrap', true );
1803 SetExitOnF3( IniFile.ReadBool( 'General', 'ExitOnF3', true ) );
1804 FPrintHeader := IniFile.ReadBool( 'General', 'PrintHeader', FPrintHeader );
1805
1806 LoadFormSizePosition( self, IniFile );
1807
1808 FMemoFont :=
1809 Screen.CreateCompatibleFont(
1810 Screen.GetFontFromPointSize(
1811 IniFile.ReadString( 'Font', 'Face', FMemoFont.FaceName ),
1812 IniFile.ReadInteger( 'Font', 'Size', FMemoFont.PointSize ) ) );
1813
1814 FMemoPenColor := IniFile.ReadInteger( 'Color', 'Foreground', clWindowText );
1815 FMemoColor := IniFile.ReadInteger( 'Color', 'Background', clEntryField );
1816
1817 AutoSaveTypeString := IniFile.ReadString( 'AutoSave', 'Type', 'None' );
1818 if StringsSame( AutoSaveTypeString, 'Timed' ) then
1819 FAutoSaveType := asTimed
1820 else if StringsSame( AutoSaveTypeString, 'Changes' ) then
1821 FAutoSaveType := asChanges
1822 else
1823 FAutoSaveType := asNone;
1824
1825 FAutoSaveMinutes := IniFile.ReadInteger( 'AutoSave', 'Minutes', 10 );
1826 FAutoSaveChanges := IniFile.ReadInteger( 'AutoSave', 'Changes', 100 );
1827 FRequireManualSave := IniFile.ReadBool( 'AutoSave', 'RequireManualSave', true ); // like E
1828
1829 FWarnLargeFiles := IniFile.ReadBool( 'General', 'WarnLargeFiles', true );
1830
1831 IniFile.Destroy;
1832 except
1833 end;
1834
1835 CloseFile;
1836 UpdateMode;
1837 SetWrap( FWrap );
1838
1839 FShowUsage := false;
1840 ReadOnlyFlag := false;
1841 Filename := '';
1842
1843 for ParamIndex := 1 to ParamCount do
1844 begin
1845 Param := ParamStr( ParamIndex );
1846 {
1847 if MatchFlagParam( Param, '?' )
1848 or MatchFlagParam( Param, 'H' )
1849 or MatchFlagParam( Param, 'HELP' ) then
1850 }
1851 if ( CompareText( Param, '/?' ) = 0 )
1852 or ( CompareText( Param, '/H' ) = 0 )
1853 or ( CompareText( Param, '/HELP' ) = 0 ) then
1854 begin
1855 FShowUsage := true
1856 end
1857 else if CompareText( Param, '/READ' ) = 0 then
1858 begin
1859 ReadOnlyFlag := true;
1860 end
1861 else
1862 begin
1863 if Filename = '' then
1864 Filename := Param
1865 else
1866 // too many parameters
1867 FShowUsage := true;
1868 end;
1869 end;
1870
1871 // load file from command line, if specified
1872 if Filename <> '' then
1873 begin
1874 OpenFile( Filename, false ); // don't complain (might want a new one)
1875 FFilename := Filename; // even if not found, so can save new one.
1876 if ReadOnlyFlag then
1877 SetReadOnly( true );
1878 UpdateCaption;
1879 end
1880 else
1881 begin
1882 UpdatePosition;
1883 end;
1884
1885 PostMsg( Handle, WM_OPENED, 0, 0 );
1886End;
1887
1888procedure TMainForm.WMOpened( Var Msg: TMessage );
1889begin
1890 if FShowUsage then
1891 DoMessageDlg( UsageTitle,
1892 Usage1 + EndLine + Usage2 + EndLine + EndLine + Usage3 );
1893
1894 Memo.Focus;
1895 UpdateStatus;
1896end;
1897
1898function TMainForm.SaveFileTo( const Filename: string ): boolean;
1899var
1900 Text: pchar;
1901 F: HFILE;
1902 rc: APIRET;
1903 szName: cstring;
1904 OpenAction: ULONG;
1905 ActualWritten: ULONG;
1906 Size: longint;
1907begin
1908 Result := false;
1909
1910 MemoToText( Text, Size, false );
1911
1912 szName := FileName;
1913 rc:= DosOpen( szName,
1914 F,
1915 OpenAction,
1916 Size, // file size (only used if file is new)
1917 0, // attrs
1918 OPEN_ACTION_CREATE_IF_NEW + OPEN_ACTION_OPEN_IF_EXISTS,
1919 OPEN_SHARE_DENYREADWRITE + OPEN_ACCESS_WRITEONLY,
1920 nil ); // no eas
1921 if rc <> 0 then
1922 begin
1923 case rc of
1924 ERROR_ACCESS_DENIED:
1925 begin
1926 if FileIsReadOnly( Filename ) then
1927 DoErrorDlg( SaveTitle,
1928 SaveReadonlyError
1929 + FileName )
1930 else
1931 DoErrorDlg( SaveTitle,
1932 SaveAccessDeniedError
1933 + FileName );
1934 end;
1935
1936 ERROR_SHARING_VIOLATION:
1937 DoErrorDlg( SaveTitle,
1938 FileInUseError
1939 + FileName );
1940
1941 else
1942 DoErrorDlg( SaveTitle,
1943 SaveError
1944 + FileName
1945 + ' '
1946 + SysErrorMessage( rc ) );
1947 end;
1948 exit;
1949 end;
1950
1951 // Set the file size. This is done for two reasons:
1952 // 1. (Most important) we are not replacing the file but overwriting
1953 // existing data, in order to keep extended attributes. So we need
1954 // to set the correct size in case the file on disk is currently longer.
1955 // 2. Efficiently allocate space
1956 rc := DosSetFileSize( F, Size );
1957 if rc = 0 then
1958 rc := DosWrite( F, Text^, Size, ActualWritten );
1959
1960 DosClose( F );
1961 StrDispose( Text );
1962
1963 if rc <> 0 then
1964 begin
1965 DoErrorDlg( SaveTitle,
1966 SaveError
1967 + Filename
1968 + ' '
1969 + SysErrorMessage( rc ) );
1970 exit;
1971 end;
1972
1973 SetMessage( SavedMsg + Filename );
1974
1975 SetChanged( false );
1976
1977 Result := true;
1978end;
1979
1980function TMainForm.SaveFileAs: boolean;
1981begin
1982 Result := false;
1983 SaveDialog.Title := SaveTitle;
1984 SaveDialog.Filename := FFilename;
1985 if not SaveDialog.Execute then
1986 exit;
1987 if FileExists( SaveDialog.Filename ) then
1988 if not DoConfirmDlg( SaveTitle,
1989 ReplacePrompt
1990 + EndLine
1991 + SaveDialog.Filename ) then
1992 exit;
1993 if not SaveFileTo( SaveDialog.Filename ) then
1994 exit;
1995
1996 Result := true;
1997 FFilename := SaveDialog.Filename;
1998 FLastDirectory := ExtractFilePath( FFilename );
1999
2000 UpdateCaption;
2001end;
2002
2003function TMainForm.SaveFile: boolean;
2004begin
2005 Result := true;
2006 if FFilename = '' then
2007 begin
2008 Result := SaveFileAs;
2009 exit;
2010 end;
2011
2012 Result := SaveFileTo( FFilename );
2013end;
2014
2015procedure TMainForm.CreateMemo;
2016begin
2017 // MLE seems to be crap in this respect,
2018 // we have to destroy it to free up memory or something!
2019 if Assigned( Memo ) then
2020 begin
2021 FMemoPenColor := Memo.PenColor;
2022 FMemoColor := Memo.Color;
2023 Memo.Destroy;
2024 end;
2025
2026 Memo := TCustomMemo.Create( self );
2027
2028 Memo.WordWrap := FWrap;
2029 if Memo.WordWrap then
2030 Memo.ScrollBars := ssVertical
2031 else
2032 Memo.ScrollBars := ssBoth;
2033
2034 MainFormOnResize( self );
2035 Memo.BorderStyle := bsNone;
2036 Memo.StoreLines := false;
2037 Memo.ReadOnly := FReadOnly;
2038
2039 Memo.PopupMenu := EditPopupMenu;
2040
2041 Memo.Parent := self;
2042 Memo.Font := FMemoFont;
2043
2044 Memo.PenColor := FMemoPenColor;
2045 Memo.Color := FMemoColor;
2046
2047 Memo.WantTabs := true;
2048 {
2049 // can't do it at this point in startup.
2050 // leave as default (8 spaces)
2051 SendMsg( Memo.Handle,
2052 MLM_SETTABSTOP,
2053 Memo.Canvas.TextWidth( 'm' ) * 2,
2054 0 );
2055 }
2056 WinSendMsg( Memo.Handle, MLM_RESETUNDO, 0, 0 ); // cause setting the color counts as an undoable item!
2057
2058 Memo.OnFontChange := MemoOnFontChange;
2059 Memo.OnChange := MemoOnChange;
2060 Memo.OnMouseUp := MemoOnMouseUp; // for updating position
2061 Memo.OnScan := MemoOnScan; // overriding some keys
2062 Memo.OnDragDrop := MemoOnDragDrop;
2063 Memo.OnDragOver := MemoOnDragOver;
2064end;
2065
2066function TMainForm.CloseFile: boolean;
2067begin
2068 result := false;
2069
2070 if Assigned( Memo ) then
2071 begin
2072 if GetChanged then
2073 begin
2074 SaveQueryForm.ShowModal;
2075
2076 case SaveQueryForm.ModalResult of
2077 cmSave:
2078 if not SaveFile then
2079 exit;
2080
2081 cmCancel:
2082 exit;
2083
2084 // else - cmDiscard - do nothing
2085 end;
2086 end;
2087 end;
2088
2089 Result := true;
2090
2091 CreateMemo;
2092
2093 SetChanged( false );
2094 SetReadOnly( false );
2095
2096 FTextFormat := tfDOS;
2097
2098 UpdateStatus;
2099 EnableControls;
2100
2101 FFilename := '';
2102 UpdateCaption;
2103
2104 SetMessage( NewFileMsg );
2105
2106 PostMsg( Handle, WM_FOCUSMEMO, 0, 0 );
2107end;
2108
2109procedure TMainForm.DetectTextFormat( Text: pchar;
2110 TextLength: ULONG );
2111var
2112 ScanLength: ULONG;
2113 p: pchar;
2114 EndP: pchar;
2115begin
2116 // scan up to 64k for the first line break
2117
2118 ScanLength := TextLength;
2119 if ScanLength > 65536 then
2120 ScanLength := 65536;
2121
2122 p := Text + 1;
2123 EndP := Text + ScanLength;
2124
2125 FTextFormat := tfDOS; // default if no linebreak found
2126 while p < EndP do
2127 begin
2128 if p[ 0 ] = #10 then // Line feed
2129 begin
2130 if (p-1)[ 0 ] = #13 then
2131 // CRLF -> DOS
2132 FTextFormat := tfDOS
2133 else
2134 // LF by itself -> Unix
2135 FTextFormat := tfUnix;
2136 break;
2137 end;
2138 inc( p );
2139 end;
2140end;
2141
2142function TMainForm.OpenFile( const Filename: string;
2143 ComplainIfMissing: boolean ): boolean;
2144var
2145 Text: pchar;
2146 F: HFILE;
2147 rc: APIRET;
2148 szName: cstring;
2149 OpenAction: ULONG;
2150 FileInfo: FILESTATUS3;
2151 ActualRead: ULONG;
2152 TextLength: ULONG;
2153begin
2154 Result := false;
2155 if not CloseFile then
2156 exit;
2157
2158 Screen.Cursor := crHourGlass;
2159
2160 szName := Filename;
2161 rc := DosOpen( szName,
2162 F,
2163 OpenAction,
2164 0, // file size - irrelevant, not creating,
2165 0, // attrs - ''
2166 OPEN_ACTION_OPEN_IF_EXISTS,
2167 OPEN_SHARE_DENYREADWRITE + OPEN_ACCESS_READONLY,
2168 nil ); // no eas
2169 if rc <> 0 then
2170 begin
2171 Screen.Cursor := crDefault;
2172 case rc of
2173 ERROR_FILE_NOT_FOUND,
2174 ERROR_OPEN_FAILED:
2175 if ComplainIfMissing then
2176 DoErrorDlg( OpenTitle,
2177 FileDoesNotExistError + FileName );
2178
2179 ERROR_ACCESS_DENIED:
2180 DoErrorDlg( OpenTitle,
2181 OpenAccessDeniedError + FileName );
2182
2183 ERROR_SHARING_VIOLATION:
2184 DoErrorDlg( OpenTitle,
2185 OpenFileInUseError + FileName );
2186
2187 else
2188 DoErrorDlg( OpenTitle,
2189 OpenError
2190 + FileName
2191 + ' '
2192 + SysErrorMessage( rc ) );
2193 end;
2194 exit;
2195 end;
2196
2197 // Get file size
2198 rc := DosQueryFileInfo( F,
2199 FIL_STANDARD,
2200 FileInfo,
2201 sizeof( FileInfo ) );
2202 if rc <> 0 then
2203 begin
2204 Screen.Cursor := crDefault;
2205 DosClose( F );
2206 DoErrorDlg( OpenTitle,
2207 OpenError + SysErrorMessage( rc ) );
2208 exit;
2209 end;
2210
2211 TextLength := FileInfo.cbFile;
2212
2213 if FWarnLargeFiles
2214 and ( TextLength > 1000*1000 ) then
2215 begin
2216 Screen.Cursor := crDefault;
2217 LargeFileWarningForm.NotAgainCheckBox.Checked := not FWarnLargeFiles;
2218 LargeFileWarningForm.ShowModal;
2219 FWarnLargeFiles := not LargeFileWarningForm.NotAgainCheckBox.Checked;
2220
2221 if LargeFileWarningForm.ModalResult <> mrOK then
2222 begin
2223 DosClose( F );
2224 exit;
2225 end;
2226
2227 Screen.Cursor := crHourGlass;
2228 end;
2229
2230 // allocate temp memory for loading file
2231 GetMem( Text, TextLength );
2232
2233 rc := DosRead( F, Text^, TextLength, ActualRead );
2234 DosClose( F );
2235
2236 if rc <> 0 then
2237 begin
2238 Screen.Cursor := crDefault;
2239 FreeMem( Text, TextLength );
2240 DoErrorDlg( OpenTitle,
2241 OpenError + SysErrorMessage( rc ) );
2242 exit;
2243 end;
2244
2245 DetectTextFormat( Text, TextLength );
2246
2247 TextToMemo( Text, ActualRead );
2248
2249 UpdatePosition;
2250
2251 FreeMem( Text, TextLength );
2252
2253 FFilename := Filename;
2254
2255 FLastDirectory := ExtractFilePath( FFilename );
2256
2257 UpdateCaption;
2258
2259 SetChanged( false );
2260 WinSendMsg( Memo.Handle, MLM_RESETUNDO, 0, 0 ); // cause setting the color counts as an undoable item!
2261
2262 if FileGetAttr( Filename ) and faReadOnly <> 0 then
2263 SetReadonly( True );
2264
2265 SetMessage( OpenedMsg + Filename );
2266
2267 Screen.Cursor := crDefault;
2268
2269 Result := true;
2270end;
2271
2272Procedure TMainForm.FileOpenMIOnClick (Sender: TObject);
2273Begin
2274 OpenDialog.Filename := AddSlash( FLastDirectory ) + '*.*';
2275 if OpenDialog.Execute then
2276 OpenFIle( OpenDialog.Filename, true );
2277End;
2278
2279Procedure TMainForm.FileExitMIOnClick (Sender: TObject);
2280Begin
2281 Close;
2282End;
2283
2284Function TMainForm.GetChanged: boolean;
2285begin
2286 Result := SendMsg( Memo.Handle,
2287 MLM_QUERYCHANGED,
2288 0,
2289 0 ) <> 0;
2290end;
2291
2292Procedure TMainForm.SetChanged( Value: boolean );
2293begin
2294 SendMsg( Memo.Handle,
2295 MLM_SETCHANGED,
2296 MParam( Value ),
2297 0 );
2298 if not Value then
2299 // ack! pffbt! Shouldn't this be if Value ???
2300 // changed: start timing/counting for autosave
2301 InitAutoSave;
2302 UpdateStatus;
2303end;
2304
2305procedure TMainForm.OnHint( Sender: TObject );
2306Begin
2307 SetMessage( Application.Hint );
2308end;
2309
2310const
2311 Vendor = 'Aaron Lawrence';
2312 Description = 'Text Editor';
[479]2313{
[469]2314 // BLDLevel-like info (not actually compatible with BLDLEVEL command)
[454]2315 EmbeddedVersion: string =
2316 '@#'
2317 + Vendor
2318 + ':'
2319 + BldLevelVersion
2320 + '#@'
2321 + Description
2322 + #0;
[479]2323}
[454]2324
2325Initialization
2326 RegisterClasses ([TMainForm, TMainMenu, TStatusBar, TMenuItem,
2327 TSystemOpenDialog, TSystemSaveDialog, TTimer, TPopupMenu, TCustomFontDialog]);
2328End.
Note: See TracBrowser for help on using the repository browser.