huatu.txt

在delphi7中实现简单的画图功能并可保存所画图形。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, Buttons;

type
  TdrawingTool=(dtLine,dtRectangle,dtEllipse,dtRounRect);
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    Open: TMenuItem;
    Save: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Image1: TImage;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Splitter1: TSplitter;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure SaveClick(Sender: TObject);
    procedure OpenClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DrawShape(TopLeft,bottomRight:Tpoint;Amode:TPenMode);
  end;

var
  Form1: TForm1;
  DrawingTool:TDrawingTool;
  drawing:boolean;
  origin,movept:Tpoint;

implementation

{$R *.dfm}

procedure Tform1.DrawShape(TopLeft,bottomRight:Tpoint;Amode:TPenMode);
begin
   with image1.Canvas do
   begin
     pen.Mode:=AMode;
     case drawingTool of
        dtline:
        begin
           moveto(topleft.X,topleft.Y);
           lineto(bottomright.X,bottomRight.y);
        end;
      dtRectangle:
           Rectangle(topleft.X,topleft.Y,bottomright.X,bottomright.Y);
      dtEllipse:
           ellipse(topleft.X,topleft.Y,bottomright.X,bottomright.Y);
      dtRounRect:
           RoundRect(topleft.X,topleft.Y,bottomright.X,bottomright.Y,
           (Topleft.X-bottomRight.X)div 2,(topleft.Y-bottomright.Y)div 2);
   end;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    DrawingTool:=dtLine;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
      DrawingTool:=dtRectangle;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
     DrawingTool:=dtRounRect;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
       
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    drawing:=true;
    image1.Canvas.MoveTo(x,y);
    origin:=point(x,y);
    movept:=origin;
    
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if drawing then
       drawshape(origin,point(x,y),pmCopy);
    drawing:=false;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     if drawing then
     begin
      drawshape(origin,movept,pmNotXor);
      movept:=Point(x,y);
      drawshape(origin,movept,pmNotXor);
     end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     form1.Caption:='一个简单的绘图程序';
     with image1 do
     begin
        setbounds(0,0,600,400);
        picture.Graphic:=TBitmap.Create;
        picture.Graphic.Width:=600;
        picture.Graphic.Height:=400;
     end;
end;

procedure TForm1.SaveClick(Sender: TObject);
begin
    if savedialog1.Execute then
       image1.Picture.SaveToFile(savedialog1.filename);
end;

procedure TForm1.OpenClick(Sender: TObject);
begin
     if opendialog1.Execute then
        image1.Picture.LoadFromFile(opendialog1.FileName);
end;

end.