unit1.pas.~2~

《Delphi 2005程序设计及其应用开发》源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Borland.Vcl.ExtDlgs, Borland.Vcl.ComCtrls, Borland.Vcl.Menus,
  System.ComponentModel, Borland.Vcl.ExtCtrls, Borland.Vcl.StdCtrls,
  Borland.Vcl.ToolWin, Borland.Vcl.ImgList;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    OpenItem: TMenuItem;
    SaveItem: TMenuItem;
    N1: TMenuItem;
    ExitItem: TMenuItem;
    E1: TMenuItem;
    CutItem: TMenuItem;
    CopyItem: TMenuItem;
    PasteItem: TMenuItem;
    H1: TMenuItem;
    AboutItem: TMenuItem;
    StatusBar1: TStatusBar;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton8: TToolButton;
    ToolButton2: TToolButton;
    ToolButton9: TToolButton;
    ToolButton11: TToolButton;
    Panel2: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Label1: TLabel;
    Label2: TLabel;
    ColorBox1: TColorBox;
    ColorBox2: TColorBox;
    SavePictureDialog1: TSavePictureDialog;
    ImageList1: TImageList;
    Panel3: TPanel;
    PaintBox1: TPaintBox;
    procedure OpenItemClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
    procedure SaveItemClick(Sender: TObject);
    procedure ExitItemClick(Sender: TObject);
    procedure ColorBox2Change(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
  private
    { Private declarations }
    bitmap : TBitmap;
    bDown : Boolean;
    bShape :(cLine, cRect, cRoundRect, cEllipse, cPencil, cFRect, cFRoundRect,
          cFEllipse);          //定义枚举类型的变量
    Startp : TPoint;        //画笔的起点
    Endp : TPoint;          //画笔的终点
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.nfm}

procedure TForm1.OpenItemClick(Sender: TObject);
var
  rect : TRect;
begin
   //通过打开对话框将图形文件加载到位图中
   if OpenpictureDialog1.Execute then
       bitmap.LoadFromFile(OpenpictureDialog1.FileName);
   rect.Left := 0;
   rect.Top := 0;
   rect.Right := PaintBox1.Width;
   rect.Bottom := PaintBox1.Height;
   //将位图中的图像复制到PaintBox1的画板中
   PaintBox1.Canvas.CopyRect(rect,bitmap.Canvas,rect);
end;

//通过PaintBox1组件的OnPaint事件来刷新画板中的图像
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  rect : TRect;
begin
    rect.Left := 0;
    rect.Top := 0;
    rect.Right := PaintBox1.Width;
    rect.Bottom := PaintBox1.Height;
    //将位图中的图像复制到PaintBox1的画板中
    PaintBox1.Canvas.CopyRect(rect,bitmap.Canvas,rect);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 bitmap := TBitmap.Create; //创建bitmap对象，并设置其宽度和高度
 Bitmap.Width := PaintBox1.Width;
 Bitmap.Height := PaintBox1.Height;
 Shape2.Brush.Color:= clBlack;    //通过Shape2组件显示线条颜色
 Shape1.Brush.Color := clWhite;   //通过Shape1组件显示填充颜色
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Startp.X := X;
   Startp.Y := Y;
   Endp.X := X;
   Endp.Y := Y;
   bDown := True;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CPoint : TPoint;
begin
   StatusBar1.Panels[1].Text := InttoStr(X) +','+IntToStr(Y);
   if bDown then
     begin
     CPoint.X := Endp.X;
     CPoint.Y := Endp.Y;
     Endp.X := X;
     Endp.Y := Y;
     begin
      case bShape of
         cLine:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.MoveTo(Startp.X, Startp.Y);
              PaintBox1.Canvas.LineTo(CPoint.X, CPoint.Y);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.MoveTo(Startp.X, Startp.Y);
              PaintBox1.Canvas.LineTo(Endp.X, Endp.Y);
           End;
         cRect:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,CPoint.X, CPoint.Y);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cEllipse:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,CPoint.X, CPoint.Y);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cRoundRect:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,CPoint.X, CPoint.Y,
                    (CPoint.X-Startp.X) div 4, (CPoint.Y-Startp.Y) div 4);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,Endp.X, Endp.Y,
                    (Endp.X-Startp.X) div 4, (Endp.Y-Startp.Y) div 4);
           end;
         cFRect:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.Brush.Color := clWhite;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,CPoint.X, CPoint.Y);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cFEllipse:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;
              PaintBox1.Canvas.Brush.Color := ClWhite;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,CPoint.X, CPoint.Y);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cFRoundRect:
           begin
              PaintBox1.Canvas.Pen.Color := clWhite;	;
              PaintBox1.Canvas.Brush.Color := clWhite;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,CPoint.X, CPoint.Y,
                    (CPoint.X-Startp.X) div 4, (CPoint.Y-Startp.Y) div 4);
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,Endp.X, Endp.Y,
                    (Endp.X-Startp.X) div 4, (Endp.Y-Startp.Y) div 4);
           end;
         CPencil:
           Begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.MoveTo(CPoint.X,CPoint.Y);
              PaintBox1.Canvas.LineTo(Endp.X,Endp.Y);
            End;
         end;
       end;
      end;

end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  rect : TRect;
begin
   Endp.X := X ;
   Endp.Y := Y;
   if bDown then
     begin
       case bShape of
         cLine:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.MoveTo(Startp.X, Startp.Y);
              PaintBox1.Canvas.LineTo(Endp.X, Endp.Y);
           End;
         cRect:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cEllipse:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cRoundRect:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,Endp.X, Endp.Y,
                    (Endp.X-Startp.X) div 4, (Endp.Y-Startp.Y) div 4);
           end;
         cFRect:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.Rectangle(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cFEllipse:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.Ellipse(Startp.X, Startp.Y,Endp.X, Endp.Y);
           end;
         cFRoundRect:
           begin
              PaintBox1.Canvas.Pen.Color := ColorBox1.Selected;
              PaintBox1.Canvas.Brush.Color := ColorBox2.Selected;
              PaintBox1.Canvas.RoundRect(Startp.X, Startp.Y,Endp.X, Endp.Y,
                    (Endp.X-Startp.X) div 4, (Endp.Y-Startp.Y) div 4);
           end;
         end;
         bDown := False;
         rect.Left := 0;
         rect.Top := 0;
         rect.Right := PaintBox1.Width;
         rect.Bottom := PaintBox1.Height;
         Bitmap.Width := PaintBox1.Width;
         Bitmap.Height := PaintBox1.Height;
         bitmap.Canvas.CopyRect(rect, paintBox1.Canvas,rect);
         //PaintBox1.Canvas.Refresh;
   end;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
  bShape := CPencil;
  StatusBar1.Panels[0].Text := '铅笔 ';
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  bShape := CEllipse;
  StatusBar1.Panels[0].Text := '画无填充色的椭圆形 ';
  PaintBox1.Canvas.Brush.Style := bsClear;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
   bShape := CRect;
   StatusBar1.Panels[0].Text := '画无填充色的矩形 ';
   PaintBox1.Canvas.Brush.Style := bsClear;
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
   bShape := CRoundRect;
   StatusBar1.Panels[0].Text := '画无填充色的圆角矩形 ';
   PaintBox1.Canvas.Brush.Style := bsClear;
end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
   bShape := CLine;
   StatusBar1.Panels[0].Text := '画线条 ';
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
   bShape := CFRect;
   StatusBar1.Panels[0].Text := '画带填充色的矩形 ';
   PaintBox1.Canvas.Brush.Style := bsSolid;
end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
   bShape := CFRoundRect;
   StatusBar1.Panels[0].Text := '画带填充色的圆角矩形 ';
   PaintBox1.Canvas.Brush.Style := bsSolid;
end;

procedure TForm1.ToolButton11Click(Sender: TObject);
begin
   bShape := CFEllipse;
   StatusBar1.Panels[0].Text := '画带填充色的椭圆 ';
   PaintBox1.Canvas.Brush.Style := bsSolid;
end;

procedure TForm1.SaveItemClick(Sender: TObject);
var
  rect : TRect;
  myBitmap : TBitmap;
begin
   if SavePictureDialog1.Execute then
   begin
      rect.Left := 0;
      rect.Top := 0;
      rect.Right := PaintBox1.Width;
      rect.Bottom := PaintBox1.Height;
      myBitmap := TBitmap.Create;
      try
        myBitmap.Width := PaintBox1.Width;
        myBitmap.Height := PaintBox1.Height;
        myBitmap.Canvas.CopyRect(rect, paintBox1.Canvas,rect);
        myBitmap.SaveToFile(SavePictureDialog1.FileName);
      finally
        myBitmap.Free;
      end;
   end;
end;

procedure TForm1.ExitItemClick(Sender: TObject);
begin
  Bitmap.Free;
  Close;
end;

procedure TForm1.ColorBox2Change(Sender: TObject);
begin
   Shape1.Brush.Color:= ColorBox2.Selected;
end;

procedure TForm1.ColorBox1Change(Sender: TObject);
begin
   Shape2.Brush.Color:= ColorBox1.Selected;
end;

end.