maindraw.pas

在Delphi中

unit maindraw;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ToolWin, ComCtrls, ExtCtrls, Buttons, StdCtrls, ExtDlgs;

type
  TZQDraw = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    b: TBevel;
    Bevel1: TBevel;
    Panel4: TPanel;
    fc: TPanel;
    Panel7: TPanel;
    bc: TPanel;
    c1: TPanel;
    c2: TPanel;
    c3: TPanel;
    c4: TPanel;
    c5: TPanel;
    c6: TPanel;
    c7: TPanel;
    c8: TPanel;
    c9: TPanel;
    c10: TPanel;
    c11: TPanel;
    c12: TPanel;
    c13: TPanel;
    c14: TPanel;
    c15: TPanel;
    c28: TPanel;
    c29: TPanel;
    c30: TPanel;
    c27: TPanel;
    c26: TPanel;
    c25: TPanel;
    c24: TPanel;
    c23: TPanel;
    c22: TPanel;
    c21: TPanel;
    c20: TPanel;
    c19: TPanel;
    c18: TPanel;
    c17: TPanel;
    c16: TPanel;
    s1: TPanel;
    s2: TPanel;
    s3: TPanel;
    s4: TPanel;
    s6: TPanel;
    s5: TPanel;
    s8: TPanel;
    s7: TPanel;
    s10: TPanel;
    s9: TPanel;
    s12: TPanel;
    s11: TPanel;
    s14: TPanel;
    s13: TPanel;
    s15: TPanel;
    s16: TPanel;
    w1: TPanel;
    w2: TPanel;
    w3: TPanel;
    w4: TPanel;
    w5: TPanel;
    w6: TPanel;
    w7: TPanel;
    ColorDialog1: TColorDialog;
    N11: TMenuItem;
    Edit1: TMenuItem;
    N14: TMenuItem;
    Paste1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    N15: TMenuItem;
    Repeatcommand1: TMenuItem;
    Undo1: TMenuItem;
    U1: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    savp: TSavePictureDialog;
    opp: TOpenPictureDialog;
    www: TPanel;
    zt: TScrollBox;
    pb: TImage;
    myfont: TFontDialog;
    N8: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    procedure N6Click(Sender: TObject);
    procedure pbMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure s1Click(Sender: TObject);
    procedure s2Click(Sender: TObject);
    procedure s3Click(Sender: TObject);
    procedure s4Click(Sender: TObject);
    procedure s5Click(Sender: TObject);
    procedure s6Click(Sender: TObject);
    procedure s7Click(Sender: TObject);
    procedure s8Click(Sender: TObject);
    procedure s9Click(Sender: TObject);
    procedure s10Click(Sender: TObject);
    procedure s11Click(Sender: TObject);
    procedure s12Click(Sender: TObject);
    procedure s13Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure s15Click(Sender: TObject);
    procedure s16Click(Sender: TObject);
    procedure fcMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bcMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c6MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c7MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c8MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c9MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c10MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c11MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c12MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c13MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c14MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c15MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c16MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c17MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c18MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c19MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c20MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c21MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c22MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c23MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c24MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c25MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c26MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c27MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c28MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c29MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure c30MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure w1Click(Sender: TObject);
    procedure w2Click(Sender: TObject);
    procedure w3Click(Sender: TObject);
    procedure w4Click(Sender: TObject);
    procedure w5Click(Sender: TObject);
    procedure w7Click(Sender: TObject);
    procedure w6Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure s14Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    p1,p2,p3,p4:tpoint;
    Cp:bool;
    procedure MyPaint(I:byte);
    procedure MyR(n:byte);
  end;

var
  ZQDraw: TZQDraw;
  num:byte=0;//确定是哪个按钮按下，以便能画相应的图
  s:array[1..16] of tpanel;
  shiftdown:bool;
  arc:array[1..4]of tpoint;//画圆弧时用
  ms:integer=0;
  p:array[1..100] of tpoint;   //画折线与多边形时用
  mm:integer=0;     //画折线与多边形时用
  pp:array of tpoint;  //画折线与多边形时用
  Bfill:bool=false;


implementation

{$R *.dfm}

procedure TZQDraw.MyR(n:byte);
var
i:integer;
begin
  for i:=1 to 16 do
    if i<>n then
      begin
        s[i].BevelOuter:=bvraised;
        s[i].Color:=clBtnFace;
      end;
  s[n].BevelOuter:=bvlowered;
  s[n].Color:=clwhite;
  ms:=0;mm:=0;
  setlength(pp,3);
  pp[0].X:=0;pp[0].Y:=0;
pp[1].X:=1;pp[1].Y:=0;
pp[2].X:=0;pp[2].Y:=1;
end;

procedure TZQDraw.MyPaint(i:byte);
var
m,n:integer;
str:string;
begin
  case i of
  1:begin //直线
      pb.Canvas.PenPos:=p1;
      pb.Canvas.LineTo(p2.X,p2.Y);
    end;
  2:begin //椭圆
      pb.Canvas.Ellipse(p1.X,p1.Y,p2.X,p2.Y);
    end;
  3:begin //铅笔****

    end;
  4:begin //曲线

    end;
  5:begin //圆角矩形
      m:=abs(p2.X-p1.X)div 4;
      n:=abs(p2.y-p1.y)div 4;
      if m>n then m:=n;
      pb.Canvas.RoundRect(p1.X,p1.Y,p2.X,p2.Y,m,m);
    end;
  6:begin //矩形
      pb.Canvas.Rectangle(p1.X,p1.Y,p2.X,p2.Y);
    end;
  7:begin //多边形
      pb.Canvas.Polygon(pp);
    end;
  8:begin //折线
      pb.Canvas.Polyline(pp);
    end;
  9:begin //橡皮擦
      pb.Canvas.Pen.Width:=10;
    end;
  10:begin //刷子
      pb.Canvas.Pen.Width:=10;
    end;
  11:begin //文字
      str:=inputbox('提示','请输入要加入图中的文字','');
      if length(s)>0 then
        pb.Canvas.TextOut(p1.X,p1.Y,str);
    end;
  12:begin //取色
      /////////
    end;
  13:begin //填充色
      ///////////
    end;
  14:begin //放大镜
      //////////
    end;
  15:begin //  扇形

    end;
  16:begin //切分椭圆

    end;
  end;

end;

procedure TZQDraw.N6Click(Sender: TObject);
begin
close;
end;

procedure TZQDraw.pbMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     p1.X:=x;
     p1.Y:=y;
     p2:=p1;
     pb.Canvas.PenPos:=p1;
  if shift=[ssleft] then
    pb.Canvas.Pen.Color:=fc.Color;
  if shift=[ssright] then
    pb.Canvas.Pen.Color:=bc.Color;
  if num in[4,15,16] then  //画圆弧,切分圆，扇形时用
  begin
   if ms>4 then ms:=1
     else ms:=ms+1;
   arc[ms].X:=x;
   arc[ms].Y:=y;
   if ms=1 then
    pb.Canvas.MoveTo(arc[1].X,arc[1].y);
  end;
  if (num in[7,8])and(shift=[ssleft]) then //画折线及多边形
  begin
    ms:=ms+1;
    p[ms].X:=x;
    p[ms].Y:=y;
  end;
  if (num in[7,8])and(shift=[ssright])and(ms<>0)then
    mm:=1000 //准备画折线或多边形
    else mm:=0;
end;

procedure TZQDraw.pbMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
m,n,i:integer;
rect1,rect2:trect;
begin
  p2.X:=x;
  p2.Y:=y;
  if (shift=[ssShift])and(num in [2]) then //画圆用
   begin
     if button=mbleft then
       pb.Canvas.Pen.Color:=fc.Color
     else
       pb.Canvas.Pen.Color:=bc.Color;
     m:=(p2.X-p1.X);
     n:=(p2.Y-p1.Y);
     if abs(m)>abs(n) then m:=n;
     p2.X:=p1.X+m;
     p2.Y:=p1.Y+m;
   end;


  if num in[15,16,4] then //画圆弧,切分圆，扇形时用
  begin
    if ms=4 then
     begin
       case num of
       4:pb.Canvas.Arc(arc[1].x,arc[1].y,arc[2].x,arc[2].y,
          arc[3].x,arc[3].y,arc[4].x,arc[4].y);
       15:pb.Canvas.Pie(arc[1].x,arc[1].y,arc[2].x,arc[2].y,
          arc[3].x,arc[3].y,arc[4].x,arc[4].y);
       16:pb.Canvas.Chord(arc[1].x,arc[1].y,arc[2].x,arc[2].y,
          arc[3].x,arc[3].y,arc[4].x,arc[4].y);
       end;
       ms:=0;
     end;
  end;

  if (mm=1000) then //画折线与多边形
  begin
    setlength(pp,ms);
    for i:=1 to ms do
      pp[i-1]:=p[i];
    pb.Canvas.Pen.Color:=fc.Color;
    pb.Canvas.MoveTo(pp[0].X,pp[0].y);
    ms:=0;
  end;

  if num=14 then  //选择按钮实现代码
  begin
    rect1.Bottom:=p2.Y;
    rect1.Top:=p1.Y;
    rect1.Left:=p1.X;
    rect1.Right:=p2.X;
    rect2.Bottom:=100;
    rect1.Top:=220;
    rect1.Left:=220;
    rect1.Right:=0;
  end;
    mypaint(num);  
end;

procedure TZQDraw.s1Click(Sender: TObject);
begin
  num:=1; pb.Canvas.Pen.Width:=1;
  myr(num);
end;

procedure TZQDraw.s2Click(Sender: TObject);
begin
  num:=2;pb.Canvas.Pen.Width:=1;
  myr(num);
end;

procedure TZQDraw.s3Click(Sender: TObject);
begin
  num:=3;pb.Canvas.Pen.Width:=1;
  myr(num);
end;

procedure TZQDraw.s4Click(Sender: TObject);
begin
  num:=4;pb.Canvas.Pen.Width:=1; myr(num);
end;

procedure TZQDraw.s5Click(Sender: TObject);
begin
num:=5;pb.Canvas.Pen.Width:=1; myr(num);
end;

procedure TZQDraw.s6Click(Sender: TObject);
begin
num:=6;pb.Canvas.Pen.Width:=1;myr(num);
end;

procedure TZQDraw.s7Click(Sender: TObject);
begin
num:=7;pb.Canvas.Pen.Width:=1; myr(num);
end;

procedure TZQDraw.s8Click(Sender: TObject);
begin
num:=8;pb.Canvas.Pen.Width:=1; myr(num);
end;

procedure TZQDraw.s9Click(Sender: TObject);
begin
num:=9;pb.Canvas.Pen.Width:=10;myr(num);
end;

procedure TZQDraw.s10Click(Sender: TObject);
begin
num:=10;pb.Canvas.Pen.Width:=10;myr(num);
end;

procedure TZQDraw.s11Click(Sender: TObject);
begin
num:=11;pb.Canvas.Pen.Width:=1;myr(num);
if myfont.Execute then
pb.Canvas.Font:=myfont.Font;
end;

procedure TZQDraw.s12Click(Sender: TObject);
begin
num:=12;pb.Canvas.Pen.Width:=1;myr(num);
end;

procedure TZQDraw.s13Click(Sender: TObject);