DISCLAIMER This is the GraphWin unit of NGpaint. It is a Delphi 2 unit. unit GraphWin; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, MDIedit; type Str7 = String[7]; TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtText); TdrElem = Record PColor : TColor; PStyle : TPenStyle; PWidth : Integer; BColor : TColor; BStyle : TBrushStyle; FColor : TColor; DrTool : TDrawingTool; End; TGrafForm = class(TForm) Panel1: TPanel; LineButton: TSpeedButton; RectangleButton: TSpeedButton; EllipseButton: TSpeedButton; SolidPen: TSpeedButton; DashPen: TSpeedButton; DotPen: TSpeedButton; DashDotPen: TSpeedButton; PenWidth: TUpDown; PenSize: TEdit; StatusBar1: TStatusBar; ScrollBox1: TScrollBox; Image: TImage; ColorDialog1: TColorDialog; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; MainMenu1: TMainMenu; Edit1: TMenuItem; copy1: TMenuItem; CbGridSnap: TCheckBox; CbOrthoSnap: TCheckBox; CbBrushStyle: TCheckBox; TextButton: TSpeedButton; File1: TMenuItem; Textwindow1: TMenuItem; N1: TMenuItem; exit1: TMenuItem; BtnPaintGrid: TBitBtn; N2: TMenuItem; grid1: TMenuItem; procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); procedure LineButtonClick(Sender: TObject); procedure RectangleButtonClick(Sender: TObject); procedure EllipseButtonClick(Sender: TObject); procedure StyleBtnClick(Sender: TObject); procedure PenSizeChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure SetBrushStyle(Sender: TObject); procedure Copy1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TextButtonClick(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure Textwindow1Click(Sender: TObject); procedure OnGrafWinActivate(Sender: TObject); procedure BtnPaintGridClick(Sender: TObject); procedure grid1Click(Sender: TObject); private { Private declarations } public { Public declarations } Drawing,DrawPoly : Boolean; Origin, MovePt, EllCenter : TPoint; Zoomed : Integer; DrawingTool: TDrawingTool; EdMemo : TMemo; EdWin : TEditForm; HiLitString : ShortString; {note: Delphi 32 shortstring = String[255]} F7LineNo,OriLen,SumLen : Integer; procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode); Function Snap(X,Y:Integer;draw:Boolean):TPoint; Function PenStr : Str7; Function FillStr : Str7; Procedure ToEdit(S : ShortString); Procedure AppEdit(S : ShortString); Function SetEdStyle(Var Z : ShortString):Boolean; Function SetEdBrush(Var Z : ShortString):Boolean; Procedure DrawEdLine(Z : ShortString; pMode : TPenMode;cColor : TColor); Procedure DrawEdRect(Z : ShortString; pMode : TPenMode;cColor : TColor); Procedure DrawEdEllipse(Z : ShortString; pMode : TPenMode;cColor : TColor); Procedure DrawEdText(Z : ShortString; pMode : TPenMode;cColor : TColor); Procedure DrawFromTextLine(Var Z : ShortString; pMode : TPenMode;cColor : TColor); Procedure DrawFromText; Procedure DrawGrid; Procedure SaveCanvas(Var TE : TDrElem); Procedure RestCanvas(Var TE : TDrElem); Procedure HiLite(HL : ShortString); end; var GrafForm: TGrafForm; implementation uses BMPDlg, Clipbrd, MDIFrame; {$R *.DFM} Function I2S(I : Integer):Str7; Var S : Str7; Begin Str(I,S); I2S := S; End; Function NextItem(Var S : ShortString):Str7; Var T : Str7; Begin T := ''; while (S > '') and not (Upcase(S[1]) in ['-','0'..'9','A'..'Z']) do Begin Delete(S,1,1); End; while (S > '') and (Upcase(S[1]) in ['-','0'..'9','A'..'Z']) do Begin T := T+Upcase(S[1]); Delete(S,1,1); End; NextItem := T; End; Function NextInt(Var S : ShortString; Var T : Str7; Var I : Integer):Boolean; Var Chk : Integer; Begin NextInt := false; T := NextItem(S); if T > '' then Begin Val(T,I,Chk); NextInt := (Chk=0); End; End; Function NextStr(Var S : ShortString; Var T : ShortString):Boolean; Begin NextStr := false; T := ''; while (S > '') and (S[1] <> '"') do Begin Delete(S,1,1); End; if (S > '') and (S[1]='"') then Delete(S,1,1); while (S > '') and (S[1] <> '"') do Begin T := T+S[1]; Delete(S,1,1); End; NextStr := T > ''; End; { ------------------------------------------ } Function TGrafForm.PenStr : Str7; Var S,T : Str7; Begin Case Image.Canvas.Pen.Style of psSolid : Begin Str(Image.Canvas.Pen.Width,T); S := '('+T+';'; End; psDash : S := '(DS;'; psDot : S := '(DT;'; psDashDot : S := '(DD;'; End; PenStr := S; End; Function TGrafForm.FillStr : Str7; Var S : Str7; Begin Case Image.Canvas.Brush.Style of bsSolid : FillStr := PenStr+'F;'; bsClear : FillStr := PenStr+'E;'; End; End; procedure TGrafForm.FormCreate(Sender: TObject); {Windows form event} var Bitmap: TBitmap; begin Zoomed := 1; Bitmap := TBitmap.Create; Bitmap.Width := 320; Bitmap.Height := 200; Image.Picture.Graphic := Bitmap; Image.Canvas.Brush.Style := bsClear; EdMemo := Nil; Drawing := false; DrawPoly := false; end; procedure TGrafForm.Exit1Click(Sender: TObject); {menu file exit handler} begin FrameForm.Exit1Click(Sender); {message to mainwindow, finish NGpaint} end; { --- 3 mouse events:} procedure TGrafForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {mouse button down event} Var Itext : String; begin if ((ssCtrl in Shift) or DrawPoly) and (DrawingTool = dtLine) and Drawing then Begin {nothing} End else Begin Origin := Snap(X,Y,false); EllCenter := Origin; Image.Canvas.MoveTo(Origin.X,Origin.Y); MovePt := Origin; End; Drawing := true; StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [Origin.X, Origin.Y]); StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [MovePt.X, MovePt.Y]); if DrawingTool = dtText then Begin Drawing := false; DrawPoly := false; Itext := ''; if InputQuery('Text To Paint', 'Text', Itext) and (Itext > '') then Begin if length(Itext) > 24 then SetLength(Itext,24); Brush.Color := clWhite; Image.Canvas.TextOut(Origin.X,Origin.Y-abs(Image.Canvas.Font.Height),Itext); ToEdit('T(M;'+ I2S(Origin.X)+';'+ I2S(Origin.Y)+';"'+Itext+'")'); End; End; end; procedure TGrafForm.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {mouse button up event} Procedure ProtoLine; Begin if ssCtrl in Shift then Begin if not DrawPoly then Begin if ((Origin.X <> MovePt.X) or (Origin.Y <> MovePt.Y)) then ToEdit('L'+PenStr+ I2S(Origin.X)+';'+ I2S(Origin.Y)); End; if ((Origin.X <> MovePt.X) or (Origin.Y <> MovePt.Y)) then AppEdit(';'+I2S(MovePt.X)+ ';'+I2S(MovePt.Y)); DrawShape(Origin, MovePt, pmCopy); Origin := MovePt; DrawPoly := true; Image.Canvas.MoveTo(MovePt.X,MovePt.Y); StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [Origin.X, Origin.Y]); StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [MovePt.X, MovePt.Y]); End else Begin DrawShape(Origin, MovePt, pmCopy); if ((Origin.X <> MovePt.X) or (Origin.Y <> MovePt.Y)) then Begin if not DrawPoly then ToEdit('L'+PenStr+ I2S(Origin.X)+';'+ I2S(Origin.Y)+';'+ I2S(MovePt.X)+';'+ I2S(MovePt.Y)+')') else AppEdit(';'+I2S(MovePt.X)+ ';'+I2S(MovePt.Y)+')'); End; Drawing := false; DrawPoly := false; End; End; Procedure ProtoRect; Begin DrawShape(Origin, MovePt, pmCopy); if ((Origin.X <> MovePt.X) and (Origin.Y <> MovePt.Y))then ToEdit('R'+FillStr+ I2S(Origin.X)+';'+ I2S(Origin.Y)+';'+ I2S(MovePt.X)+';'+ I2S(MovePt.Y)+')'); Drawing := false; DrawPoly := false; End; Procedure ProtoEllipse; Begin DrawShape(Origin, MovePt, pmCopy); if ((Origin.X <> MovePt.X) and (Origin.Y <> MovePt.Y))then ToEdit('E'+FillStr+ I2S(Origin.X)+';'+ I2S(Origin.Y)+';'+ I2S(MovePt.X)+';'+ I2S(MovePt.Y)+')'); Drawing := false; DrawPoly := false; End; begin {mouseup} if Drawing then begin MovePt := Snap(X,Y,true); Case DrawingTool of dtLine: ProtoLine; dtRectangle: ProtoRect; dtEllipse: ProtoEllipse; End; end; end; procedure TGrafForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); Var LocPt : TPoint; begin Image.Canvas.Pen.Width := PenWidth.Position; if Drawing then begin DrawShape(Origin, MovePt, pmNotXor); MovePt := Snap(X, Y,true); if (DrawingTool = dtEllipse) and (ssCtrl in Shift) then Begin Origin.X := EllCenter.X*2-MovePt.X; Origin.Y := EllCenter.Y*2-MovePt.Y; End; DrawShape(Origin, MovePt, pmNotXor); StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [Origin.X, Origin.Y]); StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [MovePt.X, MovePt.Y]); end else Begin LocPt := Snap(X,Y,false); StatusBar1.Panels[1].Text := Format('Cursor: (%d, %d)', [LocPt.X, LocPt.Y]); End; end; { some button events} procedure TGrafForm.LineButtonClick(Sender: TObject); {button events...} begin if Drawing or DrawPoly then Exit; DrawingTool := dtLine; end; procedure TGrafForm.RectangleButtonClick(Sender: TObject); begin if Drawing or DrawPoly then Exit; DrawingTool := dtRectangle; end; procedure TGrafForm.EllipseButtonClick(Sender: TObject); begin if Drawing or DrawPoly then Exit; DrawingTool := dtEllipse; end; procedure TGrafForm.TextButtonClick(Sender: TObject); begin if Drawing or DrawPoly then Exit; DrawingTool := dtText; end; procedure TGrafForm.StyleBtnClick(Sender: TObject); {common event handler} begin if Drawing or DrawPoly then Exit; with Image.Canvas.Pen do begin if Sender = SolidPen then Style := psSolid else if Sender = DashPen then Style := psDash else if Sender = DotPen then Style := psDot else if Sender = DashDotPen then Style := psDashDot; if Style <> psSolid then PenWidth.Position := 1; end; end; procedure TGrafForm.PenSizeChange(Sender: TObject); begin if Drawing or DrawPoly then Exit; Image.Canvas.Pen.Width := PenWidth.Position; if Image.Canvas.Pen.Width <> 1 then Begin SolidPen.Down := true; {force solid line if not thickness 1} End; end; procedure TGrafForm.SetBrushStyle(Sender: TObject); {event} begin if Drawing or DrawPoly then Exit; with Image.Canvas.Brush do begin if CbBrushStyle.Checked then Begin Style := bsSolid; Color := Image.Canvas.Pen.Color; {filled rects and ellipses} End else Begin Style := bsClear; End; end; end; procedure TGrafForm.Copy1Click(Sender: TObject); {menu edit copy to clip} begin Clipboard.Assign(Image.Picture); End; procedure TGrafForm.FormClose(Sender: TObject; var Action: TCloseAction); begin { Action := caFree; do not close the window! } Action := Action; end; { general drawing procedure, used for line...ellipse } procedure TGrafForm.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode); begin {draws lines, rects and ellipses} with Image.Canvas do begin Pen.Mode := AMode; case DrawingTool of dtLine: begin Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y); Image.Canvas.LineTo(BottomRight.X, BottomRight.Y); end; dtRectangle: Begin Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,BottomRight.Y); End; dtEllipse: Begin Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,BottomRight.Y); End; dtText: Begin {unused, will not happen} End; end; end; end; Function TGrafForm.Snap(X,Y:Integer;draw:Boolean):TPoint; Var diffX,diffY : Integer; QuR : Real; function sign(I : Integer) : Integer; Begin if I >= 0 then sign := 1 else sign := -1; End; Begin if CbGridSnap.Checked then Begin X := ((X+5) div 10)*10; Y := ((Y+5) div 10)*10; End; if draw and CbOrthoSnap.Checked then {ortho snap} Begin diffX := X-origin.X; diffY := Y-origin.Y; if diffY=0 then QuR := sign(diffX)*10000.0 else QuR := (1.0*diffX) / (1.0*diffY); if (abs(QuR) < 0.707) or (abs(QuR) > 1.414) or (DrawingTool <> dtLine) then Begin if abs(diffX) > abs(diffY) then Begin case DrawingTool of dtLine: Y := origin.Y; dtRectangle, dtEllipse: Begin Y := origin.Y + abs(diffX)*sign(diffY); End; end; {case} End else Begin case DrawingTool of dtLine: X := origin.X; dtRectangle, dtEllipse: Begin X := origin.X + abs(diffY)*sign(diffX); End; end; {case} End; End else Begin if abs(diffX) > abs(diffY) then Begin Y := origin.Y + abs(diffX)*sign(diffY); End else Begin X := origin.X + abs(diffY)*sign(diffX); End; End; End; Snap := Point(X,Y); End; {append text to the editwindow} Procedure TGrafForm.ToEdit(S : ShortString); Begin EdMemo.Lines.Append(S); {whole line} End; Procedure TGrafForm.AppEdit(S : ShortString); Var L : Integer; T : ShortString; Begin L := EdMemo.Lines.Count; if L < 1 then Exit; T := EdMemo.Lines[L-1]; {append to last written line} EdMemo.Lines[L-1] := T+S; {increase textline, for polyline} End; {--------- procedures for the parser} Function TGrafForm.SetEdStyle(Var Z : ShortString):Boolean; Var Styl : Integer; T : Str7; Begin SetEdStyle := false; if NextInt(Z,T,Styl) then Begin Image.Canvas.Pen.Style := psSolid; Image.Canvas.Pen.Width := Styl; SetEdStyle := true; End else Begin if T = 'DS' then Begin Image.Canvas.Pen.Style := psDash; Image.Canvas.Pen.Width := 1; SetEdStyle := true; End else if T = 'DT' then Begin Image.Canvas.Pen.Style := psDot; Image.Canvas.Pen.Width := 1; SetEdStyle := true; End else if T = 'DD' then Begin Image.Canvas.Pen.Style := psDashDot; Image.Canvas.Pen.Width := 1; SetEdStyle := true; End; End; End; Function TGrafForm.SetEdBrush(Var Z : ShortString):Boolean; Var T : Str7; Begin SetEdBrush := false; T := NextItem(Z); if T = 'E' then Begin Image.Canvas.Brush.Style := bsClear; SetEdBrush := true; End else if T = 'F' then Begin Image.Canvas.Brush.Style := bsSolid; Image.Canvas.Brush.Color := Image.Canvas.Pen.Color; SetEdBrush := true; End; End; Procedure TGrafForm.DrawEdLine(Z : ShortString; pMode : TPenMode;cColor : TColor); Var X1,Y1,X2,Y2,CPos : Integer; T : Str7; OriZ : ShortString; Function NotCloseBracket : Boolean; Var P : Integer; Begin NotCloseBracket := true; if length(Z) = 0 then Exit; P := 1; while (P < length(Z)) and (Z[P] = ' ') do Inc(P); T := Z[P]; NotCloseBracket := T <> ')'; End; Begin OriZ := Z; Delete(Z,1,1); if SetEdStyle(Z) and NextInt(Z,T,X1) and NextInt(Z,T,Y1) and NextInt(Z,T,X2) and NextInt(Z,T,Y2) then with Image.Canvas do Begin Pen.Mode := pMode; Pen.Color := cColor; Brush.Color := clWhite; MoveTo(X1,Y1); LineTo(X2,Y2); X1 := X2; Y1 := Y2; While NotCloseBracket and {delimiter -> T} NextInt(Z,T,X2) and NextInt(Z,T,Y2) do Begin MoveTo(X1,Y1); LineTo(X2,Y2); X1 := X2; Y1 := Y2; End; if (T <> ')') and (pMode = pmCopy) then {at full F7 draw only} Begin EdWin.SetCursor(OriLen-length(Z),F7LineNo); if MessageDlg( 'Polyline is probably incomplete'+#13#10+OriZ, mtWarning,mbOkCancel,0)<>mrOK then F7LineNo := 100000; End; SumLen := SumLen + OriLen - length(Z)+1; End ; End; Procedure TGrafForm.DrawEdRect(Z : ShortString; pMode : TPenMode;cColor : TColor); Var X1,Y1,X2,Y2 : Integer; T : Str7; Begin Delete(Z,1,1); Image.Canvas.Brush.Color := clWhite; if SetEdStyle(Z) and SetEdBrush(Z) and NextInt(Z,T,X1) and NextInt(Z,T,Y1) and NextInt(Z,T,X2) and NextInt(Z,T,Y2) then with Image.Canvas do Begin SumLen := SumLen + OriLen - length(Z)+1; {assumed ) still in Z} Pen.Mode := pMode; Pen.Color := cColor; Rectangle(X1,Y1,X2,Y2); End; End; Procedure TGrafForm.DrawEdEllipse(Z : ShortString; pMode : TPenMode;cColor : TColor); Var X1,Y1,X2,Y2 : Integer; T : Str7; Begin Delete(Z,1,1); Image.Canvas.Brush.Color := clWhite; if SetEdStyle(Z) and SetEdBrush(Z) and NextInt(Z,T,X1) and NextInt(Z,T,Y1) and NextInt(Z,T,X2) and NextInt(Z,T,Y2) then with Image.Canvas do Begin SumLen := SumLen + OriLen - length(Z)+1; {assumed ) still in Z} Pen.Mode := pMode; Pen.Color := cColor; Ellipse(X1,Y1,X2,Y2); End; End; Procedure TGrafForm.DrawEdText(Z : ShortString; pMode : TPenMode;cColor : TColor); Var X1,Y1,Yb : Integer; T : Str7; S,OriZ : ShortString; Begin OriZ := Z; Delete(Z,1,1); if NextItem(Z)='M' then Begin if NextInt(Z,T,X1) and NextInt(Z,T,Y1) and NextStr(Z,S) then Begin SumLen := SumLen + OriLen - length(Z)+1; {assumed ) still in Z} Yb := Y1-abs(Image.Canvas.Font.Height); if pMode = pmCopy then with Image.Canvas do Begin Pen.Mode := pMode; Brush.Color := clWhite; Font.Color := cColor; Image.Canvas.MoveTo(X1,Y1); Image.Canvas.TextOut(X1,Yb,S); if (Z = '') or (Z[1] <> '"') then Begin EdWin.SetCursor(OriLen-length(Z),F7LineNo); if MessageDlg( 'Legend text is probably incomplete'+#13#10+OriZ, mtWarning,mbOkCancel,0)<>mrOK then F7LineNo := 100000; End; End else with Image.Canvas do Begin Brush.Color := clWhite; Pen.Mode := pMode; Pen.Color := cColor; Pen.Width := 5; Pen.Style := psSolid; Image.Canvas.MoveTo(X1,Y1+1); LineTo(X1+15,Y1+1); End; End; End; End; {parse a single textline} Procedure TGrafForm.DrawFromTextLine(Var Z : ShortString; pMode : TPenMode;cColor : TColor); Begin if (Z > '') and (Z[2]='(') then Begin Case Z[1] of 'L' : DrawEdLine(Z,pMode,cColor); 'R' : DrawEdRect(Z,pMode,cColor); 'E' : DrawEdEllipse(Z,pMode,cColor); 'T' : DrawEdText(Z,pMode,cColor); End; End; End; {parse the whole text from the editwindow, F7} Procedure TGrafForm.DrawFromText; Var R : TRect; Z : ShortString; Begin if EdMemo=Nil then Exit; if (EdMemo IS TMemo) and (EdMemo.Lines.Count > 0) then Begin F7LineNo := 0; SumLen := 0; R.Top := 0; R.Left:=0; R.Bottom := Image.Picture.Graphic.Height; R.Right := Image.Picture.Graphic.Width; Image.Canvas.Brush.Style := bsSolid; Image.Canvas.Brush.Color := clWhite; Image.Canvas.FillRect(R); Image.Canvas.Brush.Style := bsClear; while F7LineNo < EdMemo.Lines.Count do Begin Z := EdMemo.Lines[F7LineNo]; OriLen := Length(Z); DrawFromTextLine(Z,pmCopy,clBlack); Inc(F7LineNo); End; if SumLen > 4095 then {alert the user to be modest!} Begin if MessageDlg(Format('Drawing text is %d characters!',[SumLen]), mtWarning,[mbOk],0)=mrOK then; End; {restore the environment for manual drawing} if LineButton.Down then DrawingTool := dtLine; if RectangleButton.Down then DrawingTool := dtRectangle; if EllipseButton.Down then DrawingTool := dtEllipse; if TextButton.Down then DrawingTool := dtText; with Image.Canvas.Pen do Begin if SolidPen.Down then Style := psSolid; if DashPen.Down then Style := psDash; if DotPen.Down then Style := psDot; if DashDotPen.Down then Style := psDashDot; if Style <> psSolid then PenWidth.Position := 1; End; with Image.Canvas.Brush do begin if CbBrushStyle.Checked then Begin Style := bsSolid; Color := Image.Canvas.Pen.Color; End else Style := bsClear; end; Caption := 'Draw '+ Copy(EdWin.Caption,6,100); End; End; Procedure TGrafForm.DrawGrid; Var X,Y : Integer; R : TRect; SavElem : TDrElem; Begin SaveCanvas(SavElem); with Image.Canvas do Begin Pen.Width := 1; Pen.Color := clAqua; Pen.Style := psDot; Pen.Mode := pmNotXor; Brush.Color := clWhite; for X := 0 to 32 do Begin MoveTo(X*10,0); LineTo(X*10,200); End; for Y := 0 to 20 do Begin MoveTo(0,Y*10); LineTo(320,Y*10); End; End; RestCanvas(SavElem); End; {aux procs} Procedure TGrafForm.SaveCanvas(Var TE : TDrElem); Begin with Image.Canvas, TE do Begin PColor := Pen.Color; PStyle := Pen.Style; PWidth := Pen.Width; BColor := Brush.Color; BStyle := Brush.Style; FColor := Font.Color; DrTool := DrawingTool; End; End; Procedure TGrafForm.RestCanvas(Var TE : TDrElem); Begin with TE, Image.Canvas do Begin Pen.Color := PColor; Pen.Style := PStyle; Pen.Width := PWidth; Brush.Color := BColor; Brush.Style := BStyle; Font.Color := FColor; DrawingTool := DrTool; End; End; procedure TGrafForm.Textwindow1Click(Sender: TObject); {the F6 key event} begin FrameForm.SelectTextWindow(EdWin); {message to the mainwindow} end; Procedure TGrafForm.HiLite(HL : ShortString); Var SavElem : TDrElem; Begin if HL = HiLitString then Exit; SaveCanvas(SavElem); if HiLitString > '' then DrawFromTextLine(HiLitString,pmNotXor,clLime); {erase prev} HiLitString := ''; if ((length(HL) > 5) and (HL[2] = '(') and (Upcase(HL[1]) in ['L','R','E','T'])) then Begin DrawFromTextLine(HL,pmNotXor,clLime); HiLitString := HL; {save it for restore} End; RestCanvas(SavElem); End; {event handlers} procedure TGrafForm.OnGrafWinActivate(Sender: TObject); begin if HiLitString > '' then HiLite(''); {remove ev. highlighted element} end; procedure TGrafForm.BtnPaintGridClick(Sender: TObject); {button event} begin DrawGrid; end; procedure TGrafForm.grid1Click(Sender: TObject); {menu event} begin DrawGrid; end; End.