unit1.pas

使用delphi编写的绘图程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    ToolBar3: TToolBar;
    ToolBar4: TToolBar;
    line: TButton;
    Pencil: TButton;
    eraser: TButton;
    square: TButton;
    FSquare: TButton;
    RSquare: TButton;
    FRSquare: TButton;
    Circle: TButton;
    FCircle: TButton;
    ImageList1: TImageList;
    ColorGrid1: TColorGrid;
    PaintBox1: TPaintBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    SaveDialog1: TSaveDialog;
    procedure lineClick(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);

    procedure SetButtonValid;
    procedure paintbox1mousedown(Sender: TObject;button:Tmousebutton;shift:Tshiftstate;x,y:integer);
    procedure paintbox1mouseup(Sender: TObject;button:Tmousebutton;shift:Tshiftstate;x,y:integer);
    procedure N1Click(Sender: TObject);
    procedure oncreate(Sender: TObject);
    procedure paintbox1mousemove(Sender: TObject;shift:Tshiftstate;x,y:integer);
    procedure dispalyhint(Sender: TObject);
  private
    { Private declarations }
    IsDown:boolean;
    startp,endp:Tpoint;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetButtonValid;
var
  i:Integer;
begin
  for i:=0 to form1.ComponentCount-1 do
  begin
    if form1.Components[i] is TToolbutton then
      (form1.Components[i] as TToolbutton).Down:=false;
  end;
end;

procedure TForm1.lineClick(Sender: TObject);
begin
  if sender is TToolbutton then
   begin
     setbuttonvalid;
     with sender as TToolbutton do
       down:=true;
   end;
end;

procedure TForm1.ColorGrid1Change(Sender: TObject);
begin
paintbox1.Canvas.Pen.Color:=colorgrid1.ForegroundColor;
end;

procedure TForm1.paintbox1mousedown(Sender: TObject;button:Tmousebutton;shift:Tshiftstate;x,y:integer);
begin
  isdown:=true;
  if Pencil.down then
    paintbox1.canvas.MoveTo(x,y);
  if line.down then
  begin
     startp.x:=x;
     startp.y:=y;
     endp.x:=x;
     endp.y:=y;
  end;
  if square.down or rsquare.down or circle.down then

  begin
     startp.x:=x;
     startp.y:=y;
     endp.x:=x;
     endp.y:=y;
  end;

  if fsquare.down or frsquare.down or fcircle.down then

  begin
    paintbox1.canvas.brush.color:=colorgrid1.backgroundcolor;
    startp.x:=x;
    startp.y:=y;
    endp.x:=x;
    endp.y:=y;
  end;
end;

procedure TForm1.paintbox1mouseup(Sender: TObject;button:Tmousebutton;shift:Tshiftstate;x,y:integer);
begin
    isdown:=false;
end;

procedure TForm1.paintbox1mousemove(Sender: TObject;shift:Tshiftstate;x,y:integer);
begin
     if isdown then
     begin
       if pencil.down then
           paintbox1.canvas.LineTo(x,y);
       if line.down then
           with paintbox1 do
           begin
            canvas.pen.color:=clwhite;
            canvas.moveto(startp.x,startp.y);
            canvas.LineTo(endp.x,endp.Y);
            canvas.pen.color:=colorgrid1.foregroundcolor;
            canvas.MoveTo(startp.x,startp.Y);
            canvas.LineTo(x,y);
            endp.x:=x;
            endp.Y:=y;
           end;
     end;

     if eraser.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         fillrect(rect(x-10,y-10,x+15,y+15));
       end;
     end;

     if square.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         framerect(rect(startp.x,startp.Y,endp.x,endp.y));
         endp.x:=x;
         endp.Y:=y;
            brush.Color:=colorgrid1.Foregroundcolor;
         framerect(rect(startp.x,startp.Y,endp.x,endp.y));
       end;
     end;

     if fsquare.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         fillrect(rect(startp.x,startp.Y,endp.x,endp.y));
         endp.x:=x;
         endp.Y:=y;
         brush.Color:=colorgrid1.backgroundcolor;
         fillrect(rect(startp.x,startp.Y,endp.x,endp.y));
         brush.Color:=colorgrid1.Foregroundcolor;
         framerect(rect(startp.x,startp.Y,endp.x,endp.y));
       end;
     end;

     if rsquare.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         pen.color:=clwhite;
         roundrect(startp.x,startp.Y,endp.x,endp.y,(startp.x-endp.x)div 2,(startp.y-endp.y)div 2);
         endp.x:=x;
         endp.Y:=y;
         pen.Color:=colorgrid1.Foregroundcolor;
         roundrect(startp.x,startp.Y,endp.x,endp.y,(startp.x-endp.x)div 2,(startp.y-endp.y)div 2);
       end;
     end;

     if frsquare.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         pen.color:=clwhite;
         roundrect(startp.x,startp.Y,endp.x,endp.y,(startp.x-endp.x)div 2,(startp.y-endp.y)div 2);
         endp.x:=x;
         endp.Y:=y;
         pen.Color:=colorgrid1.Foregroundcolor;
         brush.color:=colorgrid1.backgroundcolor;
         roundrect(startp.x,startp.Y,endp.x,endp.y,(startp.x-endp.x)div 2,(startp.y-endp.y)div 2);
       end;
     end;

     if circle.down then
     begin
       with paintbox1.canvas do
       begin
         pen.color:=clwhite;
         arc(startp.x,startp.Y,endp.x,endp.y,startp.x,startp.Y,startp.x,startp.Y);
         endp.x:=x;
         endp.Y:=y;
         pen.Color:=colorgrid1.Foregroundcolor;
         arc(startp.x,startp.Y,endp.x,endp.y,startp.x,startp.Y,startp.x,startp.Y);
       end;
     end;

     if fcircle.down then
     begin
       with paintbox1.canvas do
       begin
         brush.color:=clwhite;
         pen.color:=clwhite;
         ellipse(startp.x,startp.Y,endp.x,endp.y);
         endp.x:=x;
         endp.Y:=y;
         pen.Color:=colorgrid1.Foregroundcolor;
         brush.color:=colorgrid1.backgroundcolor;
         ellipse(startp.x,startp.Y,endp.x,endp.y);
         arc(startp.x,startp.Y,endp.x,endp.y,startp.x,startp.Y,startp.x,startp.Y);
       end;
     end;
end;

procedure TForm1.N1Click(Sender: TObject);
var
  rect:trect;
  filename:string;
begin
  if savedialog1.Execute then
    rect.Left:=0;
    rect.Top:=0;
    rect.Right:=paintbox1.Width;
    rect.Bottom:=paintbox1.Height;
    with tbitmap.Create do
    begin
     try
        width:=rect.right;
        height:=rect.Bottom;
        canvas.CopyRect(rect,paintbox1.canvas,rect);
        filename:=savedialog1.FileName;
        if extractfileext(filename)='' then
        filename:=filename+'.bmp';
        savetofile(filename);
     finally
     free;
    end;
   end;
end;


procedure TForm1.dispalyhint(Sender: TObject);
begin
statusbar1.panels[0].text:=application.Hint;
statusbar1.refresh;
end;
procedure TForm1.oncreate(Sender: TObject);
begin
application.OnHint:=diaplayhint;
end;



end.