unit1.pas

能够让用户很方便的在自己的程序中写出自己想要的所有的图形来,很实用的.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    ToolBar3: TToolBar;
    ToolBar4: TToolBar;
    ColorGrid1: TColorGrid;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    PaintBox1: TPaintBox;
    PopupMenu1: TPopupMenu;
    SaveDialog1: TSaveDialog;
    N1: TMenuItem;
    procedure ColorGrid1Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure displayhint(sender:Tobject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  IsDown:boolean;
  StartP,endP:Tpoint;
{$R *.dfm}

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

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

  end;
end;

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

end;

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

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

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

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

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

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

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

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

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
IsDown:=true;
if toolbutton2.Down then
  paintbox1.Canvas.MoveTo(x,y);
if toolbutton1.Down then
begin
  startp.X:=x;
  startp.Y:=y;
  endp.X:=x;
  endp.Y:=y;
end;
if toolbutton4.Down or toolbutton8.Down then
begin
  startp.X:=x;
  startp.Y:=y;
  endp.X:=x;
  endp.Y:=y;
end;
if toolbutton5.Down or toolbutton7.Down or toolbutton9.Down then
begin
  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 toolbutton2.Down then
begin
paintbox1.Canvas.LineTo(x,y);
end;
if toolbutton1.Down then
begin
  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 toolbutton3.Down then
begin
with paintbox1.Canvas do
begin
brush.Color:=clwhite;
fillrect(rect(x-10,y-10,x+15,y+15));
end;

end;
if toolbutton4.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 toolbutton5.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 toolbutton6.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 toolbutton7.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 toolbutton8.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 toolbutton9.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;

end;

procedure TForm1.N1Click(Sender: TObject);
var
  rect:Trect;
  filename:string;
begin
if savedialog1.Execute then
begin
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;

end;
procedure Tform1.displayhint(Sender:Tobject);
begin
statusbar1.Panels[0].Text:=application.Hint;
statusbar1.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
application.OnHint:=displayhint;
end;



end.