Develop and Download Open Source Software

Browse Subversion Repository

Contents of /MainFrm.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Mon Nov 7 12:03:00 2011 UTC (12 years, 4 months ago) by shiraishikazuo
File MIME type: text/x-pascal
File size: 39416 byte(s)


1 unit MainFrm;
2
3 {$IFDEF FPC}
4 {$MODE DELPHI}{$H+}
5 {$ENDIF}
6
7 (***************************************)
8 (* Copyright (C) 2009, SHIRAISHI Kazuo *)
9 (***************************************)
10
11 interface
12
13 uses Types, Classes, Graphics, Forms, Controls, Menus,
14 SysUtils,ExtCtrls, StdCtrls, Dialogs,
15 ComCtrls, ImgList,
16 base, codefrm, myutils, LResources, SynEdit, SynHighlighterAny;
17
18 type
19
20 { TFrameForm }
21
22 TFrameForm = class(TForm)
23 MainMenu1: TMainMenu;
24 File1: TMenuItem;
25 Exit1: TMenuItem;
26 SetUpOptions: TMenuItem;
27 Setup1: TMenuItem;
28 BMPsize1: TMenuItem;
29 Path1: TMenuItem;
30 N2: TMenuItem;
31 Open1: TMenuItem;
32 New1: TMenuItem;
33 merge1: TMenuItem;
34 Save1: TMenuItem ;
35 SaveAs1: TMenuItem;
36 Print1:TMenuItem;
37
38 Edit1: TMenuItem;
39 Cut1: TMenuItem;
40 Copy1: TMenuItem;
41 Paste1: TMenuItem;
42 Delete1: TMenuItem;
43 Memo1: TSynEdit;
44 SynAnySyn1: TSynAnySyn;
45 Undo1: TMenuItem;
46 N4: TMenuItem;
47 SelectAll1: TMenuItem;
48 Find1: TMenuItem;
49 Repalce1: TMenuItem;
50 FindNext1: TMenuItem;
51 N5: TMenuItem;
52 ToolBox1: TMenuItem;
53 deleteLabelNumber1: TMenuItem;
54 AddLabelNumber1: TMenuItem;
55 CaseChange1: TMenuItem;
56 WordWrap1: TMenuItem;
57 Run1: TMenuItem;
58 Run2: TMenuItem;
59 Code1: TMenuItem;
60 step1: TMenuItem;
61 Break1: TMenuItem;
62 Option1: TMenuItem;
63 option2: TMenuItem;
64 AutoCorrect1: TMenuItem;
65 Syntax1: TMenuItem;
66 Compatibility1: TMenuItem;
67 Font1: TMenuItem;
68 N6: TMenuItem;
69 N3: TMenuItem;
70 Window1: TMenuItem;
71 TextOut1: TMenuItem;
72 Help1: TMenuItem;
73 About1: TMenuItem;
74 Contents1: TMenuItem;
75 N1: TMenuItem;
76 ButtonFrame1: TMenuItem;
77 N9: TMenuItem;
78 N10: TMenuItem;
79 AutoFormat1: TMenuItem;
80 S1: TMenuItem;
81 I1: TMenuItem;
82
83 StatusBar1: TStatusBar;
84 ToolbarImages: TImageList;
85 ToolBar1: TToolBar;
86 tbNew: TToolButton;
87 TBOpen: TToolButton;
88 TBSave: TToolButton;
89 TBPrint: TToolButton;
90 ToolButton15: TToolButton;
91 TBCut: TToolButton;
92 TBCopy: TToolButton;
93 TBPaste: TToolButton;
94 TBUndo: TToolButton;
95 ToolButton12: TToolButton;
96 TBRun: TToolButton;
97 TBStep: TToolButton;
98 TBBreak: TToolButton;
99 ToolButton16: TToolButton;
100 TBHelp: TToolButton;
101 ShowToolBar1: TMenuItem;
102 TBDecimal: TToolButton;
103 TBHighPrecision: TToolButton;
104 TBBinary: TToolButton;
105 TBDeg: TToolButton;
106 ToolButton5: TToolButton;
107 ToolButton6: TToolButton;
108 ToolButton3: TToolButton;
109 TBComplex: TToolButton;
110 TBRational: TToolButton;
111
112
113 SaveDialog1: TSaveDialog;
114 FontDialog1: TFontDialog;
115 OpenDialog1: TOpenDialog;
116 FindDialog1: TFindDialog;
117 ReplaceDialog1: TReplaceDialog;
118
119 PopupMenu1: TPopupMenu;
120 popupRun1: TMenuItem;
121 PopupCode1: TMenuItem;
122 N12: TMenuItem;
123 Cut2: TMenuItem;
124 copy2: TMenuItem;
125 paste2: TMenuItem;
126 Delete2: TMenuItem;
127 SelectAll2: TMenuItem;
128 N15: TMenuItem;
129 PopUpBreak1: TMenuItem;
130
131 procedure Code1Click(Sender: TObject);
132 procedure FormCreate(Sender: TObject);
133 procedure FormDestroy(Sender: TObject);
134 procedure FormShow(Sender: TObject);
135 procedure FormClose(Sender: TObject; var Action: TCloseAction);
136 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
137 procedure FormResize(Sender: TObject);
138 procedure FormDeactivate(Sender: TObject);
139 procedure Memo1Change(Sender: TObject);
140 //procedure FormActivate(Sender: TObject);
141
142 procedure New1Click(Sender: TObject);
143 procedure Open1Click(Sender: TObject);
144 procedure Close1Click(Sender: TObject);
145 procedure Break1Click(Sender: TObject);
146 procedure Font1Click(Sender: TObject);
147 procedure option2Click(Sender: TObject);
148 procedure About1Click(Sender: TObject);
149 procedure Path1Click(Sender: TObject);
150 procedure SetUpOptionsClick(Sender: TObject);
151 procedure TextOut1Click(Sender: TObject);
152 procedure Graphic1Click(Sender: TObject);
153 procedure Contents1Click(Sender: TObject);
154 procedure Search1Click(Sender: TObject);
155 procedure compatibility1Click(Sender: TObject);
156 procedure AutoCorrect1Click(Sender: TObject);
157 procedure Syntax1Click(Sender: TObject);
158 procedure ShowToolBar1Click(Sender: TObject);
159
160 procedure tbNewClick(Sender: TObject);
161 procedure TBOpenClick(Sender: TObject);
162 procedure TBSaveClick(Sender: TObject);
163 procedure TBPrintClick(Sender: TObject);
164 procedure TBCutClick(Sender: TObject);
165 procedure TBCopyClick(Sender: TObject);
166 procedure TBPasteClick(Sender: TObject);
167 procedure TBUndoClick(Sender: TObject);
168 procedure TBRunClick(Sender: TObject);
169 procedure TBStepClick(Sender: TObject);
170 procedure TBBreakClick(Sender: TObject);
171 procedure TBHelpClick(Sender: TObject);
172 procedure TBDecimalClick(Sender: TObject);
173 procedure TBHighPrecisionClick(Sender: TObject);
174 procedure TBBinaryClick(Sender: TObject);
175 procedure TBDegClick(Sender: TObject);
176 procedure TBComplexClick(Sender: TObject);
177 procedure TBRationalClick(Sender: TObject);
178
179 procedure L1Click(Sender: TObject);
180 procedure Debug1Click(Sender: TObject);
181 procedure ButtonFrame1Click(Sender: TObject);
182 procedure N9Click(Sender: TObject);
183 procedure AutoFormat1Click(Sender: TObject);
184 procedure I1Click(Sender: TObject);
185 procedure MenuFont1Click(Sender: TObject);
186 procedure Save1Click(Sender: TObject);
187 procedure Exit1Click(Sender: TObject);
188 procedure Cut1Click(Sender: TObject);
189 procedure Copy1Click(Sender: TObject);
190 procedure Paste1Click(Sender: TObject);
191 procedure Delete1Click(Sender: TObject);
192 procedure SelectAll1Click(Sender: TObject);
193 procedure SaveAs1Click(Sender: TObject);
194 procedure Print1Click(Sender: TObject);
195 procedure WordWrap1Click(Sender: TObject);
196 procedure Find1Click(Sender: TObject);
197 procedure Repalce1Click(Sender: TObject);
198 procedure FindNext1Click(Sender: TObject);
199 procedure Find(Sender: TObject);
200 procedure Replace(Sender: TObject);
201 procedure FindDialog1Find(Sender: TObject);
202 procedure ReplaceDialog1Find(Sender: TObject);
203 procedure ReplaceDialog1Replace(Sender: TObject);
204 procedure Run2Click(Sender: TObject);
205 procedure step1Click(Sender: TObject);
206 procedure ToolBox1Click(Sender: TObject);
207 procedure Undo1Click(Sender: TObject);
208 procedure deleteLabelNumber1Click(Sender: TObject);
209 procedure merge1Click(Sender: TObject);
210 procedure SelectAll2Click(Sender: TObject);
211 procedure Popupstep1Click(Sender: TObject);
212 procedure Cut2Click(Sender: TObject);
213 procedure copy2Click(Sender: TObject);
214 procedure paste2Click(Sender: TObject);
215 procedure Delete2Click(Sender: TObject);
216 procedure popupRun1Click(Sender: TObject);
217 procedure PopUpBreak1Click(Sender: TObject);
218 procedure Edit1Click(Sender: TObject);
219 procedure PopupMenu1Popup(Sender: TObject);
220 procedure AddLabelNumber1Click(Sender: TObject);
221 procedure CaseChange1Click(Sender: TObject);
222 procedure BMPsize1Click(Sender: TObject);
223
224 procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
225 procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
226
227 function CloseQuery:boolean;override;
228
229 private
230 executing:boolean;
231 OverWriteMode:boolean;
232 searchLength:integer;
233 changed:boolean;
234
235 procedure SetOptionMenues(b:byte);
236 procedure SetPrecisionButtons(mode:tpPrecision) ;
237
238 function search(const FText:ansistring; Options1:TFindOptions):boolean;
239 function curText:ansistring;
240 procedure UpdateCursorPos;
241 procedure PrepareSearch;
242 procedure AutoFormat;
243 function SaveAs:boolean;
244 function Save:boolean;
245 public
246 backup:ansistring;
247 UnDoFromBackUp:boolean;
248 AngleConfirmed:boolean;
249 ArithmeticConfirmed:boolean;
250
251 procedure ActiveFormChange(Sender: TObject);
252 function ValidComponent(component:TComponent):boolean;
253 function OpenTextFile(Filename: string):boolean;
254 procedure SetStatusBar1(OverWriteMode:boolean);
255 procedure SetAngleButtons(s:boolean);
256 procedure SetBreakMessage;
257 end;
258
259 var
260 FrameForm: TFrameForm;
261 var
262 ToTerminate:boolean=false;
263 ToOpen:boolean=false;
264 ToOpenFile:string='';
265
266 implementation
267 uses Clipbrd, IniFiles, Helpintfs, fileutil,
268 {$IFDEF FPC}
269 Interfaces, LCLIntf, LCLType, LCLProc,
270 {$ELSE}
271 Windows,
272 {$ENDIF}
273
274 {$IFDEF win32}
275 windows,shellapi,
276 {$ELSE}
277 unix,
278 {$ENDIF}
279 optiondg,compadlg,toolfrm,texthand, optina,syntaxdg,
280 tracefrm, {debugdg,}
281 fkeydlg, sizedlg,
282 base0,struct,afdg,sconsts, about,
283 {$IFNDEF LclGtk} printdlg,{$ENDIF}
284 findText,kwlist, Compiler, setpath, setupop;
285 {$R *.lfm}
286
287
288 var
289 InitialDir:ansistring='.';
290
291 procedure TFrameForm.FormCreate(Sender: TObject);
292 begin
293
294 Caption:=Application.Title;
295 OpenDialog1.Title:=s_OpenFile;
296 SaveDialog1.Title:=s_SaveFile;
297
298 Screen.OnActiveFormChange := ActiveFormChange;
299
300 with TMyIniFile.create('Frame') do
301 begin
302 BreakKey:=ReadString('BreakKey',BreakKey)[1];
303 Left:=ReadInteger('Left',Left);
304 Top:=ReadInteger('Top',Top);
305 Width:=ReadInteger('Width',Width);
306 Height:=ReadInteger('Height',Height);
307 HideSyntaxMenu:=ReadBool('HideSyntaxMenu',HideSyntaxMenu);
308 NoBackUp:=ReadBool('NoBackUp',NoBackUp);
309 BasExt:=ReadString('BasExt',BasExt);
310 LibExt:=ReadString('LibExt',LibExt);
311 InitialDir:=ReadString('InitialDir', InitialDir);
312 OpenDialog1.InitialDir:=InitialDir;
313 InitialDir:=ReadString('InitialDir', InitialDir);
314 SaveDialog1.InitialDir:=InitialDir;
315 Run2.ShortCut:=ReadInteger('RunShortCut',Run2.ShortCut);
316 Step1.ShortCut:=ReadInteger('StepShortCut',Step1.ShortCut);
317
318 if ToolBar1.Flat<>ReadBool('Flat',ToolBar1.flat) then
319 ButtonFrame1Click(self);
320 if ToolBar1.visible <> ReadBool('ToolBar',ToolBar1.visible) then
321 ShowToolBar1Click(self);
322
323 if ReadOnly then
324 I1.Enabled:=false;
325 free
326 end;
327
328 if permitMicrosoft then MinimalBasic:=true;
329 SetOptionMenues(0);
330 if MinimalBasic then SetOptionMenues(1);
331 if permitMicrosoft then SetOptionMenues(2);
332 if HideSyntaxMenu then
333 begin
334 syntax1.enabled:=false;
335 MinimalBasic:=false;
336 PermitMicrosoft:=false;
337 SetOptionMenues(0);
338 end;
339 FrameForm.StatusBar1.Panels[3].text:=statusBarMems3;
340
341 // ToolBar1.Height:=27;
342
343 Break1.ShortCut:=ShortCut(Word(BreakKey), [ssCtrl,ssalt]);
344 executing:=false;
345 OverWriteMode:=false;
346
347 with TMyIniFile.create('EditorFont') do
348 begin
349 RestoreFont(Memo1.Font);
350 free
351 end;
352 // WindowState:=wsNormal
353 end;
354
355 procedure TFrameForm.Code1Click(Sender: TObject);
356 begin
357 Step1Click(sender)
358 end;
359
360
361
362 procedure TFrameForm.FormDestroy(Sender: TObject);
363 begin
364 //Application.HelpCommand(HELP_QUIT,0);
365
366 with TMyIniFile.create('Frame') do
367 begin
368 WriteInteger('Left',Left);
369 WriteInteger('Top',Top);
370 WriteInteger('Width',Width);
371 WriteInteger('Height',Height);
372 WriteBool('Flat',ToolBar1.Flat);
373 WriteBool('ToolBar',ToolBar1.visible);
374 WriteInteger('RunShortCut',Run2.ShortCut);
375 WriteInteger('StepShortCut',Step1.ShortCut);
376
377 Free
378 end;
379
380 with TMyIniFile.create('EditorFont') do
381 begin
382 StoreFont(Memo1.Font);
383 free
384 end;
385
386 end;
387
388 procedure TFrameForm.FormShow(Sender: TObject);
389 begin
390 if ToTerminate then
391 Application.Terminate ;
392
393 if ToOpen then
394 begin
395 CodeForm.Visible:=false; //WindowState:=wsMinimized;
396 //PaintForm.Visible:=false; //WindowState:=wsMinimized;
397 //TraceForm.Visible:=false; //.WindowState:=wsMinimized;
398 OpenTextFile(ToOpenFile);
399 Application.ProcessMessages;
400
401 ToOpen:=false;
402 BringToFront;
403 end;
404
405 end;
406
407 (*
408 procedure TFrameForm.FormActivate(Sender: TObject);
409 begin
410 FrameForm.setStatusBar1(OverWriteMode);
411 with FrameForm do
412 begin
413 TBCut.enabled:=not executing;
414 TBPaste.enabled:=not executing;
415 TBUndo.enabled:=not executing;
416 end;
417 UpdateCursorPos ;
418
419 end;
420 *)
421
422 procedure TFrameForm.FormResize(Sender: TObject);
423 begin
424 memo1.refresh;
425 end;
426
427 procedure TFrameForm.ActiveFormChange(Sender: TObject);
428 begin
429 end;
430
431 procedure TFrameForm.FormClose(Sender: TObject; var Action: TCloseAction);
432 begin
433 windowState:=wsNormal;
434 toolbox.close;
435 end;
436
437 procedure TFrameForm.FormDeactivate(Sender: TObject);
438 begin
439 //FindDialog1.closeDialog;
440 //ReplaceDialog1.closeDialog;
441 end;
442
443 procedure TFrameForm.Memo1Change(Sender: TObject);
444 begin
445 changed:=true
446 end;
447
448
449 procedure TFrameForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
450 var
451 MsgVal: integer;
452 FileName: string;
453 begin
454 if executing then
455 begin
456 //ShowMessage(s_CannotQuit);
457 Break1Click(Sender);
458 CanClose:=false;
459 exit
460 end
461 else
462 begin
463 FileName := OpenDialog1.FileName;
464 if Memo1.Modified then
465 begin
466 MsgVal := MessageDlg(Format(CloseMsg, [FileName]),
467 mtConfirmation, [mbYes,mbNo,mbCancel], 0);
468 case MsgVal of
469 mrYes: CanClose:=Save;
470 mrCancel: CanClose := false;
471 end;
472 end;
473 end;
474 end;
475
476 function TFrameForm.ValidComponent(component:TComponent):boolean;
477 var
478 i:integer;
479 begin
480 ValidComponent:=true;
481 i:=ComponentCount;
482 while i>0 do
483 begin
484 dec(i);
485 if Components[i]=component then exit
486 end;
487 ValidComponent:=false
488 end;
489
490
491
492
493 function TFrameForm.CloseQuery:boolean;
494 begin
495 result:=true;
496 FormCloseQuery(Self,result)
497 end;
498
499 var PrevIndex:integer=0;
500
501 function ReadSJISFile(const fname:string):string;
502 var
503 p:PChar;
504 i,k:integer;
505 s:TFileStream;
506 begin
507 with TFileStream.Create(fname,fmOpenRead) do
508 try
509 k:=size;
510 p:=Allocmem(k+1);
511 try
512 for i:=0 to k-1 do
513 Read(p[i],1);
514 Result:=SysToUTF8(p);
515 finally
516 FreeMem(p,k+1);
517 end;
518 finally
519 free;
520 end;
521
522 end;
523
524
525
526 function TFrameForm.OpenTextFile(FileName: string):boolean;
527 const DefaultText:string=EOL+'END'+EOL;
528 begin
529 changed:=true;
530 Hint:='';
531 previndex:=0;
532 result:=false;
533
534 if FileName <> '' then
535 try
536 OpenDialog1.FileName:=FileName;
537
538 Memo1.Lines.BeginUpdate;
539
540 if ProgramFileCharsetUTF8 then
541 MEMO1.LINES.LoadFromFile(UTF8toSys(FileName))
542 else
543 Memo1.lines.Text:=ReadSJISFile(UTF8toSys(FileName));
544
545 Memo1.Lines.EndUpdate;
546
547 Memo1.Modified:=false;
548 Caption := Application.Title + ' [ ' + FileName + ' ]';
549 result:=true;
550 except
551 MessageDlg(s_Extype9003+EOL+FileName,mtError, [mbOk],0);
552 end
553 else
554 begin
555 OpenDialog1.FileName:='NoName'+BasExt;
556 Memo1.ClearAll;
557 if not permitMicrosoft then
558 //Memo1.seltext:=DefaultText; //This causes an error on Linux Lazarus 0.9.24
559 Memo1.Lines.text:=DefaultText;
560 Memo1.SelStart:=0;
561 Memo1.Modified:=false;
562 Caption:=Application.Title;
563 result:=true;
564 end;
565 if (CompareStr(UpperCase(ExtractFileExt(FileName)), BASExt) = 0) or
566 (FileName = '') then
567 begin
568 WordWrap1.visible:=false
569 end ;
570
571 end;
572
573
574 procedure TFrameForm.New1Click(Sender: TObject);
575 begin
576 //if executingNow then exit;
577 if memo1.Modified and not CloseQuery then exit;
578 OpenTextFile('');
579 end;
580
581 procedure TFrameForm.Open1Click(Sender: TObject);
582 begin
583 //if executingNow then exit;
584 if memo1.Modified and not CloseQuery then exit;
585 OpenDialog1.Filter :=
586 s_program+'|*'+BasExt+';*.BAS;*.BAK|'
587 +s_Library+'|*'+LibExt+';*.Lib;*.LIB|'
588 +s_TextFile+'|*.txt;*.TXT;*.log;*.LOG|';
589 OpenDialog1.DefaultExt :=copy(BasExt,2,3);
590 if OpenDialog1.Execute then
591 OpenTextFile(OpenDialog1.FileName);
592 end;
593
594
595 function TFrameForm.Save:boolean;
596 var
597 i:integer;
598 begin
599 with OpenDialog1 do
600 begin
601 if (FileName = '') or (Pos('NoName',FileName)>0 )then
602 result:=SaveAs
603 else
604 begin
605 if ProgramFileCharsetUTF8 then
606 Memo1.Lines.SaveToFile(UTF8toSYS(FileName))
607 else // UTF-8
608 With TStringList.Create do
609 begin
610 for i:=0 to Memo1.Lines.Count-1 do
611 Add(UTF8toSys(memo1.lines[i]));
612 SaveToFile(UTF8toSYS(FileName));
613 Clear; Free;
614 end;
615 ;
616 Memo1.Modified := false;
617 result:=true;
618 end;
619 end;
620 end;
621
622 procedure TFrameForm.Save1Click(Sender: TObject);
623 begin
624 save;
625 end;
626
627
628 function TFrameForm.SaveAs:boolean;
629 begin
630 With FrameForm.SaveDialog1 do
631 begin
632 Filter:=s_program+'|*'+BasExt+'|'+s_library+'|*'+LibExt+'|'+s_TextFile+'|*.TXT';
633 FileName := OpenDialog1.FileName;
634 DefaultExt:=copy(BasExt,2,3);
635 result:=Execute;
636 if result then
637 begin
638 OpenDialog1.FileName := FileName;
639 result:=Save;
640 end;
641 end;
642 end;
643
644 procedure TFrameForm.SaveAs1Click(Sender: TObject);
645 begin
646 SaveAs
647 end;
648
649 procedure TFrameForm.merge1Click(Sender: TObject);
650 begin
651 OpenDialog1.Filter :=
652 s_Library+'|*.lib|'+s_Program+'|*.bas|'+s_TextFile+'|*.txt';
653 OpenDialog1.DefaultExt := 'lib';
654 if OpenDialog1.Execute then
655 with TStringList.Create do
656 begin
657 loadFromFile(OpenDialog1.FileName);
658 memo1.lines.beginUpdate;
659 memo1.SelStart:=length(memo1.Text);
660 memo1.seltext:=sysToUTF8(text);
661 memo1.modified:=true;
662 memo1.lines.endupdate;
663 Clear; free;
664 end;
665 end;
666
667
668
669 procedure TFrameForm.Close1Click(Sender: TObject);
670 begin
671 Close;
672 end;
673
674 procedure TFrameForm.Break1Click(Sender: TObject);
675 begin
676 ctrlBreakHit:=true;
677 SetBreakMessage;
678 end;
679
680
681 procedure TFrameForm.Font1Click(Sender: TObject);
682 var
683 i:integer;
684 begin
685 FontDialog1.Font.assign(Memo1.Font);
686 if FontDialog1.Execute then
687 begin
688 Memo1.Font.assign(FontDialog1.Font);
689 end;
690 end;
691
692 procedure TFrameForm.option2Click(Sender: TObject);
693 begin
694 Optiondg.setoption;
695 SetPrecisionButtons(InitialPrecisionMode0);
696 end;
697
698 procedure TFrameForm.SetPrecisionButtons(mode:tpPrecision);
699 begin
700 case Mode of
701 PrecisionNormal: TBDecimal.down:=true;
702 PrecisionHigh: TBHighprecision.Down:=true;
703 PrecisionNative: TBBinary.down:=true;
704 PrecisionComplex: TBComplex.down:=true;
705 PrecisionRational:TBRational.down:=true;
706 end;
707 end;
708
709 procedure TFrameForm.SetAngleButtons(s:boolean);
710 begin
711 TBdeg.down:=s;
712 end;
713
714
715 procedure TFrameForm.compatibility1Click(Sender: TObject);
716 begin
717 setCompatibility
718 end;
719
720
721 procedure TFrameForm.AutoCorrect1Click(Sender: TObject);
722 var
723 i:integer;
724 begin
725 with optionAC do
726 begin
727 for i:=0 to ac_end do
728 CheckListBox1.checked[i]:=AutoCorrect[i];
729 OptionAC.CheckListBox2.Visible:=not MinimalBasic;
730 OptionAC.Label2.Visible:=not MinimalBasic;
731 CheckListBox2.checked[0]:=InsertDIMst;
732 CheckListBox2.checked[1]:=(InitialOptionBase=0);
733 CheckListBox3.checked[0]:=InitialAngleDegrees;
734 CheckListBox4.Checked[0]:=AutoIndent;
735 if showModal=mrOK then
736 begin
737 for i:=0 to ac_end do
738 AutoCorrect[i]:=CheckListBox1.checked[i];
739 InsertDIMst:=CheckListBox2.checked[0];
740 Boolean(InitialOptionBase):= not CheckListBox2.checked[1];
741 InitialAngleDegrees:=CheckListBox3.checked[0];
742 setAngleButtons(InitialAngleDegrees);
743 AutoIndent:=CheckListBox4.Checked[0];
744 end;
745 end
746 end;
747
748
749 procedure TFrameForm.SetOptionMenues(b:byte);
750 const
751 mes:array[0..2]of string=(s_Standard,s_Minimal,s_MS);
752 var
753 s:boolean;
754 begin
755 StatusBar1.Panels[2].text:=mes[b];
756 case b of
757 0,1:begin
758 s:=true;
759 setPrecisionButtons(InitialPrecisionMode0);
760 SetAngleButtons(InitialAngleDegrees);
761 end;
762 else begin {Microsoft BASIC}
763 s:=false;
764 setPrecisionButtons(PrecisionNative);
765 SetAngleButtons(false);
766 end;
767 end;
768 option2.enabled:=s;
769 Compatibility1.enabled:=s;
770 Autocorrect1.enabled:=s;
771 TBDecimal.enabled:=s;
772 TBHighPrecision.enabled:=s;
773 TBComplex.enabled:=s;
774 TBRational.enabled:=s;
775 TBDeg.enabled:=s;
776 end;
777
778 procedure TFrameForm.Syntax1Click(Sender: TObject);
779 var
780 b:byte;
781 begin
782 with SyntaxDlg do
783 begin
784 b:=byte(MinimalBasic);
785 RadioGroup1.ItemIndex:=b;
786 if permitMicrosoft then RadioGroup1.ItemIndex:=2;
787 CheckListBox1.checked[0]:=OptionExplicit;
788
789 if ShowModal=mrOK then
790 begin
791 MinimalBasic:=RadioGroup1.Itemindex>0;
792 permitMicrosoft:=(RadioGroup1.Itemindex=2);
793 SetOptionMenues(RadioGroup1.ItemIndex);
794 OptionExplicit:=(CheckListBox1.checked[0]) and not MinimalBasic;
795 end;
796 end;
797 end;
798
799
800
801 procedure TFrameForm.SetStatusBar1(OverWriteMode:boolean);
802 begin
803 if OverWriteMode then
804 begin
805 StatusBar1.Panels[0].text:=s_Overwrite;
806 StatusBar1.Panels[0].Bevel:=pbRaised;
807 end
808 else
809 begin
810 StatusBar1.Panels[0].text:=s_insert;
811 StatusBar1.Panels[0].Bevel:=pbLowered;
812 end;
813 end;
814
815 procedure TFrameForm.TextOut1Click(Sender: TObject);
816 begin
817 with CodeForm do
818 begin
819 Visible:=true;
820 WindowState:=wsNormal;
821 BringToFront
822 end;
823 end;
824
825 procedure TFrameForm.Graphic1Click(Sender: TObject);
826 begin
827 end;
828
829
830
831
832
833 procedure TFrameForm.TBOpenClick(Sender: TObject);
834 begin
835 Open1Click(sender)
836 end;
837
838 procedure TFrameForm.TBSaveClick(Sender: TObject);
839 begin
840 SaveAs1click(sender)
841 end;
842
843 procedure TFrameForm.TBPrintClick(Sender: TObject);
844 begin
845 Print1click(sender)
846 end;
847
848 procedure TFrameForm.TBCutClick(Sender: TObject);
849 begin
850 Cut1click(sender)
851 end;
852
853 procedure TFrameForm.TBCopyClick(Sender: TObject);
854 begin
855 Copy1click(sender)
856 end;
857
858
859 procedure TFrameForm.TBPasteClick(Sender: TObject);
860 begin
861 Paste1click(sender)
862 end;
863
864
865 procedure TFrameForm.TBUndoClick(Sender: TObject);
866 begin
867 Undo1click(sender)
868 end;
869
870 procedure TFrameForm.TBRunClick(Sender: TObject);
871 begin
872 Run2click(sender)
873 end;
874
875
876 procedure TFrameForm.TBStepClick(Sender: TObject);
877 begin
878 Step1click(sender)
879 end;
880
881
882
883 procedure TFrameForm.TBBreakClick(Sender: TObject);
884 begin
885 Break1click(sender)
886 end;
887
888 procedure TFrameForm.TBHelpClick(Sender: TObject);
889 begin
890 Contents1Click(sender)
891 end;
892
893 procedure TFrameForm.TBDecimalClick(Sender: TObject);
894 begin
895 InitialPrecisionMode0:=PrecisionNormal
896 end;
897
898 procedure TFrameForm.TBHighPrecisionClick(Sender: TObject);
899 begin
900 InitialPrecisionMode0:=PrecisionHigh
901 end;
902
903 procedure TFrameForm.TBBinaryClick(Sender: TObject);
904 begin
905 InitialPrecisionMode0:=PrecisionNative
906 end;
907
908 procedure TFrameForm.TBComplexClick(Sender: TObject);
909 begin
910 InitialPrecisionMode0:=PrecisionComplex
911 end;
912
913 procedure TFrameForm.TBRationalClick(Sender: TObject);
914 begin
915 InitialPrecisionMode0:=PrecisionRational
916 end;
917
918
919 procedure TFrameForm.TBDegClick(Sender: TObject);
920 begin
921 InitialAngleDegrees:=not InitialAngleDegrees;
922 end;
923
924
925 procedure TFrameForm.L1Click(Sender: TObject);
926 begin
927 with TraceForm do
928 begin
929 visible:=true;
930 if WindowState=wsMinimized then
931 WindowState:=wsNormal;
932 BringToFront
933 end;
934 end;
935
936 procedure TFrameForm.Debug1Click(Sender: TObject);
937 begin
938 // DebugDlg.setFont;
939 end;
940
941 procedure TFrameForm.ShowToolBar1Click(Sender: TObject);
942 begin
943 with ShowToolBar1 do
944 begin
945 Checked:=not checked;
946 ToolBar1.visible:=checked;
947 ButtonFrame1.Enabled:=checked;
948 end;
949 end;
950
951 procedure TFrameForm.ButtonFrame1Click(Sender: TObject);
952 begin
953 with ButtonFrame1 do
954 begin
955 checked:=not checked;
956 Toolbar1.Flat:=not checked;
957 end;
958
959 end;
960
961 procedure TFrameForm.N9Click(Sender: TObject);
962 begin
963 FkeysDlg.Execute
964 end;
965
966
967 procedure TFrameForm.AutoFormat1Click(Sender: TObject);
968 begin
969 AFDg.SetAutoFormat;
970 end;
971
972 procedure TFrameForm.SetBreakMessage;
973 begin
974 StatusBar1.Panels[3].text:=s_To_Break;
975 StatusBar1.update;
976 end;
977
978 procedure TFrameForm.I1Click(Sender: TObject);
979 begin
980 InitializeEnv;
981 end;
982
983 procedure TFrameForm.tbNewClick(Sender: TObject);
984 begin
985 New1Click(Sender)
986 end;
987
988 procedure TFrameForm.MenuFont1Click(Sender: TObject);
989 begin
990 FontDialog1.Font:=Font;
991 if FontDialog1.Execute then
992 Font:=FontDialog1.Font;
993 end;
994
995 procedure TFrameForm.Exit1Click(Sender: TObject);
996 begin
997 FrameForm.Close1Click(Sender);
998 end;
999
1000
1001 procedure TFrameForm.Cut1Click(Sender: TObject);
1002 begin
1003 if executing then exit;
1004 Memo1.CutToClipBoard;
1005 UnDoFromBackUp:=false;
1006 changed:=true;
1007 end;
1008
1009 procedure TFrameForm.Copy1Click(Sender: TObject);
1010 begin
1011 Memo1.CopyToClipBoard;
1012 UnDoFromBackUp:=false;
1013 end;
1014
1015 procedure TFrameForm.Paste1Click(Sender: TObject);
1016 begin
1017 if executing then exit;
1018 Memo1.PasteFromClipBoard;
1019 UnDoFromBackUp:=false;
1020 changed:=true;
1021 end;
1022
1023 procedure TFrameForm.Delete1Click(Sender: TObject);
1024 begin
1025 if executing then exit;
1026 Memo1.ClearSelection;
1027 UnDoFromBackUp:=false;
1028 changed:=true;
1029 end;
1030
1031 procedure TFrameForm.SelectAll1Click(Sender: TObject);
1032 begin
1033 Memo1.SelectAll;
1034 end;
1035
1036 procedure TFrameForm.Undo1Click(Sender: TObject);
1037 begin
1038 if UnDoFromBackup then
1039 memo1.lines.text:=backUp
1040 else
1041 Memo1.Undo;
1042 //SendMessage(Memo1.Handle,WM_UNDO,0,0);
1043 changed:=true;
1044 end;
1045
1046 procedure TFrameForm.Print1Click(Sender: TObject);
1047 begin
1048 {$IFNDEF LclGtk}
1049 with TPrintDialog1.create(self) do
1050 begin
1051 Execute(memo1);
1052 free
1053 end;
1054 {$ENDIF}
1055 end;
1056
1057
1058
1059 procedure TFrameForm.WordWrap1Click(Sender: TObject);
1060 begin
1061 (*
1062 with Memo1 do begin
1063 WordWrap := not WordWrap;
1064 if WordWrap then
1065 ScrollBars := ssVertical
1066 else
1067 ScrollBars := ssBoth;
1068 WordWrap1.Checked := WordWrap;
1069 end;
1070 *)
1071 end;
1072
1073 procedure TFrameForm.PrepareSearch;
1074 var
1075 s:string;
1076 begin
1077 s:=Memo1.seltext;
1078 if MultiLine(s) then
1079 SearchLength:=Memo1.selend - memo1.SelStart -1
1080 else
1081 begin
1082 SearchLength:=Length(Memo1.text)-1;
1083 memo1.selstart:=0;
1084 FindDialog1.FindText:=s;
1085 ReplaceDialog1.FindText:=s;
1086 end;
1087 //Memo1.sellength:=0;
1088 end;
1089
1090 procedure TFrameForm.Find1Click(Sender: TObject);
1091 begin
1092 PrepareSearch;
1093 FindDialog1.Execute;
1094 FindNext1.Enabled :=True;
1095 end;
1096
1097 procedure TFrameForm.Repalce1Click(Sender: TObject);
1098 begin
1099 if executing then exit;
1100 backUp:=Memo1.lines.text;
1101 UnDoFromBackUp:=true;
1102
1103 PrepareSearch;
1104 ReplaceDialog1.Execute;
1105 FindNext1.Enabled := False;
1106 changed:=true;
1107 end;
1108
1109 procedure TFrameForm.FindNext1Click(Sender: TObject);
1110 begin
1111 Find(FindDialog1);
1112 end;
1113
1114 function TFrameForm.search(const FText:ansistring; Options1:TFindOptions):boolean;
1115 var
1116 p:integer;
1117 s:TFindOptions;
1118 InitialPos:integer;
1119 begin
1120 s:=[];
1121 if frMatchCase in Options1 then s:=s+[frMatchCase];
1122 with memo1 do
1123 begin
1124 InitialPos:=SelEnd; //selstart+selLength;
1125 if frWholeWord in Options1 then
1126 p:=findword(memo1,FText,InitialPos,SearchLength,s)
1127 else
1128 //p:=findtext(FText,InitialPos,SearchLength,s);
1129 p:=SearchText(memo1,FText,InitialPos,SearchLength,s);
1130 if p>=0 then
1131 begin
1132 selstart:=p;
1133 Selend:=p+Length(FText); //selLength:=length(FText);
1134 searchLength:=searchlength-(p-initialPos)-length(FText);
1135 result:=true;
1136 end
1137 else
1138 begin
1139 selStart:=SelStart+length(FText);
1140 SelEnd:=SelStart; //selLength:=0;
1141 result:=false;
1142 end;
1143 end;
1144 end;
1145
1146
1147
1148 procedure TFrameForm.Find(Sender: TObject);
1149 begin
1150 with Sender as TFindDialog do
1151 if Search( FindText, Options) then
1152 else
1153 CloseDialog; //ShowMessage( FindText + EOL + s_NotFound);
1154 end;
1155
1156 procedure TFrameForm.Replace(Sender: TObject);
1157 var
1158 Found: Boolean;
1159 begin
1160 with ReplaceDialog1 do
1161 begin
1162 if AnsiCompareText(Memo1.SelText, FindText) = 0 then
1163 Memo1.SelText := ReplaceText;
1164 Found := Search( FindText, Options);
1165 while Found and (frReplaceAll in Options) do
1166 begin
1167 Memo1.SelText := ReplaceText;
1168 Found := Search( FindText, Options);
1169 end;
1170 if (not Found) {and (frReplace in Options)} then
1171 CloseDialog //ShowMessage( FindText + EOL + s_NotFound);
1172 end;
1173 changed:=true;
1174 end;
1175
1176 procedure TFrameForm.FindDialog1Find(Sender: TObject);
1177 begin
1178 Find(Sender);
1179 end;
1180
1181 procedure TFrameForm.ReplaceDialog1Find(Sender: TObject);
1182 begin
1183 Find(Sender)
1184 end;
1185
1186 procedure TFrameForm.ReplaceDialog1Replace(Sender: TObject);
1187 begin
1188 Replace(Sender);
1189 end;
1190
1191
1192 procedure TFrameForm.ToolBox1Click(Sender: TObject);
1193 begin
1194 if not memo1.ReadOnly then
1195 try
1196 ToolFrm.ToolBox.show;
1197 changed:=true;
1198 except
1199 showmessage('System Error')
1200 end;
1201 end;
1202
1203
1204
1205 procedure TFrameForm.About1Click(Sender: TObject);
1206 begin
1207
1208 AboutBox.ShowModal
1209
1210 end;
1211
1212 procedure TFrameForm.Path1Click(Sender: TObject);
1213 begin
1214 PathDialog.execute;
1215 end;
1216
1217 procedure TFrameForm.SetUpOptionsClick(Sender: TObject);
1218 begin
1219 SetUpOptionsDlg.execute;
1220 end;
1221
1222
1223 procedure TFrameForm.Contents1Click(Sender: TObject);
1224
1225 begin
1226 {$IFNDEF win32}
1227 Shell('Open ' + ChangeFileExt(Application.ExeName,'.htm'));
1228 {$ELSE}
1229 ShellExecuteA(self.Handle,'Open',PChar(ChangeFileExt(Application.ExeName,'.htm')), '','',SW_SHOW);
1230 {$ENDIF}
1231 end;
1232
1233
1234 procedure TFrameForm.Search1Click(Sender: TObject);
1235 var
1236 s:shortstring;
1237 begin
1238 s:=Trim(Memo1.SelText);
1239 if s='' then s:=(curText);
1240 if s<>'' then
1241 begin
1242 Application.HelpKeyword(s) ;
1243 //s:=s+chr(0);
1244 //Application.HelpCommand(HELP_PARTIALKEY,LongInt(@s[1]))
1245 end
1246 else
1247 Contents1Click(Sender)
1248 end;
1249
1250
1251 procedure TFrameForm.Run2Click(Sender: TObject);
1252 begin
1253 {
1254 backup:=memo1.lines.text;
1255 UnDoFromBackUp:=true;
1256 executing:=true;
1257 RunNormal;
1258 executing:=false;
1259 }
1260 backup:=memo1.lines.text;
1261 UnDoFromBackUp:=true;
1262 executing:=true;
1263 if changed then
1264 begin
1265 changed:=false;
1266 if Generate(CodeForm.Memo1.Lines) then
1267 RunCode(CodeForm);
1268 end
1269 else
1270 executeImmediately;
1271 executing:=false;
1272 end;
1273
1274 procedure TFrameForm.step1Click(Sender: TObject);
1275 begin
1276 {
1277 backup:=memo1.lines.text;
1278 UnDoFromBackUp:=true;
1279 executing:=true;
1280 RunStep;
1281 executing:=false;
1282 }
1283 backup:=memo1.lines.text;
1284 UnDoFromBackUp:=true;
1285 executing:=true;
1286 if Generate(CodeForm.Memo1.Lines) then
1287 begin
1288 CodeForm.visible:=True;
1289 CodeForm.WindowState:=wsNormal;
1290 CodeForm.BringToFront;
1291 end;
1292 executing:=false;
1293 end;
1294
1295
1296 procedure TFrameForm.deleteLabelNumber1Click(Sender: TObject);
1297 begin
1298 backup:=memo1.lines.text;
1299 UndoFromBackUp:=true;
1300 deleteLabelNumber(memo1)
1301 end;
1302
1303 procedure TFrameForm.SelectAll2Click(Sender: TObject);
1304 begin
1305 SelectAll1Click(Sender)
1306 end;
1307
1308 procedure TFrameForm.Popupstep1Click(Sender: TObject);
1309 begin
1310 step1Click(Sender)
1311 end;
1312
1313 procedure TFrameForm.Cut2Click(Sender: TObject);
1314 begin
1315 Cut1Click(Sender)
1316 end;
1317
1318 procedure TFrameForm.copy2Click(Sender: TObject);
1319 begin
1320 copy1Click(Sender)
1321 end;
1322
1323 procedure TFrameForm.paste2Click(Sender: TObject);
1324 begin
1325 paste1Click(sender)
1326 end;
1327
1328 procedure TFrameForm.Delete2Click(Sender: TObject);
1329 begin
1330 Delete1Click(Sender)
1331 end;
1332
1333 procedure TFrameForm.popupRun1Click(Sender: TObject);
1334 begin
1335 Run2Click(Sender)
1336 end;
1337
1338 procedure TFrameForm.PopUpBreak1Click(Sender: TObject);
1339 begin
1340 break1Click(Sender)
1341 end;
1342
1343 procedure TFrameForm.Edit1Click(Sender: TObject);
1344 var
1345 b:boolean;
1346 begin
1347 b:= memo1.seltext<>'' ;
1348 with cut1 do enabled:=(not executing) and b;
1349 copy1.enabled:=b;
1350 with delete1 do enabled:=(not executing) and b;
1351 paste1.Enabled:=not executing;
1352 end;
1353
1354 procedure TFrameForm.PopupMenu1Popup(Sender: TObject);
1355 var
1356 b:boolean;
1357 begin
1358 b:= memo1.seltext<>'' ;
1359 cut2.enabled:=(not executing) and b;
1360 copy2.enabled:=b;
1361 delete2.enabled:=(not executing) and b;
1362 paste2.enabled:=(not executing) ;
1363 end;
1364
1365
1366
1367 procedure TFrameForm.AddLabelNumber1Click(Sender: TObject);
1368 begin
1369 backup:=memo1.lines.text;
1370 UndoFromBackUp:=true;
1371 AddLabelNumber(memo1);
1372 end;
1373
1374 procedure TFrameForm.CaseChange1Click(Sender: TObject);
1375 begin
1376 backup:=memo1.lines.text;
1377 UndoFromBackUp:=true;
1378 CaseChange(memo1);
1379 end;
1380
1381 procedure TFrameForm.BMPsize1Click(Sender: TObject);
1382 begin
1383 OptionSizeDlg.Execute;
1384
1385 end;
1386
1387
1388 const
1389 KeyWordChar:set of char=['0'..'9','A'..'Z','a'..'z','$','_'];
1390 PunctuationChar:set of char=[#13,#10,' ','&'..'/',':'..'>','^'];
1391
1392 function bytechar(s:WideString):char;
1393 var
1394 t:string;
1395 begin
1396 t:=s;
1397 result:=#0;
1398 if length(t)>0 then result:=t[1]
1399 end;
1400
1401 function TFrameForm.curText:ansistring;
1402 var
1403 i,j:integer;
1404 s:widestring;
1405 begin
1406 result:='';
1407 i:=memo1.selstart +1;
1408 j:=i;
1409 s:=memo1.text;
1410 while (i>1) and (bytechar(s[i-1]) in KeyWordChar) do dec(i);
1411 while bytechar(s[j]) in KeyWordChar do inc(j);
1412 result:=copy(s,i,j-i)
1413 end;
1414
1415 procedure TFrameForm.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1416
1417 procedure insert(const s:string);
1418 begin
1419 backUp:=Memo1.lines.Text;
1420 Memo1.seltext:=s;
1421 Memo1.SelStart:=Memo1.SelStart+length(s);
1422 //Memo1.SelLength:=0;
1423 UndoFromBackUp:=true;
1424 end;
1425 begin
1426 if (shift=[]) then
1427 case Key of
1428 vk_F1:begin
1429 Search1Click(Sender);
1430 end;
1431 vk_insert:if memo1.ReadOnly=false then
1432 begin
1433 OverWriteMode:=not OverWriteMode;
1434 FrameForm.SetStatusBar1(OverWriteMode);
1435 ;
1436 end;
1437 end
1438 else if (shift=[ssshift]) and (memo1.ReadOnly=false) then
1439 case Key of
1440 vk_F5:insert(shift_F5);
1441 vk_F6:insert(shift_F6);
1442 vk_F7:insert(shift_F7);
1443 vk_F8:insert(shift_F8);
1444 end ;
1445 end;
1446
1447 procedure TFrameForm.UpdateCursorPos;
1448 var
1449 CPos: TPoint;
1450 begin
1451 if executing then exit;
1452 //CPos.Y := SendMessage(Memo1.Handle, EM_EXLINEFROMCHAR, 0,Memo1.SelStart);
1453 //CPos.X := (Memo1.SelStart -
1454 // SendMessage(memo1.Handle, EM_LINEINDEX, CharPos.Y, 0));
1455
1456 CPos.Y := Memo1.CaretY;
1457 CPos.X := Memo1.CaretX;
1458
1459 //Inc(CPos.y);
1460 //Inc(CPos.x);
1461 FrameForm.StatusBar1.Panels[1].text:=Format('%6d:%4d', [CPos.y, CPos.x]);
1462 //FrameForm.StatusBar1.Panels[1].Bevel:=pbLowered;
1463 end;
1464
1465 procedure TFrameForm.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
1466 begin
1467 if Memo1.selStart=Memo1.SelEnd then
1468 begin
1469 if not TranslatingNow and AutoFormatKw then
1470 case key of
1471 vk_SPACE, vk_RETURN: AutoFormat;
1472 end;
1473 //PrevIndex:=Memo1.SelStart;
1474 UpdateCursorPos;
1475 end;
1476 end;
1477
1478 var PrevLine:integer=-1;
1479 procedure TFrameForm.AutoFormat;
1480 var
1481 i,j:integer;
1482 c1,c2:char;
1483 len:integer;
1484 ExPos:TPoint;
1485 begin
1486 if executing then exit;
1487 j:=PrevLine;
1488 ExPos:=Memo1.CaretXY;
1489 prevLine:=Memo1.CaretY-1;
1490 if (j<0) or (pass<>0) then exit;
1491 if TextHand.memo<>nil then exit; //������������
1492
1493 texthand.memo:=memo1;
1494 texthand.linenumber:=j;
1495 try
1496 texthand.initline;
1497 while tokenspec<>tail do
1498 begin
1499 if tokenspec in [NIdf,SIdf] then
1500 begin
1501 if keyWordList1.find(token,i)
1502 or ((token='ANGLE') and (PrevToken='OPTION'))
1503 or ((token='SIZE') and (PrevToken='DEVICE'))
1504 or keyWordList2.find(token,i) then
1505 ReplaceToken2(token);
1506 end;
1507 if (token='DATA') or (token='IMAGE') or (token='REM') then
1508 skip
1509 else
1510 gettoken;
1511 end;
1512 except
1513 on e:exception do
1514 end;
1515 texthand.memo:=nil;
1516
1517 Memo1.CaretXY:=exPos;
1518 end;
1519
1520
1521 (*
1522 procedure TFrameForm.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
1523 begin
1524 if Memo1.sellength=0 then
1525 begin
1526 if not ExecutingNow and AutoFormatKw and (key = vk_RETURN) then
1527 AutoFormat;
1528 UpdateCursorPos;
1529 end;
1530 end;
1531
1532
1533 procedure TFrameForm.AutoFormat;
1534 var
1535 i,j:integer;
1536 begin
1537 if executing then exit;
1538 if TextHand.memo<>nil then exit; //������������
1539
1540
1541 j:=PrevIndex;
1542 PrevIndex:=Memo1.SelStart;
1543 if (j>0)
1544 and (length(Memo1.lines.Text)>j)
1545 and (Memo1.lines.text[j] in KeyWordChar )
1546 and (Memo1.lines.text[j+1] in PunctuationChar )
1547 and (Pass=0) then
1548 begin
1549 texthand.memo:=memo1;
1550 //memo1.lines.BeginUpdate;
1551 //texthand.linenumber:=SendMessage(memo1.handle,EM_LINEFROMCHAR,j,0);
1552 texthand.linenumber:=LineFromChar(memo1,j);
1553 try
1554 texthand.initline;
1555 while tokenspec<>tail do
1556 begin
1557 if tokenspec in [NIdf,SIdf] then
1558 begin
1559 if keyWordList1.find(token,i)
1560 or ((token='ANGLE') and (PrevToken='OPTION'))
1561 or ((token='SIZE') and (PrevToken='DEVICE'))
1562 or keyWordList2.find(token,i) then
1563 ReplaceToken2(token);
1564 end;
1565 if (token='DATA') or (token='IMAGE') or (token='REM') then
1566 skip
1567 else
1568 gettoken;
1569 end;
1570 except
1571 on e:exception do
1572 end;
1573 texthand.memo:=nil;
1574 Memo1.SelStart:= PrevIndex;
1575 //memo1.lines.EndUpdate;
1576 end;
1577
1578 end;
1579 *)
1580
1581
1582
1583 initialization
1584
1585
1586
1587 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26