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.