unit1.pas

这个是个DELPHI绘图软件

unit Unit1;

interface

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

type
  TDrawingTool = (dtLine,dtEllipse,dtRectangle,dtRoundrect);
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    solidepen: TSpeedButton;
    dashdotdotpen: TSpeedButton;
    dashpen: TSpeedButton;
    dotpen: TSpeedButton;
    dashdotpen: TSpeedButton;
    clearpen: TSpeedButton;
    solidebrush: TSpeedButton;
    clearbrush: TSpeedButton;
    hbrush: TSpeedButton;
    vbrush: TSpeedButton;
    fd: TSpeedButton;
    bd: TSpeedButton;
    crossbrush: TSpeedButton;
    dcrossbrush: TSpeedButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    ColorDialog1: TColorDialog;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SavePictureDialog1: TSavePictureDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    PrintDialog1: TPrintDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ColorGrid1: TColorGrid;
    Image1: TImage;
    N14: TMenuItem;
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    Panel6: TPanel;
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Setpenstyle(Sender: TObject);
    procedure Setbrushstyle(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure DrawShape(StartPoint,EndPoint:TPoint;AMode:TPenMode);
  end;

var
  Form1: TForm1;
  Drawing:Boolean;
  Origin:TPoint;
  MovePt:TPoint;
  DrawingTool:TDrawingTool;
  CurrentFile:String;
  Printer:TPrinter;

implementation

uses Unit2,Clipbrd,JPEG;

{$R *.dfm}

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.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.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.SpeedButton5Click(Sender: TObject);
begin
  DrawingTool:=dtLine;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
  DrawingTool:=dtEllipse;
end;

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

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
  DrawingTool:=dtRoundRect;
end;
procedure TForm1.DrawShape(StartPoint,EndPoint:TPoint;AMode:TpenMode);
begin
  with image1.Canvas do
    begin
      Pen.Mode:=AMode;
      case DrawingTool of
        dtLine:
          begin
            Image1.Canvas.MoveTo(StartPoint.X,StartPoint.Y);
            Image1.Canvas.LineTo(EndPoint.X,EndPoint.Y);
          end;
        dtEllipse:image1.Canvas.Ellipse(StartPoint.X,StartPoint.Y,
          EndPoint.X,EndPoint.Y);
        dtRectangle:image1.Canvas.Rectangle(StartPoint.X,Startpoint.Y,
          endpoint.X,endpoint.Y);
        dtRoundRect:image1.Canvas.RoundRect(Startpoint.X,startpoint.Y,
          endpoint.X,endpoint.Y,(startpoint.x-endpoint.x) div 2,
          (startpoint.y-endpoint.y) div 2);
    end;
  end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  colorDialog1.Color:=image1.Canvas.Pen.Color;
  if  colordialog1.Execute then
    image1.Canvas.Pen.Color:=colordialog1.Color;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  colorDialog1.Color:=image1.Canvas.Brush.Color;
  if  colordialog1.Execute then
    image1.Canvas.Brush.Color:=colordialog1.Color;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Panel4.Visible:=true;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  Panel5.Visible:=true;
end;

procedure TForm1.Setpenstyle(Sender: TObject);
begin
  with image1.Canvas.Pen do
  begin
    if Sender=solidepen then Style:=psSolid
    else if Sender=clearpen then Style:=psClear
    else if Sender=dashpen then Style:=psdash
    else if Sender=dotpen then Style:=psDot
    else if Sender=dashdotpen then Style:=psDashDot
    else if Sender=dashdotdotpen then Style:=psDashDotDot;
  end;
end;

procedure TForm1.Setbrushstyle(Sender: TObject);
begin
  with image1.Canvas.Brush do
    begin
      if  Sender=clearbrush then Style:=bsClear
      else if Sender=solidebrush then Style:=bsSolid
      else if Sender=hbrush then Style:=bsHorizontal
      else if Sender=vbrush then Style:=bsvertical
      else if Sender=fd then Style:=bsFDiagonal
      else if Sender=bd then Style:=bsBDiagonal
      else if Sender=crossbrush then Style:=bsCross
      else if Sender=dcrossbrush then Style:=bsDiagCross;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap:TBitmap;
begin
  Bitmap:=nil;
  try
    Bitmap:=TBitmap.Create;
    Bitmap.Width:=560;
    Bitmap.Height:=439;
    image1.Picture.Graphic:=Bitmap;
  finally
    Bitmap.Free;
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  FormCreate(sender);
end;

procedure TForm1.N14Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    CurrentFile:=OpenPictureDialog1.FileName;
    image1.Picture.LoadFromFile(CurrentFile);
  end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  if  CurrentFile<>EmptyStr then
    image1.Picture.SaveToFile(CurrentFile)
  else N4Click(Sender);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  if  SavePictureDialog1.Execute then
  begin
    CurrentFile:=SavePictureDialog1.FileName;
    N3Click(Sender);
  end;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  if  PrintDialog1.Execute then
    Printer.BeginDoc;
    printer.Canvas.Draw(image1.Left,image1.Top,image1.Picture.Graphic);
    printer.EndDoc;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  Close;
end;



procedure TForm1.N12Click(Sender: TObject);
begin
  statusbar1.Visible:=True;
  statusbar1.Panels[0].Text:='尺寸：' +
    Format('(%d × %d)',[image1.Picture.Height,image1.Picture.Width]);
  statusbar1.Panels[1].Text:=
    ExtractFilePath(OpenPictureDialog1.FileName)+
    ExtractFileName(OpenPictureDialog1.FileName);
end;

procedure TForm1.N13Click(Sender: TObject);
begin
  form2.ShowModal;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  Clipboard.Assign(Image1.Picture);
end;

procedure TForm1.N9Click(Sender: TObject);
var
  ARect:TRect;
begin
 N8Click(Sender);
  with image1.Canvas do
    begin
      CopyMode:=cmWhiteness;
      ARect:=Rect(0,0,image1.Width,image1.Height);
      CopyRect(ARect,image1.Canvas,ARect);
      CopyMode:=cmSrcCopy;
    end;
end;

procedure TForm1.N10Click(Sender: TObject);
var
  Bitmap:TBitmap;
begin
  if Clipboard.HasFormat(CF_BITMAP) then
    begin
      Bitmap:=TBitmap.Create;
      try
        Bitmap.Assign(Clipboard);
        image1.Canvas.Draw(0,0,Bitmap);
      finally
        Bitmap.Free;
      end;
    end;
end;

procedure TForm1.ColorGrid1Change(Sender: TObject);
begin
  image1.Canvas.Pen.Color:=ColorGrid1.ForegroundColor;
  image1.Canvas.Brush.Color:=ColorGrid1.BackgroundColor;
end;

end.