source: trunk/ae/MainFormUnit.pas@ 469

Last change on this file since 469 was 469, checked in by ataylor, 3 years ago

Improve print dialog scaling; avoid crash when querying the system time/date formats
File size: 61.1 KB
Line 
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
11 AppVersion = 'v1.9.8d'; // $SS_REQUIRE_NEW_VERSION$
12 BldLevelVersion = '1.9.8d';
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;
626Begin
627 if not ( Source is TExternalDragDropObject ) then
628 // probably not needed, but crashes during drag drop completely
629 // screw PM, so best to be sure!
630 exit;
631
632 DropObject := Source as TExternalDragDropObject;
633
634 g_DroppedFileName := AddSlash( DropObject.ContainerName )
635 + DropObject.SourceFilename;
636 // can't process synchronously, cause we need to destroy the memo
637 // that's handling the drop event
638 PostMsg( Self.Handle,
639 WM_OPENDROPPEDFILE,
640 0,
641 0 );
642end;
643
644Procedure TMainForm.MemoOnFontChange( Sender: TObject );
645begin
646 FMemoFont := Memo.Font;
647end;
648
649Procedure TMainForm.HelpContentsMIOnClick (Sender: TObject);
650Begin
651 Application.HelpContents;
652End;
653
654Procedure TMainForm.PrintPageHeader( X: longint;
655 Y: longint;
656 Width: longint );
657var
658 DateTimeStr: string;
659 DateTimeX: longint;
660 PageNumberStr: string;
661begin
662
663 // Filename top left
664 Printer.Canvas.TextOut( X,
665 Y,
666 ExtractFileName( FFilename ) );
667
668 // centred date/time, if it fits (short/long date/time strings cause crash on some systems)
669 DateTimeStr := FormatDateTime( 'yyyy/mm/dd h:nn:ss ampm',
670 Now );
671
672 DateTimeX := X
673 + Width div 2
674 - Printer.Canvas.TextWidth( DateTimeStr ) div 2;
675
676 if DateTimeX > Printer.Canvas.PenPos.X then
677 // datetime starts after end of filename
678 Printer.Canvas.TextOut( DateTimeX,
679 Y,
680 DateTimeStr );
681
682 // page number, top right
683 PageNumberStr := IntToStr( Printer.PageNumber );
684
685 Printer.Canvas.TextOut( Width
686 - Printer.Canvas.TextWidth( PageNumberStr ),
687 Y,
688 PageNumberStr );
689
690end;
691
692type
693 TCharWidthArray = array[ #0..#255 ] of longint;
694
695Procedure TMainForm.SelectNone;
696var
697 CursorPosition: ULONG;
698begin
699 CursorPosition := SendMsg( Memo.Handle,
700 MLM_QUERYSEL,
701 MLFQS_CURSORSEL,
702 0 );
703
704 SendMsg( Memo.Handle,
705 MLM_SETSEL,
706 CursorPosition,
707 CursorPosition );
708end;
709
710Function TMainForm.HaveSelection: boolean;
711begin
712 result := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MAXSEL, 0 )
713 - WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MINSEL, 0 )
714 > 0;
715end;
716
717Procedure TMainForm.FilePrintMIOnClick (Sender: TObject);
718var
719 MarginSize: longint;
720 RightMargin: longint;
721 TopMargin: longint;
722 p: pchar;
723 EndP: Pchar;
724 Text: pchar;
725 Size: longint;
726 c: char;
727 TextHeight: longint;
728
729 pLineStart: pchar;
730 pLineEnd: pchar;
731 pLastBreak: pchar;
732
733 CharWidths: TCharWidthArray;
734 X: longint;
735 Y: longint;
736 DrawPoint: POINTL;
737
738 NumberOfPages: longint;
739Begin
740 if Printer.Printers.Count = 0 then
741 begin
742 DoErrorDlg( PrintTitle,
743 NoPrinterError );
744 exit;
745 end;
746
747 AEPrintDialog.HeaderCheckBox.Checked := FPrintHeader;
748
749 if HaveSelection then
750 // there's a selection - use that
751 AEPrintDialog.SelectionRadioButton.Checked := true
752 else
753 AEPrintDialog.AllRadioButton.Checked := true;
754
755 AEPrintDialog.ShowModal;
756 if AEPrintDialog.ModalResult <> mrOK then
757 exit;
758
759 FPrintHeader := AEPrintDialog.HeaderCheckBox.Checked;
760
761 Screen.Cursor := crHourglass;
762
763 Printer.Title := FFilename;
764
765 Printer.BeginDoc;
766
767 // Pick the printer font.
768 if FMemoFont.FontType = ftBitmap then
769 begin
770 // pick an appropriate outline font
771 if FMemoFont.Pitch = fpFixed then
772 begin
773 Printer.Canvas.Font :=
774 Screen.GetFontFromPointSize( 'Courier',
775 FMemoFont.PointSize );
776 end
777 else
778 begin
779 Printer.Canvas.Font :=
780 Screen.GetFontFromPointSize( 'Helvetica',
781 FMemoFont.PointSize );
782 end
783 end
784 else
785 begin
786 // the selected memo font is an outline font so use it as is.
787 Printer.Canvas.Font := FMemoFont;
788 end;
789
790 MarginSize := Printer.Canvas.HorizontalResolution // pixels per meter
791 * 0.0125; // 12.5 mm = 0.5 inch
792
793 RightMargin := Printer.PageWidth - MarginSize;
794 TopMargin := Printer.PageHeight - MarginSize;
795
796 TextHeight := Printer.Canvas.TextHeight( 'm' );
797
798 MemoToText( Text,
799 Size,
800 AEPrintDialog.SelectionRadioButton.Checked );
801
802 p := Text;
803 EndP := Text + Size;
804
805 // Retrieve all character widths
806 if not GpiQueryWidthTable( Printer.Canvas.Handle,
807 0, 256,
808 CharWidths[ #0 ] ) then
809 begin
810 raise Exception.Create( 'Error getting character width table: '
811 + 'GpiQueryWidthTable error '
812 + IntToStr( WinGetLastError( AppHandle ) ) );
813 end;
814
815 // Convert all widths to positive!
816 // For unknown reason, sometimes GPI returns negative values...
817 for c := #0 to #255 do
818 begin
819 CharWidths[ c ] := Abs( CharWidths[ c ] );
820 end;
821
822 while p < EndP do
823 begin
824 // Print a page
825
826 SetMessage( PrintingPageMsg
827 + IntToStr( Printer.PageNumber ) );
828
829 Y := TopMargin - TextHeight;
830
831 if FPrintHeader then
832 begin
833 PrintPageHeader( MarginSize, // X
834 Y, // Y
835 RightMargin - MarginSize ); // width
836
837 dec( Y, TextHeight * 2 ); // space for header
838 end;
839
840 // print text that fits on this page
841 while P < EndP do
842 begin
843 // print a line
844
845 // move to start of text area.
846 X := MarginSize;
847
848 pLineStart := p;
849 pLineEnd := nil;
850 pLastBreak := nil;
851
852 // work out how much text fits on the line ie. do wrapping
853 while true do
854 begin
855 if p >= EndP then
856 begin
857 pLineEnd := p;
858 break;
859 end;
860
861 c := p[ 0 ];
862
863 case c of
864 #13: // carriage return
865 begin
866 pLineEnd := p;
867 inc( p );
868 if p[ 0 ] = #10 then
869 // skip following LF
870 inc( p );
871 break;
872 end;
873
874 #10: // linefeed
875 begin
876 pLineEnd := p;
877 inc( p );
878 break;
879 end;
880
881 ' ', #9: // space, tab
882 begin
883 pLastBreak := p;
884 end;
885
886 end;
887
888 // add size of this char
889 inc( X, CharWidths[ c ] );
890
891 if X > RightMargin then
892 begin
893 // need to wrap
894 if pLastBreak <> nil then
895 begin
896 pLineEnd := pLastBreak;
897 p := pLastBreak + 1;
898
899 // skip extra spaces
900 while p < EndP do
901 begin
902 if p[ 0 ] <> ' ' then
903 break;
904 inc( p );
905 end;
906
907 end
908 else
909 begin
910 // no word break, just truncate at this char
911 pLineEnd := p;
912 if p = pLineStart then
913 // draw at least 1 char
914 inc( p );
915 end;
916 break;
917 end;
918 inc( p );
919 end;
920
921 // print the line
922
923 DrawPoint.X := MarginSize;
924 DrawPoint.Y := Y;
925
926 // note: max 512 chars, thanks GPI :(
927 GpiCharStringPosAt( Printer.Canvas.Handle,
928 DrawPoint,
929 nil, // text rect - not used
930 0, // no options
931 PCharDiff( pLineEnd, pLineStart ),
932 pLineStart[ 0 ],
933 nil // no vector of increments
934 );
935 // subtract line height from vertical position
936 dec( Y, TextHeight );
937
938 if P < EndP then
939 begin
940 if Y - TextHeight < MarginSize then
941 begin
942 // next line won't fit on page, new page
943 Printer.NewPage;
944 break;
945 end;
946 end;
947 end;
948 end;
949
950 StrDispose( Text );
951
952 NumberOfPages := Printer.PageNumber;
953
954 Printer.EndDoc;
955
956 Screen.Cursor := crDefault;
957
958 SetMessage( PrintDoneMsg1
959 + IntToStr( NumberOfPages )
960 + PrintDoneMsg2 );
961
962End;
963
964Procedure TMainForm.MainFormOnCreate (Sender: TObject);
965Begin
966 Application.ShowHint := true;
967
968 RegisterForLanguages( OnLanguageEvent );
969
970 LoadDefaultLanguage( 'ae' );
971
972 Font := GetNiceDefaultFont;
973 FPrintHeader := true;
974
975 // set up form icons
976 FormIconResourceID := 1;
977
978 Application.HelpFile := FindDefaultLanguageHelpFile( 'ae' );
979 Application.HelpWindowTitle := HelpTitle;
980
981 Application.OnHint := OnHint;
982End;
983
984Procedure TMainForm.EditReplaceMIOnClick (Sender: TObject);
985Begin
986
987 // load existing preferences to replace dialog
988 ReplaceForm.TextToFindEdit.Text := FFindText;
989 ReplaceForm.ReplaceTextEdit.Text := FReplaceText;
990 ReplaceForm.CaseSensitiveCheckBox.Checked := FFindCaseSensitive;
991 ReplaceForm.FromTopCheckBox.Checked := false;
992
993 ReplaceForm.OnReplaceCommand := OnReplaceCommand;
994
995 SelectNone;
996
997 ReplaceForm.Show;
998 WinSetOwner( ReplaceForm.Frame.Handle, Frame.Handle );
999end;
1000
1001Procedure TMainForm.OnReplaceCommand( Sender: TObject;
1002 Command: TReplaceCommand );
1003var
1004 szFindText: cstring;
1005 szReplaceText: cstring;
1006 SearchData: MLE_SEARCHDATA;
1007 Flags: ULONG;
1008 CursorPosition: ULONG;
1009 CursorLine: ULONG;
1010 CursorLineScreenBottom: ULONG;
1011 TopPosition: ULONG;
1012 TopLine: ULONG;
1013 ReplaceCount: longint;
1014 MatchFound: boolean;
1015begin
1016 // get preferences back from dialog
1017 FFindText := ReplaceForm.TextToFindEdit.Text;
1018 FReplaceText := ReplaceForm.ReplaceTextEdit.Text;
1019 FFindCaseSensitive := ReplaceForm.CaseSensitiveCheckBox.Checked;
1020 FFindFromTop := ReplaceForm.FromTopCheckBox.Checked;
1021 ReplaceForm.FromTopCheckBox.Checked := false; // uncheck after one use
1022
1023 szFindText := FFindText; // convert to null terminated
1024 szReplaceText := FReplaceText; // convert to null terminated
1025
1026 if ( Command = rcReplaceSelectionThenFind )
1027 or ( Command = rcReplaceSelectionAndAll ) then
1028 begin
1029 // first replace selection, if any, with replace text.
1030 // NOTE: Original e.exe actually does another search, and only replaces
1031 // matches regardless of current selection.
1032 // I think this behaviour is perhaps reasonable and even useful.
1033 // Of course most people will not be modifying selection so it is an obscure point.
1034 if HaveSelection then
1035 begin
1036 SendMsg( Memo.Handle,
1037 MLM_INSERT,
1038 MPARAM( Addr( szReplaceText ) ),
1039 0 );
1040 end;
1041 end;
1042 // Set up search data
1043 SearchData.cb := sizeof( SearchData );
1044 SearchData.pchFind := Addr( szFindText );
1045 SearchData.cchFind := Length( FFindText );
1046
1047 // set up flags
1048 Flags := MLFSEARCH_SELECTMATCH; // select the matching text
1049 if FFindCaseSensitive then
1050 Flags := Flags + MLFSEARCH_CASESENSITIVE; // want case sensitive search
1051
1052 ReplaceCount := 0;
1053 MatchFound := false;
1054
1055 while true do
1056 begin
1057 // set search start and end positions
1058 if FFindFromTop then
1059 SearchData.iptStart := 0 // start
1060 else
1061 SearchData.iptStart := -1; // current cursor
1062 FFindFromTop := false;
1063
1064 SearchData.iptStop := -1; // end
1065
1066 // do the search
1067 if SendMsg( Memo.Handle,
1068 MLM_SEARCH,
1069 Flags,
1070 MParam( Addr( SearchData ) ) ) = 0 then
1071 // no (more) matches found
1072 break;
1073
1074 MatchFound := true;
1075
1076 if ( Command = rcFindOnly )
1077 or ( Command = rcReplaceSelectionThenFind ) then
1078 // only doing a single find.
1079 break;
1080
1081 // do the replacement
1082 SendMsg( Memo.Handle,
1083 MLM_INSERT,
1084 MParam( Addr( szReplaceText ) ),
1085 0 );
1086 inc( ReplaceCount );
1087
1088 CursorPosition := SendMsg( Memo.Handle,
1089 MLM_QUERYSEL,
1090 MLFQS_CURSORSEL,
1091 0 );
1092
1093 // move past previous match
1094 SendMsg( Memo.Handle,
1095 MLM_SETSEL,
1096 CursorPosition,
1097 CursorPosition );
1098 end;
1099
1100 if Command = rcFindOnly then
1101 begin
1102 if MatchFound then
1103 SetMessage( MatchMsg )
1104 else
1105// SetMessage( NoMatchMsg )
1106 DoMessageDlg( FindForm.Caption, NoMatchMsg );
1107 end
1108 else
1109 begin
1110 if ReplaceCount > 0 then
1111 SetMessage( ReplaceDoneMsg1
1112 + IntToStr( ReplaceCount )
1113 + ReplaceDoneMsg2 )
1114 else if MatchFound then
1115 SetMessage( NoReplacementsMsg )
1116 else
1117 DoMessageDlg( ReplaceForm.Caption, NoMatchMsg );
1118// SetMessage( NoMatchMsg )
1119 end;
1120End;
1121
1122Procedure TMainForm.MainFormOnActivate (Sender: TObject);
1123Begin
1124 UpdateMode;
1125End;
1126
1127Procedure TMainForm.EditFindAgainMIOnClick (Sender: TObject);
1128Begin
1129 if FFindText = '' then
1130 EditFindMIOnClick( Sender )
1131 else
1132 Find;
1133
1134End;
1135
1136Procedure TMainForm.SetMessage( const Message: string );
1137begin
1138 StatusBar.Panels[ 0 ].Text := Message;
1139end;
1140
1141Procedure TMainForm.Find;
1142var
1143 szFindText: cstring;
1144 SearchData: MLE_SEARCHDATA;
1145 Flags: ULONG;
1146begin
1147 szFindText := FFindText;
1148 SearchData.cb := sizeof( SearchData );
1149 SearchData.pchFind := Addr( szFindText );
1150 SearchData.cchFind := Length( FFindText );
1151 if FFindFromTop then
1152 SearchData.iptStart := 0 // start
1153 else
1154 SearchData.iptStart := -1; // current cursor
1155 FFindFromTop := false;
1156 SearchData.iptStop := -1; // end
1157
1158 Flags := MLFSEARCH_SELECTMATCH;
1159 if FFindCaseSensitive then
1160 Flags := Flags + MLFSEARCH_CASESENSITIVE;
1161
1162 if SendMsg( Memo.Handle,
1163 MLM_SEARCH,
1164 Flags,
1165 MParam( Addr( SearchData ) ) ) <> 0 then
1166 begin
1167 SetMessage( MatchMsg )
1168 end
1169 else
1170 begin
1171 // no match - put focus back on find form, edit box
1172 FindForm.Focus;
1173 FindForm.TextToFindEdit.Focus;
1174 DoMessageDlg( FindForm.Caption, NoMatchMsg );
1175 end;
1176 // SetMessage( NoMatchMsg )
1177end;
1178
1179Procedure TMainForm.EditFindMIOnClick (Sender: TObject);
1180Begin
1181 FindForm.TextToFindEdit.Text := FFindText;
1182 FindForm.CaseSensitiveCheckBox.Checked := FFindCaseSensitive;
1183 FindForm.OnFindClicked := OnFindCommand;
1184 FindForm.FromTopCheckBox.Checked := false;
1185
1186 SelectNone;
1187
1188 FindForm.Show;
1189 WinSetOwner( FindForm.Frame.Handle, Frame.Handle );
1190end;
1191
1192Procedure TMainForm.OnFindCommand;
1193begin
1194 FFindText := FindForm.TextToFindEdit.Text;
1195 FFindCaseSensitive := FindForm.CaseSensitiveCheckBox.Checked;
1196
1197 FFindFromTop := FindForm.FromTopCheckBox.Checked;
1198 FindForm.FromTopCheckBox.Checked := false; // uncheck after one use
1199
1200 Find;
1201End;
1202
1203Procedure TMainForm.HelpProductInformationMIOnClick (Sender: TObject);
1204Begin
1205 ProductInformationForm.NameAndVersionEdit.Text := 'AE ' + AppVersion;
1206 ProductInformationForm.ShowModal;
1207End;
1208
1209Procedure TMainForm.MainFormOnClose (Sender: TObject;
1210 Var Action: TCloseAction);
1211var
1212 IniFile: TMyIniFile;
1213Begin
1214 try
1215 IniFile := TMyIniFile.Create( GetIniFilePath( 'ae.ini' ) );
1216
1217 IniFile.WriteBool( 'General', 'FindCaseSensitive', FFindCaseSensitive );
1218 IniFile.WriteString( 'General', 'FindText', FFindText );
1219 IniFile.WriteString( 'General', 'ReplaceText', FReplaceText );
1220 IniFile.WriteString( 'General', 'LastDirectory', FLastDirectory );
1221
1222 IniFile.WriteBool( 'General', 'WordWrap', FWrap );
1223 IniFile.WriteBool( 'General', 'ExitOnF3', FExitOnF3 );
1224
1225 IniFile.WriteBool( 'General', 'PrintHeader', FPrintHeader );
1226
1227 SaveFormSizePosition( self, IniFile );
1228
1229 // save memo font
1230 IniFile.WriteString( 'Font', 'Face', FMemoFont.FaceName );
1231 IniFile.WriteInteger( 'Font', 'Size', FMemoFont.PointSize );
1232 IniFile.Erase( 'Font', 'Bold' ); // no longer used
1233
1234 IniFile.WriteInteger( 'Color', 'Foreground', FMemoPenColor );
1235 IniFile.WriteInteger( 'Color', 'Background', FMemoColor );
1236
1237 IniFile.WriteString( 'AutoSave', 'Type', AutoSaveTypeStrings[ FAutoSaveType ] );
1238 IniFile.WriteInteger( 'AutoSave', 'Minutes', FAutoSaveMinutes );
1239 IniFile.WriteInteger( 'AutoSave', 'Changes', FAutoSaveChanges );
1240 IniFile.WriteBool( 'AutoSave', 'RequireManualSave', FRequireManualSave );
1241
1242 IniFile.WriteBool( 'General', 'WarnLargeFiles', FWarnLargeFiles );
1243
1244 // Old keys, no longer applicable
1245 IniFile.Erase( 'General', 'ConfirmReplace' );
1246 IniFile.Erase( 'General', 'FindFromTop' );
1247 IniFile.Erase( 'General', 'ModalFindReplace' );
1248
1249 IniFile.Destroy;
1250 except
1251 end;
1252End;
1253
1254Function MLMFormat( TextFormat: TTextFormat ): MPARAM;
1255begin
1256 if TextFormat = tfDOS then
1257 result := MLFIE_CFTEXT
1258 else
1259 result := MLFIE_NOTRANS;
1260end;
1261
1262// Insert specified text into memo. Handles any length
1263// the string is not zero terminated.
1264Procedure TMainForm.TextToMemo( Text: pchar;
1265 TextLength: longint );
1266var
1267 InsertPoint: IPT;
1268 ImportSize: longint;
1269 ImportStart: pchar;
1270 ImportEnd: pchar;
1271 MaxImportEnd: pchar;
1272 TextEnd: pchar;
1273begin
1274 FSettingText := true;
1275
1276 CreateMemo;
1277
1278 Memo.BeginUpdate;
1279
1280 // set import format as appropriate
1281 WinSendMsg( Memo.Handle,
1282 MLM_FORMAT,
1283 MLMFormat( FTextFormat ),
1284 0 );
1285
1286 // start at the start
1287 ImportStart := Text;
1288 InsertPoint := 0;
1289
1290 // calculate end address
1291 TextEnd := Text + TextLength;
1292
1293 // loop until end reached...
1294 while ImportStart < TextEnd do
1295 begin
1296 // Work out the block to import.
1297 // We can import up to 64kB at a time;
1298 // and we must make sure to import CR+LF pairs,
1299 // and DBCS characters, as a whole.
1300 ImportEnd := ImportStart;
1301
1302 MaxImportEnd := ImportStart + $FF00; // a bit less than 64k
1303 if MaxImportEnd > TextEnd then
1304 MaxImportEnd := TextEnd;
1305
1306 // Now loop thru the block. Blech! Recode in assembler?
1307 while ImportEnd < MaxImportEnd do
1308 begin
1309 if ImportEnd[ 0 ] = #13 then
1310 begin
1311 // CR
1312 inc( ImportEnd );
1313 if ImportEnd < TextEnd then
1314 if ImportEnd[ 0 ] = #10 then
1315 // and LF.
1316 inc( ImportEnd );
1317 end
1318 else if ImportEnd[ 0 ] < #128 then
1319 begin
1320 // can't be a DBCS char
1321 inc( ImportEnd );
1322 end
1323 else
1324 begin
1325 ImportEnd := _WinNextChar( AppHandle,
1326 0, // system codepage
1327 0, // reserved
1328 ImportEnd );
1329 end;
1330 end;
1331
1332 // Work out size
1333 ImportSize := PCharDiff( ImportEnd, ImportStart );
1334
1335 // set import buffer
1336 WinSendMsg( Memo.Handle,
1337 MLM_SETIMPORTEXPORT,
1338 LongWord( ImportStart ),
1339 ImportSize );
1340
1341 Screen.Cursor := crHourGlass;
1342
1343 // do the import
1344 WinSendMsg( Memo.Handle,
1345 MLM_IMPORT,
1346 ULONG( @InsertPoint ),
1347 ImportSize );
1348
1349 // next block. (MLM_IMPORT adjusts the insertpoint itself)
1350 inc( ImportStart, ImportSize );
1351 end;
1352
1353 Memo.EndUpdate;
1354
1355 Screen.Cursor := crDefault;
1356
1357 FSettingText := false;
1358end;
1359
1360// Insert specified text into memo. Handles any length
1361// the string is not zero terminated.
1362Procedure TMainForm.MemoToText( Var Text: pchar;
1363 Var TextLength: longint;
1364 SelectionOnly: boolean );
1365Var
1366 Start: IPT;
1367 NumCharacters: longint;
1368 ExportStart: pchar;
1369 ExportLength: longint;
1370 BytesExported: longint;
1371 SelEnd: IPT;
1372
1373begin
1374 WinSendMsg( Memo.Handle,
1375 MLM_FORMAT,
1376 MLMFormat( FTextFormat ),
1377 0 ); // set format as appropriate
1378
1379 if SelectionOnly then
1380 begin
1381 // get start and end of selection
1382 Start := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MINSEL, 0 );
1383 SelEnd := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_MAXSEL, 0 );
1384 NumCharacters := SelEnd - Start;
1385 end
1386 else
1387 begin
1388 // all the text
1389 NumCharacters := WinSendMsg( Memo.Handle,
1390 MLM_QUERYTEXTLENGTH,
1391 0,
1392 0 );
1393 Start := 0;
1394 end;
1395
1396 // convert to formatted size
1397 TextLength := WinSendMsg( Memo.Handle,
1398 MLM_QUERYFORMATTEXTLENGTH,
1399 Start,
1400 NumCharacters );
1401
1402 // allocate memory for the text
1403 Text := StrAlloc( TextLength );
1404
1405 ExportStart := Text;
1406
1407 BytesExported := 0;
1408 while BytesExported < TextLength do
1409 begin
1410 // how much to export in this block?
1411 ExportLength := $ff00;
1412 if BytesExported + ExportLength > TextLength then
1413 // last block - take remainder
1414 ExportLength := TextLength - BytesExported;
1415
1416 // set buffer
1417 WinSendMsg( Memo.Handle,
1418 MLM_SETIMPORTEXPORT,
1419 LongWord( ExportStart + BytesExported ),
1420 ExportLength );
1421 // do the export
1422 BytesExported :=
1423 BytesExported
1424 + WinSendMsg( Memo.Handle,
1425 MLM_EXPORT,
1426 ULONG( @Start ),
1427 ULONG( @ExportLength ) );
1428 end;
1429end;
1430
1431Procedure TMainForm.RedisplayText;
1432var
1433 Text: PChar;
1434 Size: longint;
1435 OldChanged: boolean;
1436begin
1437 OldChanged := GetChanged;
1438
1439 // save text cause setting scrollbars clears the window.
1440 // normally it would store it into a TStringList but we don't
1441 // want that as it is limited to 255; so StoreLines is set to false.
1442
1443 MemoToText( Text, Size, false );
1444
1445 // now restore the text. This will setup the memo etc.
1446 TextToMemo( Text, Size );
1447
1448 StrDispose( Text );
1449
1450 SetChanged( OldChanged );
1451end;
1452
1453Procedure TMainForm.SetWrap( Value: boolean );
1454var
1455 OldCursor: IPT;
1456 OldAnchor: IPT;
1457begin
1458 OptionsWrapMI.Checked := Value;
1459
1460 if FWrap = Value then
1461 exit;
1462 FWrap := Value;
1463
1464 if Assigned( Memo ) then
1465 begin
1466 // preserve cursor/selection
1467 OldCursor := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_CURSORSEL, 0 );
1468 OldAnchor := WinSendMsg( Memo.Handle, MLM_QUERYSEL, MLFQS_ANCHORSEL, 0 );
1469 end
1470 else
1471 begin
1472 OldCursor := 0;
1473 OldAnchor := 0;
1474 end;
1475
1476 RedisplayText;
1477
1478 WinSendMsg( Memo.Handle, MLM_SETSEL, OldAnchor, OldCursor );
1479
1480 UpdatePosition;
1481
1482 PostMsg( Handle, WM_FOCUSMEMO, 0, 0 );
1483end;
1484
1485Procedure TMainForm.OptionsWrapMIOnClick (Sender: TObject);
1486Begin
1487 SetWrap( not FWrap );
1488End;
1489
1490Procedure TMainForm.EditSelectAllMIOnClick (Sender: TObject);
1491Begin
1492 Memo.SelectAll;
1493End;
1494
1495Procedure TMainForm.EditPasteMIOnClick (Sender: TObject);
1496Begin
1497 SendMsg( Memo.Handle, MLM_PASTE, 0, 0 );
1498End;
1499
1500Procedure TMainForm.EditCopyMIOnClick (Sender: TObject);
1501Begin
1502 SendMsg( Memo.Handle, MLM_COPY, 0, 0 );
1503End;
1504
1505Procedure TMainForm.EditCutMIOnClick (Sender: TObject);
1506Begin
1507 SendMsg( Memo.Handle, MLM_CUT, 0, 0 );
1508End;
1509
1510Procedure TMainForm.EditUndoMIOnClick (Sender: TObject);
1511Begin
1512 SendMsg( Memo.Handle, MLM_UNDO, 0, 0 );
1513End;
1514
1515Procedure TMainForm.OptionsReadOnlyMIOnClick (Sender: TObject);
1516Begin
1517 SetReadOnly( not FReadOnly );
1518End;
1519
1520procedure TMainForm.SetReadOnly( Value: boolean );
1521begin
1522 FReadOnly := Value;
1523 if Assigned( Memo ) then
1524 Memo.ReadOnly := Value;
1525
1526 OptionsReadOnlyMI.Checked := Value;
1527
1528 UpdateStatus;
1529 EnableControls;
1530end;
1531
1532Procedure TMainForm.UpdateStatus;
1533var
1534 Status: string;
1535begin
1536 if FReadOnly then
1537 begin
1538 Status := ReadOnlyStatus
1539 end
1540 else if GetChanged then
1541 begin
1542 if FFilename = '' then
1543 Status := NewStatus
1544 else
1545 Status := ModifiedStatus
1546 end
1547 else
1548 begin
1549 Status := '';
1550 end;
1551
1552 if Status <> StatusBar.Panels[ 3 ].Text then
1553 begin
1554 // only redraw if needed. (StatusBar is not smart enough to do this)
1555 StatusBar.Panels[ 3 ].Text := Status;
1556 StatusBar.Refresh;
1557 end;
1558end;
1559
1560Procedure TMainForm.FileSaveAsMIOnClick (Sender: TObject);
1561Begin
1562 SaveFileAs;
1563End;
1564
1565Procedure TMainForm.FileSaveMIOnClick (Sender: TObject);
1566Begin
1567 SaveFile;
1568End;
1569
1570Procedure TMainForm.MainFormOnCloseQuery (Sender: TObject;
1571 Var CanClose: Boolean);
1572Begin
1573 if GetChanged then
1574 begin
1575 // check whether user wants to save, discard or stop closing
1576 if not CloseFile then
1577 begin
1578 // cancel close
1579 CanClose := false;
1580 end;
1581 end
1582 else
1583 begin
1584 CloseFile; // mainly to get colors back from memo
1585 end;
1586End;
1587
1588Procedure TMainForm.FileNewMIOnClick (Sender: TObject);
1589Begin
1590 CloseFile;
1591End;
1592
1593Procedure TMainForm.MemoOnMouseUp (Sender: TObject; Button: TMouseButton;
1594 Shift: TShiftState; X: LongInt; Y: LongInt);
1595Begin
1596 PostUpdatePosition;
1597End;
1598
1599Procedure TMainForm.MemoOnChange (Sender: TObject);
1600Begin
1601 if FSettingText then
1602 exit;
1603
1604 PostMsg( Handle, WM_MEMOCHANGE, 0, 0 );
1605end;
1606
1607Procedure TMainForm.WMMemoChange( Var Msg: TMessage );
1608begin
1609 UpdatePosition;
1610 UpdateStatus;
1611 SetMessage( '' );
1612
1613 if FAutoSaveType = asChanges then
1614 begin
1615 inc( FChangeCount );
1616 if FChangeCount > FAutoSaveChanges then
1617 begin
1618 AutoSave;
1619 end;
1620 end
1621 else if FAutoSaveType = asTimed then
1622 begin
1623 if not AutoSaveTimer.Running then
1624 // start timing...
1625 AutoSaveTimer.Start;
1626 end;
1627End;
1628
1629Procedure TMainForm.WMFocusMemo( Var Msg: TMessage );
1630begin
1631 Memo.Focus;
1632end;
1633
1634Procedure TMainForm.WMUpdatePosition( Var Msg: TMessage );
1635begin
1636 UpdatePosition;
1637end;
1638
1639Procedure TMainForm.UpdateCaption;
1640begin
1641 if FFilename = '' then
1642 Caption := AppTitle + '-' + UntitledTitle
1643 else
1644 Caption := AppTitle + '-' + FFilename;
1645end;
1646
1647Procedure TMainForm.UpdatePosition;
1648var
1649 CursorPosition: longint;
1650 Row: longint;
1651 Column: longint;
1652 RowStartPosition: longint;
1653begin
1654 if Memo.WordWrap then
1655 begin
1656 // MLE doesn't report line/col usefully in wrap mode
1657 StatusBar.Panels[ 2 ].Text := '';
1658 exit;
1659 end;
1660
1661 CursorPosition := SendMsg( Memo.Handle,
1662 MLM_QUERYSEL,
1663 MLFQS_CURSORSEL,
1664 0 );
1665 Row := SendMsg( Memo.Handle,
1666 MLM_LINEFROMCHAR,
1667 CursorPosition,
1668 0 );
1669
1670 RowStartPosition := SendMsg( Memo.Handle,
1671 MLM_CHARFROMLINE,
1672 Row,
1673 0 );
1674
1675 Column := CursorPosition - RowStartPosition;
1676 StatusBar.Panels[ 2 ].Text := IntToStr( Row + 1 )
1677 + ': '
1678 + IntToStr( Column + 1 );
1679 StatusBar.Refresh;
1680end;
1681
1682Procedure TMainForm.PostUpdatePosition;
1683begin
1684 PostMsg( Handle, WM_UPDATEPOSITION, 0, 0 );
1685end;
1686
1687Procedure TMainForm.UpdateMode;
1688begin
1689 if WinQuerySysValue( HWND_DESKTOP, SV_INSERTMODE ) <> 0 then
1690 StatusBar.Panels[ 1 ].Text := InsertStatus
1691 else
1692 StatusBar.Panels[ 1 ].Text := OverwriteStatus
1693end;
1694
1695Procedure TMainForm.MemoOnScan (Sender: TObject; Var KeyCode: TKeyCode);
1696Begin
1697 case KeyCode of
1698 kbCtrlZ:
1699 SendMsg( Memo.Handle, MLM_UNDO, 0, 0 );
1700
1701 kbF3:
1702 // a contentious issue: old timers would prefer this to be exit...
1703 // But Windows Notepad and other applications use it as find next
1704 if FExitOnF3 then
1705 Close
1706 else
1707 Find;
1708
1709 kbF2:
1710 SaveFile; // EPM compatibility
1711 end;
1712 PostUpdatePosition;
1713 UpdateMode;
1714End;
1715
1716Procedure TMainForm.MainFormOnResize (Sender: TObject);
1717var
1718 i: longint;
1719 FirstPanelWidth: longint;
1720Begin
1721 StatusBar.Height := Canvas.TextHeight( 'S' ) + Font.InternalLeading + 2;
1722 if Assigned( Memo ) then
1723 begin
1724 Memo.Left := 0;
1725 Memo.Bottom := StatusBar.Height + 2;
1726 Memo.Width := ClientWidth;
1727 Memo.Height := ClientHeight - ( StatusBar.Height + 2 );
1728 end;
1729
1730 FirstPanelWidth := ClientWidth;
1731
1732 for i := 1 to StatusBar.Panels.Count - 1 do
1733 dec( FirstPanelWidth,
1734 StatusBar.Panels[ i ].Width
1735 + StatusBar.Spacing );
1736
1737 StatusBar.Panels[ 0 ].Width := FirstPanelWidth;
1738End;
1739
1740Procedure TMainForm.MainFormOnSetupShow (Sender: TObject);
1741Begin
1742End;
1743
1744Procedure TMainForm.MainFormOnShow (Sender: TObject);
1745var
1746 IniFile: TMyIniFile;
1747 AutoSaveTypeString: string;
1748 ParamIndex: longint;
1749 Param: string;
1750 ReadOnlyFlag: boolean;
1751 Filename: string;
1752Begin
1753 // ValidateSPCCObjects;
1754
1755 // Set the menu fonts, because they remember their own specific one
1756 MainMenu.Font := Screen.MenuFont;
1757
1758 // get default font
1759 FMemoFont := Screen.GetFontFromPointSize( 'System VIO', 10 );
1760 if FMemoFont = nil then
1761 FMemoFont := Screen.GetFontFromPointSize( 'Courier', 10 );
1762 if FMemoFont = nil then
1763 FMemoFont := Screen.DefaultFont;
1764
1765 try
1766 IniFile := TMyIniFile.Create( GetIniFilePath( 'ae.ini' ) );
1767 FFindCaseSensitive := IniFile.ReadBool( 'General', 'FindCaseSensitive', false );
1768 FFindText := IniFile.ReadString( 'General', 'FindText', '' );
1769 FReplaceText := IniFile.ReadString( 'General', 'ReplaceText', '' );
1770 FLastDirectory := IniFile.ReadString( 'General',
1771 'LastDirectory',
1772 GetBootDrive + ':\' );
1773 FWrap := IniFile.ReadBool( 'General', 'WordWrap', true );
1774 SetExitOnF3( IniFile.ReadBool( 'General', 'ExitOnF3', true ) );
1775 FPrintHeader := IniFile.ReadBool( 'General', 'PrintHeader', FPrintHeader );
1776
1777 LoadFormSizePosition( self, IniFile );
1778
1779 FMemoFont :=
1780 Screen.CreateCompatibleFont(
1781 Screen.GetFontFromPointSize(
1782 IniFile.ReadString( 'Font', 'Face', FMemoFont.FaceName ),
1783 IniFile.ReadInteger( 'Font', 'Size', FMemoFont.PointSize ) ) );
1784
1785 FMemoPenColor := IniFile.ReadInteger( 'Color', 'Foreground', clWindowText );
1786 FMemoColor := IniFile.ReadInteger( 'Color', 'Background', clEntryField );
1787
1788 AutoSaveTypeString := IniFile.ReadString( 'AutoSave', 'Type', 'None' );
1789 if StringsSame( AutoSaveTypeString, 'Timed' ) then
1790 FAutoSaveType := asTimed
1791 else if StringsSame( AutoSaveTypeString, 'Changes' ) then
1792 FAutoSaveType := asChanges
1793 else
1794 FAutoSaveType := asNone;
1795
1796 FAutoSaveMinutes := IniFile.ReadInteger( 'AutoSave', 'Minutes', 10 );
1797 FAutoSaveChanges := IniFile.ReadInteger( 'AutoSave', 'Changes', 100 );
1798 FRequireManualSave := IniFile.ReadBool( 'AutoSave', 'RequireManualSave', true ); // like E
1799
1800 FWarnLargeFiles := IniFile.ReadBool( 'General', 'WarnLargeFiles', true );
1801
1802 IniFile.Destroy;
1803 except
1804 end;
1805
1806 CloseFile;
1807 UpdateMode;
1808 SetWrap( FWrap );
1809
1810 FShowUsage := false;
1811 ReadOnlyFlag := false;
1812 Filename := '';
1813
1814 for ParamIndex := 1 to ParamCount do
1815 begin
1816 Param := ParamStr( ParamIndex );
1817 {
1818 if MatchFlagParam( Param, '?' )
1819 or MatchFlagParam( Param, 'H' )
1820 or MatchFlagParam( Param, 'HELP' ) then
1821 }
1822 if ( CompareText( Param, '/?' ) = 0 )
1823 or ( CompareText( Param, '/H' ) = 0 )
1824 or ( CompareText( Param, '/HELP' ) = 0 ) then
1825 begin
1826 FShowUsage := true
1827 end
1828 else if CompareText( Param, '/READ' ) = 0 then
1829 begin
1830 ReadOnlyFlag := true;
1831 end
1832 else
1833 begin
1834 if Filename = '' then
1835 Filename := Param
1836 else
1837 // too many parameters
1838 FShowUsage := true;
1839 end;
1840 end;
1841
1842 // load file from command line, if specified
1843 if Filename <> '' then
1844 begin
1845 OpenFile( Filename, false ); // don't complain (might want a new one)
1846 FFilename := Filename; // even if not found, so can save new one.
1847 if ReadOnlyFlag then
1848 SetReadOnly( true );
1849 UpdateCaption;
1850 end
1851 else
1852 begin
1853 UpdatePosition;
1854 end;
1855
1856 PostMsg( Handle, WM_OPENED, 0, 0 );
1857End;
1858
1859procedure TMainForm.WMOpened( Var Msg: TMessage );
1860begin
1861 if FShowUsage then
1862 DoMessageDlg( UsageTitle,
1863 Usage1 + EndLine + Usage2 + EndLine + EndLine + Usage3 );
1864
1865 Memo.Focus;
1866 UpdateStatus;
1867end;
1868
1869function TMainForm.SaveFileTo( const Filename: string ): boolean;
1870var
1871 Text: pchar;
1872 F: HFILE;
1873 rc: APIRET;
1874 szName: cstring;
1875 OpenAction: ULONG;
1876 ActualWritten: ULONG;
1877 Size: longint;
1878begin
1879 Result := false;
1880
1881 MemoToText( Text, Size, false );
1882
1883 szName := FileName;
1884 rc:= DosOpen( szName,
1885 F,
1886 OpenAction,
1887 Size, // file size (only used if file is new)
1888 0, // attrs
1889 OPEN_ACTION_CREATE_IF_NEW + OPEN_ACTION_OPEN_IF_EXISTS,
1890 OPEN_SHARE_DENYREADWRITE + OPEN_ACCESS_WRITEONLY,
1891 nil ); // no eas
1892 if rc <> 0 then
1893 begin
1894 case rc of
1895 ERROR_ACCESS_DENIED:
1896 begin
1897 if FileIsReadOnly( Filename ) then
1898 DoErrorDlg( SaveTitle,
1899 SaveReadonlyError
1900 + FileName )
1901 else
1902 DoErrorDlg( SaveTitle,
1903 SaveAccessDeniedError
1904 + FileName );
1905 end;
1906
1907 ERROR_SHARING_VIOLATION:
1908 DoErrorDlg( SaveTitle,
1909 FileInUseError
1910 + FileName );
1911
1912 else
1913 DoErrorDlg( SaveTitle,
1914 SaveError
1915 + FileName
1916 + ' '
1917 + SysErrorMessage( rc ) );
1918 end;
1919 exit;
1920 end;
1921
1922 // Set the file size. This is done for two reasons:
1923 // 1. (Most important) we are not replacing the file but overwriting
1924 // existing data, in order to keep extended attributes. So we need
1925 // to set the correct size in case the file on disk is currently longer.
1926 // 2. Efficiently allocate space
1927 rc := DosSetFileSize( F, Size );
1928 if rc = 0 then
1929 rc := DosWrite( F, Text^, Size, ActualWritten );
1930
1931 DosClose( F );
1932 StrDispose( Text );
1933
1934 if rc <> 0 then
1935 begin
1936 DoErrorDlg( SaveTitle,
1937 SaveError
1938 + Filename
1939 + ' '
1940 + SysErrorMessage( rc ) );
1941 exit;
1942 end;
1943
1944 SetMessage( SavedMsg + Filename );
1945
1946 SetChanged( false );
1947
1948 Result := true;
1949end;
1950
1951function TMainForm.SaveFileAs: boolean;
1952begin
1953 Result := false;
1954 SaveDialog.Title := SaveTitle;
1955 SaveDialog.Filename := FFilename;
1956 if not SaveDialog.Execute then
1957 exit;
1958 if FileExists( SaveDialog.Filename ) then
1959 if not DoConfirmDlg( SaveTitle,
1960 ReplacePrompt
1961 + EndLine
1962 + SaveDialog.Filename ) then
1963 exit;
1964 if not SaveFileTo( SaveDialog.Filename ) then
1965 exit;
1966
1967 Result := true;
1968 FFilename := SaveDialog.Filename;
1969 FLastDirectory := ExtractFilePath( FFilename );
1970
1971 UpdateCaption;
1972end;
1973
1974function TMainForm.SaveFile: boolean;
1975begin
1976 Result := true;
1977 if FFilename = '' then
1978 begin
1979 Result := SaveFileAs;
1980 exit;
1981 end;
1982
1983 Result := SaveFileTo( FFilename );
1984end;
1985
1986procedure TMainForm.CreateMemo;
1987begin
1988 // MLE seems to be crap in this respect,
1989 // we have to destroy it to free up memory or something!
1990 if Assigned( Memo ) then
1991 begin
1992 FMemoPenColor := Memo.PenColor;
1993 FMemoColor := Memo.Color;
1994 Memo.Destroy;
1995 end;
1996
1997 Memo := TCustomMemo.Create( self );
1998
1999 Memo.WordWrap := FWrap;
2000 if Memo.WordWrap then
2001 Memo.ScrollBars := ssVertical
2002 else
2003 Memo.ScrollBars := ssBoth;
2004
2005 MainFormOnResize( self );
2006 Memo.BorderStyle := bsNone;
2007 Memo.StoreLines := false;
2008 Memo.ReadOnly := FReadOnly;
2009
2010 Memo.PopupMenu := EditPopupMenu;
2011
2012 Memo.Parent := self;
2013 Memo.Font := FMemoFont;
2014
2015 Memo.PenColor := FMemoPenColor;
2016 Memo.Color := FMemoColor;
2017
2018 Memo.WantTabs := true;
2019 {
2020 // can't do it at this point in startup.
2021 // leave as default (8 spaces)
2022 SendMsg( Memo.Handle,
2023 MLM_SETTABSTOP,
2024 Memo.Canvas.TextWidth( 'm' ) * 2,
2025 0 );
2026 }
2027 WinSendMsg( Memo.Handle, MLM_RESETUNDO, 0, 0 ); // cause setting the color counts as an undoable item!
2028
2029 Memo.OnFontChange := MemoOnFontChange;
2030 Memo.OnChange := MemoOnChange;
2031 Memo.OnMouseUp := MemoOnMouseUp; // for updating position
2032 Memo.OnScan := MemoOnScan; // overriding some keys
2033 Memo.OnDragDrop := MemoOnDragDrop;
2034 Memo.OnDragOver := MemoOnDragOver;
2035end;
2036
2037function TMainForm.CloseFile: boolean;
2038begin
2039 result := false;
2040
2041 if Assigned( Memo ) then
2042 begin
2043 if GetChanged then
2044 begin
2045 SaveQueryForm.ShowModal;
2046
2047 case SaveQueryForm.ModalResult of
2048 cmSave:
2049 if not SaveFile then
2050 exit;
2051
2052 cmCancel:
2053 exit;
2054
2055 // else - cmDiscard - do nothing
2056 end;
2057 end;
2058 end;
2059
2060 Result := true;
2061
2062 CreateMemo;
2063
2064 SetChanged( false );
2065 SetReadOnly( false );
2066
2067 FTextFormat := tfDOS;
2068
2069 UpdateStatus;
2070 EnableControls;
2071
2072 FFilename := '';
2073 UpdateCaption;
2074
2075 SetMessage( NewFileMsg );
2076
2077 PostMsg( Handle, WM_FOCUSMEMO, 0, 0 );
2078end;
2079
2080procedure TMainForm.DetectTextFormat( Text: pchar;
2081 TextLength: ULONG );
2082var
2083 ScanLength: ULONG;
2084 p: pchar;
2085 EndP: pchar;
2086begin
2087 // scan up to 64k for the first line break
2088
2089 ScanLength := TextLength;
2090 if ScanLength > 65536 then
2091 ScanLength := 65536;
2092
2093 p := Text + 1;
2094 EndP := Text + ScanLength;
2095
2096 FTextFormat := tfDOS; // default if no linebreak found
2097 while p < EndP do
2098 begin
2099 if p[ 0 ] = #10 then // Line feed
2100 begin
2101 if (p-1)[ 0 ] = #13 then
2102 // CRLF -> DOS
2103 FTextFormat := tfDOS
2104 else
2105 // LF by itself -> Unix
2106 FTextFormat := tfUnix;
2107 break;
2108 end;
2109 inc( p );
2110 end;
2111end;
2112
2113function TMainForm.OpenFile( const Filename: string;
2114 ComplainIfMissing: boolean ): boolean;
2115var
2116 Text: pchar;
2117 F: HFILE;
2118 rc: APIRET;
2119 szName: cstring;
2120 OpenAction: ULONG;
2121 FileInfo: FILESTATUS3;
2122 ActualRead: ULONG;
2123 TextLength: ULONG;
2124begin
2125 Result := false;
2126 if not CloseFile then
2127 exit;
2128
2129 Screen.Cursor := crHourGlass;
2130
2131 szName := Filename;
2132 rc := DosOpen( szName,
2133 F,
2134 OpenAction,
2135 0, // file size - irrelevant, not creating,
2136 0, // attrs - ''
2137 OPEN_ACTION_OPEN_IF_EXISTS,
2138 OPEN_SHARE_DENYREADWRITE + OPEN_ACCESS_READONLY,
2139 nil ); // no eas
2140 if rc <> 0 then
2141 begin
2142 Screen.Cursor := crDefault;
2143 case rc of
2144 ERROR_FILE_NOT_FOUND,
2145 ERROR_OPEN_FAILED:
2146 if ComplainIfMissing then
2147 DoErrorDlg( OpenTitle,
2148 FileDoesNotExistError + FileName );
2149
2150 ERROR_ACCESS_DENIED:
2151 DoErrorDlg( OpenTitle,
2152 OpenAccessDeniedError + FileName );
2153
2154 ERROR_SHARING_VIOLATION:
2155 DoErrorDlg( OpenTitle,
2156 OpenFileInUseError + FileName );
2157
2158 else
2159 DoErrorDlg( OpenTitle,
2160 OpenError
2161 + FileName
2162 + ' '
2163 + SysErrorMessage( rc ) );
2164 end;
2165 exit;
2166 end;
2167
2168 // Get file size
2169 rc := DosQueryFileInfo( F,
2170 FIL_STANDARD,
2171 FileInfo,
2172 sizeof( FileInfo ) );
2173 if rc <> 0 then
2174 begin
2175 Screen.Cursor := crDefault;
2176 DosClose( F );
2177 DoErrorDlg( OpenTitle,
2178 OpenError + SysErrorMessage( rc ) );
2179 exit;
2180 end;
2181
2182 TextLength := FileInfo.cbFile;
2183
2184 if FWarnLargeFiles
2185 and ( TextLength > 1000*1000 ) then
2186 begin
2187 Screen.Cursor := crDefault;
2188 LargeFileWarningForm.NotAgainCheckBox.Checked := not FWarnLargeFiles;
2189 LargeFileWarningForm.ShowModal;
2190 FWarnLargeFiles := not LargeFileWarningForm.NotAgainCheckBox.Checked;
2191
2192 if LargeFileWarningForm.ModalResult <> mrOK then
2193 begin
2194 DosClose( F );
2195 exit;
2196 end;
2197
2198 Screen.Cursor := crHourGlass;
2199 end;
2200
2201 // allocate temp memory for loading file
2202 GetMem( Text, TextLength );
2203
2204 rc := DosRead( F, Text^, TextLength, ActualRead );
2205 DosClose( F );
2206
2207 if rc <> 0 then
2208 begin
2209 Screen.Cursor := crDefault;
2210 FreeMem( Text, TextLength );
2211 DoErrorDlg( OpenTitle,
2212 OpenError + SysErrorMessage( rc ) );
2213 exit;
2214 end;
2215
2216 DetectTextFormat( Text, TextLength );
2217
2218 TextToMemo( Text, ActualRead );
2219
2220 UpdatePosition;
2221
2222 FreeMem( Text, TextLength );
2223
2224 FFilename := Filename;
2225
2226 FLastDirectory := ExtractFilePath( FFilename );
2227
2228 UpdateCaption;
2229
2230 SetChanged( false );
2231 WinSendMsg( Memo.Handle, MLM_RESETUNDO, 0, 0 ); // cause setting the color counts as an undoable item!
2232
2233 if FileGetAttr( Filename ) and faReadOnly <> 0 then
2234 SetReadonly( True );
2235
2236 SetMessage( OpenedMsg + Filename );
2237
2238 Screen.Cursor := crDefault;
2239
2240 Result := true;
2241end;
2242
2243Procedure TMainForm.FileOpenMIOnClick (Sender: TObject);
2244Begin
2245 OpenDialog.Filename := AddSlash( FLastDirectory ) + '*.*';
2246 if OpenDialog.Execute then
2247 OpenFIle( OpenDialog.Filename, true );
2248End;
2249
2250Procedure TMainForm.FileExitMIOnClick (Sender: TObject);
2251Begin
2252 Close;
2253End;
2254
2255Function TMainForm.GetChanged: boolean;
2256begin
2257 Result := SendMsg( Memo.Handle,
2258 MLM_QUERYCHANGED,
2259 0,
2260 0 ) <> 0;
2261end;
2262
2263Procedure TMainForm.SetChanged( Value: boolean );
2264begin
2265 SendMsg( Memo.Handle,
2266 MLM_SETCHANGED,
2267 MParam( Value ),
2268 0 );
2269 if not Value then
2270 // ack! pffbt! Shouldn't this be if Value ???
2271 // changed: start timing/counting for autosave
2272 InitAutoSave;
2273 UpdateStatus;
2274end;
2275
2276procedure TMainForm.OnHint( Sender: TObject );
2277Begin
2278 SetMessage( Application.Hint );
2279end;
2280
2281const
2282 Vendor = 'Aaron Lawrence';
2283 Description = 'Text Editor';
2284
2285 // BLDLevel-like info (not actually compatible with BLDLEVEL command)
2286 EmbeddedVersion: string =
2287 '@#'
2288 + Vendor
2289 + ':'
2290 + BldLevelVersion
2291 + '#@'
2292 + Description
2293 + #0;
2294
2295Initialization
2296 RegisterClasses ([TMainForm, TMainMenu, TStatusBar, TMenuItem,
2297 TSystemOpenDialog, TSystemSaveDialog, TTimer, TPopupMenu, TCustomFontDialog]);
2298End.
Note: See TracBrowser for help on using the repository browser.