unit6_21.~pas

一款简简单单的绘图软件 简单的不能再简单了 供那些初学者用来看一看 长长见识用吧

unit Unit6_21;

interface

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

const MAX_STEPS = 6;

type
  TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  TForm1 = class(TForm)
    Panel1: TPanel;
    LineButton: TSpeedButton;
    RectangleButton: TSpeedButton;
    EllipseButton: TSpeedButton;
    RoundRectButton: TSpeedButton;
    PenButton: TSpeedButton;
    BrushButton: TSpeedButton;
    PenBar: TPanel;
    BrushBar: TPanel;
    SolidPen: TSpeedButton;
    DashPen: TSpeedButton;
    DotPen: TSpeedButton;
    DashDotPen: TSpeedButton;
    DashDotDotPen: TSpeedButton;
    ClearPen: TSpeedButton;
    PenWidth: TUpDown;
    PenSize: TEdit;
    StatusBar1: TStatusBar;
    ScrollBox1: TScrollBox;
    Image: TImage;
    SolidBrush: TSpeedButton;
    ClearBrush: TSpeedButton;
    HorizontalBrush: TSpeedButton;
    VerticalBrush: TSpeedButton;
    FDiagonalBrush: TSpeedButton;
    BDiagonalBrush: TSpeedButton;
    CrossBrush: TSpeedButton;
    DiagCrossBrush: TSpeedButton;
    PenColor: TSpeedButton;
    BrushColor: TSpeedButton;
    ColorDialog1: TColorDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    Print1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LineButtonClick(Sender: TObject);
    procedure RectangleButtonClick(Sender: TObject);
    procedure EllipseButtonClick(Sender: TObject);
    procedure RoundRectButtonClick(Sender: TObject);
    procedure PenButtonClick(Sender: TObject);
    procedure BrushButtonClick(Sender: TObject);
    procedure SetPenStyle(Sender: TObject);
    procedure PenSizeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SetBrushStyle(Sender: TObject);
    procedure PenColorClick(Sender: TObject);
    procedure BrushColorClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    BrushStyle: TBrushStyle;
    PenStyle: TPenStyle;
    PenWide: Integer;
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    DrawingTool: TDrawingTool;
    CurrentFile: string;
    procedure SaveStyles;
    procedure RestoreStyles;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  end;

  TDrawSteps = class(TObject)
    OriginalVertexes: array[1..MAX_STEPS] of TPoint;
    MoveVertexes: array[1..MAX_STEPS] of TPoint;
    DrawingTools: array[1..MAX_STEPS] of TDrawingTool;
    CurrentStep: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddStep(OriginalPoint, MovePoint: TPoint; DrawingTool: TDrawingTool);
    procedure RemoveStep();
  end;

var
  Form1: TForm1;
  DrawSteps: TDrawSteps;
implementation

uses Unit6_22, Clipbrd, Printers;

{$R *.DFM}

constructor TDrawSteps.Create;
begin
  CurrentStep := 0;
end;

destructor TDrawSteps.Destroy;
begin

end;

procedure TDrawSteps.AddStep(OriginalPoint, MovePoint: TPoint; DrawingTool: TDrawingTool);
var I: Integer;
begin
  if CurrentStep < MAX_STEPS then
  begin
    CurrentStep := CurrentStep + 1;
    OriginalVertexes[CurrentStep] := OriginalPoint;
    MoveVertexes[CurrentStep] := MovePoint;
    DrawingTools[CurrentStep] := DrawingTool;
  end
  else
  begin
    for I := 1 to MAX_STEPS - 1 do
    begin
      OriginalVertexes[I] := OriginalVertexes[I + 1];
      MoveVertexes[I] := MoveVertexes[I + 1];
      DrawingTools[I] := DrawingTools[I + 1];
    end;
    CurrentStep := MAX_STEPS;
    OriginalVertexes[CurrentStep] := OriginalPoint;
    MoveVertexes[CurrentStep] := MovePoint;
    DrawingTools[CurrentStep] := DrawingTool;
  end;
end;

procedure TDrawSteps.RemoveStep;
begin
  if CurrentStep > 0 then
    CurrentStep := CurrentStep - 1;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // 按下鼠标左键，取得要绘制图形的起点
  Drawing := True;

  Image.Canvas.MoveTo(X, Y);
  Origin := Point(X, Y);  // 获取要绘制图形的起点

  MovePt := Origin;
  StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // 放开左键，确定绘制图形终点
  if Drawing then
  begin
    DrawShape(Origin, Point(X, Y), pmCopy);  //pmCopy表示使用Color属性中的颜色
    Drawing := False;
    DrawSteps.AddStep(Origin, Point(X, Y), DrawingTool);
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  // 鼠标一动就开始画，不过必须要一直按下鼠标左键
  if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor); //pmNotXor指画笔模式为画笔颜色与背景颜色Xor后的Not值
    //若所画区域背景为00(黑色，即原先以画过图案)，画笔颜色为00，Xor后为11，再Not后为00(白色)，实现了原先画的图案的消除
    MovePt := Point(X, Y);
    DrawShape(Origin, MovePt, pmNotXor);
    //若所画区域背景为11(白色)，画笔颜色为00，Xor后为11，再Not后为00，即画上了黑色的图案
  end;
  StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
end;

procedure TForm1.LineButtonClick(Sender: TObject);
begin
  DrawingTool := dtLine;
  // 将画具设为画线用
end;

procedure TForm1.RectangleButtonClick(Sender: TObject);
begin
  DrawingTool := dtRectangle;
  // 将画具设为画方形用
end;

procedure TForm1.EllipseButtonClick(Sender: TObject);
begin
  DrawingTool := dtEllipse;
  // 将画具设为画圆形用
end;

procedure TForm1.RoundRectButtonClick(Sender: TObject);
begin
  DrawingTool := dtRoundRect;
  // 将画具设为画圆角方形用
end;

procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  // 根据DrawingTool变量设置的画具种类，调用对应的绘图方法，像
  // LineTo(画线)、Rectangle(画方形)、Ellipse(画椭圆形)、RoundRect(画
  // 圆角方形)。
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    case DrawingTool of
      dtLine:
        begin
          Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
          Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
        end;
      dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtEllipse: Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtRoundRect: Image.Canvas.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.PenButtonClick(Sender: TObject);
begin
  PenBar.Visible := PenButton.Down;
end;

procedure TForm1.BrushButtonClick(Sender: TObject);
begin
  BrushBar.Visible := BrushButton.Down;
end;

procedure TForm1.SetPenStyle(Sender: TObject);
begin
  // 线条类型的设置(如实线、虚线*..等)
  with Image.Canvas.Pen do
  begin
    if Sender = SolidPen then Style := psSolid
    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
    else if Sender = ClearPen then Style := psClear;
  end;
end;

procedure TForm1.PenSizeChange(Sender: TObject);
begin
  // 改变画笔宽度，即画出来的线条宽度
  Image.Canvas.Pen.Width := PenWidth.Position;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.Width := 400;
  Bitmap.Height := 400;
  Image.Picture.Graphic := Bitmap;
  DrawSteps := TDrawSteps.Create;
end;

procedure TForm1.SetBrushStyle(Sender: TObject);
begin
  // 设置笔刷的类系(如填实、清除、填横线、填直线*..等)
  with Image.Canvas.Brush do
  begin
    if Sender = SolidBrush then Style := bsSolid
    else if Sender = ClearBrush then Style := bsClear
    else if Sender = HorizontalBrush then Style := bsHorizontal
    else if Sender = VerticalBrush then Style := bsVertical
    else if Sender = FDiagonalBrush then Style := bsFDiagonal
    else if Sender = BDiagonalBrush then Style := bsBDiagonal
    else if Sender = CrossBrush then Style := bsCross
    else if Sender = DiagCrossBrush then Style := bsDiagCross;
  end;
end;

procedure TForm1.PenColorClick(Sender: TObject);
begin
  // 设置画笔颜色
  ColorDialog1.Color := Image.Canvas.Pen.Color;
  if ColorDialog1.Execute then
    Image.Canvas.Pen.Color := ColorDialog1.Color;
end;

procedure TForm1.BrushColorClick(Sender: TObject);
begin
  // 设置笔刷颜色，也就是填入范围的颜色
  ColorDialog1.Color := Image.Canvas.Brush.Color;
  if ColorDialog1.Execute then
    Image.Canvas.Brush.Color := ColorDialog1.Color;
end;

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

procedure TForm1.Open1Click(Sender: TObject);
begin
  // 打开OpenDialog对话框，打开图形文件加载画布上(Image1)
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.FileName;
    SaveStyles;
    Image.Picture.LoadFromFile(CurrentFile);
    RestoreStyles;
  end;
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
  // 将画布上的图形，存成另一个新的BMP文件
  if CurrentFile <> EmptyStr then
    Image.Picture.SaveToFile(CurrentFile)
  else SaveAs1Click(Sender);
end;

procedure TForm1.Saveas1Click(Sender: TObject);
begin
  // 将画布上的图形，存回原先的旧图形文件
  if SaveDialog1.Execute then
  begin
    CurrentFile := SaveDialog1.FileName;
    Save1Click(Sender);
  end;
end;

procedure TForm1.New1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  // 打开另一个Form，用来设置新画布(Image1)的大小
  with NewBMPForm do
  begin
    ActiveControl := WidthEdit;
    WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
    HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
    if ShowModal <> idCancel then
    begin
      Bitmap := TBitmap.Create;
      Bitmap.Width := StrToInt(WidthEdit.Text);
      Bitmap.Height := StrToInt(HeightEdit.Text);
      SaveStyles;
      Image.Picture.Graphic := Bitmap;
      RestoreStyles;
      CurrentFile := EmptyStr;
    end;
  end;
  DrawSteps.CurrentStep := 0;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  // 将系统剪贴簿上的图形，复制到画布上(Image1)
  Clipboard.Assign(Image.Picture);
end;

procedure TForm1.Cut1Click(Sender: TObject);
var
  ARect: TRect;
begin
  // 将画布上的图形(Image1)，剪到系统的剪贴簿上
  Copy1Click(Sender);
  with Image.Canvas do
  begin
    CopyMode := cmWhiteness;
    ARect := Rect(0, 0, Image.Width, Image.Height);
    CopyRect(ARect, Image.Canvas, ARect);
    CopyMode := cmSrcCopy;
  end;
end;

procedure TForm1.Paste1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  // 将系统剪贴簿上的图形，贴到画布上(Image1)
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Assign(Clipboard);
      Image.Canvas.Draw(0, 0, Bitmap);
    finally
      Bitmap.Free;
    end;
  end;
end;

procedure TForm1.SaveStyles;
begin
  with Image.Canvas do
  begin
    BrushStyle := Brush.Style;
    PenStyle := Pen.Style;
    PenWide := Pen.Width;
  end;
end;

procedure TForm1.RestoreStyles;
begin
  with Image.Canvas do
  begin
    Brush.Style := BrushStyle;
    Pen.Style := PenStyle;
    Pen.Width := PenWide;
  end;
end;

procedure TForm1.Print1Click(Sender: TObject);
begin
   // 将画布上的图形，透过TPrinter组件输出到打印机打印出来。
   Printer.BeginDoc;
   Printer.Canvas.CopyRect(Image.ClientRect, Image.Canvas,Image.ClientRect);
   Printer.EndDoc;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift = [ssCtrl] then
    if Key = Ord('Z') then
    begin
      if DrawSteps.CurrentStep > 0 then
      begin
        DrawShape(DrawSteps.OriginalVertexes[DrawSteps.CurrentStep],
                DrawSteps.MoveVertexes[DrawSteps.CurrentStep], pmNotXor);
        DrawSteps.RemoveStep;
        if DrawSteps.CurrentStep > 0 then
          DrawShape(DrawSteps.OriginalVertexes[DrawSteps.CurrentStep],
                  DrawSteps.MoveVertexes[DrawSteps.CurrentStep], pmCopy);
      end;
    end;
end;

end.