source: trunk/ae/MainFormUnit.pas@ 461

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

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