mainfrm.pas

可以实现简单绘图

unit MainFrm;

interface

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

const
  GRID_SPACE = 16;

type
  TDrawTool = (dtSelect, dtLine, dtRect, dtRoundRect, dtEllipse);

  TMainForm = class(TForm)
    ActionList1: TActionList;
    ImageList1: TImageList;
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    ToolBar2: TToolBar;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolSelectAct: TAction;
    ToolLineAct: TAction;
    ToolRectAct: TAction;
    ToolRoundRectAct: TAction;
    ToolEllipseAct: TAction;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    StatusBar: TStatusBar;
    PaintBox: TPaintBox;
    ToolButton1: TToolButton;
    DeleteAct: TAction;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolSelectActExecute(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure DeleteActExecute(Sender: TObject);
  private
    { Private declarations }
    procedure ShowCursorPos(X, Y: Integer);
    procedure DrawGraphics(ABeginPoint, AEndPoint: TPoint; APenMode: TPenMode);
    procedure CreateGraphics;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  BeginPoint, EndPoint: TPoint; //用来保存画图时起始点坐标和终止的坐标
  DragBeginPoint, DragEndPoint: TPoint; //拖放图形时的起始坐标和终止坐标
  bDrawing: Boolean; //是否正在画图
  bMoving: Boolean; //是否正在移动图形
  bResizing: Boolean; //是否正在改变图形的大小
  curTool: TDrawTool = dtSelect; //当前图形

implementation

{$R *.dfm}

uses
  VectorGraphClassUnit, GraphicsClassUnit;

var
  VectorGraph: TVectorGraph;
  SelectedGraphics: TGraphics; //当前选中的图形

{-------------------- Private --------------------}

procedure TMainForm.ShowCursorPos(X, Y: Integer);
begin
  StatusBar.SimpleText := 'X：' + IntToStr(X) + '    Y：' + IntToStr(Y);
end;

{ 画图形 }
procedure TMainForm.DrawGraphics(ABeginPoint, AEndPoint: TPoint; APenMode: TPenMode);
begin
  with PaintBox.Canvas do
  begin
    Pen.Mode := APenMode;
    case curTool of
      dtLine: { 画直线 }
      begin
        MoveTo(ABeginPoint.X, ABeginPoint.Y);
        LineTo(AEndPoint.X + 1, AEndPoint.Y + 1);
      end;

      dtRect: { 画矩形 }
      begin
        Rectangle(ABeginPoint.X, ABeginPoint.Y, AEndPoint.X + 1, AEndPoint.Y + 1);
      end;

      dtRoundRect: { 画圆角矩形 }
      begin
        RoundRect(ABeginPoint.X, ABeginPoint.Y, AEndPoint.X + 1, AEndPoint.Y + 1,
                  (ABeginPoint.X - AEndPoint.X) div 2,
                  (ABeginPoint.Y - AEndPoint.Y) div 2);
      end;

      dtEllipse: { 画椭圆 }
      begin
        Ellipse(ABeginPoint.X, ABeginPoint.Y, AEndPoint.X + 1, AEndPoint.Y + 1);
      end;
    end;
  end;
end;

procedure TMainForm.CreateGraphics;
var
  tempLine: TLine;
  tempRectangle: TRectangle;
  tempRoundRect: TRoundRect;
  tempEllipse: TEllipse;
begin
  case curTool of
    dtLine:
    begin
      tempLine := TLine.Create(BeginPoint, EndPoint);
      VectorGraph.Add(tempLine);
    end;

    dtRect:
    begin
      tempRectangle := TRectangle.Create(BeginPoint, EndPoint);
      VectorGraph.Add(tempRectangle);
    end;

    dtRoundRect:
    begin
      tempRoundRect := TRoundRect.Create(BeginPoint, EndPoint);
      VectorGraph.Add(tempRoundRect)
    end;

    dtEllipse:
    begin
      tempEllipse := TEllipse.Create(BeginPoint, EndPoint);
      VectorGraph.Add(tempEllipse);
    end;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  VectorGraph := TVectorGraph.Create;
  ScrollBox1.DoubleBuffered := True; //防止画图时闪烁
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  VectorGraph.Free;
end;

procedure TMainForm.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  tempGraphics: TGraphics;
  bSelected: Boolean;
begin
  BeginPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE)); //起点
  EndPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE)); //终点
  bSelected := False;

  { 如果当前选择的工具是选择图形 }
  if curTool = dtSelect then
  begin
    { 如果已选中了一图形，且坐标在图形的选择块中，则开始改变图形的大小 }
    if Assigned(SelectedGraphics) then
    begin
      if SelectedGraphics.PointInResizeControl(Point(X, Y)) then
      begin
        bResizing := True;
        SelectedGraphics.ReSize(PaintBox.Canvas, Point(X, Y));
        Exit;
      end
    end;

    tempGraphics := VectorGraph.GetGraphicsFromPoint(BeginPoint);
    if Assigned(tempGraphics) then
    begin
      { 如果选中了一个图形且不是当前选中的图形，就显中它，并使当前选中的图形不选中 }
      if tempGraphics <> SelectedGraphics then
      begin
        if Assigned(SelectedGraphics) then SelectedGraphics.UnSelect;
        tempGraphics.Select;
        SelectedGraphics := tempGraphics;
        bSelected := True;
      end
      else
        bSelected := True;
    end;

    if bSelected then //如果选中了一个图形，则可以移动该图形
    begin
      bMoving := True;
      Screen.Cursor := crSizeAll;
      DragBeginPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
      DragEndPoint:= Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
    end
    else if Assigned(SelectedGraphics) then //否则，如果当前有选中图形，则使它为不中状态
    begin
      SelectedGraphics.UnSelect;
      SelectedGraphics := nil;
    end;
    
    PaintBox.Invalidate;
  end
  else begin
    bDrawing := True;
  end;
end;

procedure TMainForm.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ShowCursorPos(X, Y);
  Application.ProcessMessages;
  
  if curTool = dtSelect then
  begin
    if bResizing then //改变图形的大小
    begin
      SelectedGraphics.ReSize(PaintBox.Canvas, Point(X - X mod GRID_SPACE, Y - Y mod GRID_SPACE));
      Exit;
    end;

    if bMoving then //移动图形
    begin
      DragEndPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
      SelectedGraphics.Move(PaintBox.Canvas,
                          DragEndPoint.X - DragBeginPoint.X,
                          DragEndPoint.Y - DragBeginPoint.Y);
      DragBeginPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
      Exit;
    end;

    { 如果有选中图形，就判断光标是否在图形的选择块上，如果是则改变光标 }
    if Assigned(SelectedGraphics) then
      if SelectedGraphics.PointInResizeControl(Point(X, Y)) then
      begin
        Screen.Cursor := SelectedGraphics.GetResizeCursor(Point(X,Y));
        Exit;
      end;

    { 判断鼠标是否在图形上，如果是，则改变光标 }
    if Assigned(VectorGraph.GetGraphicsFromPoint(Point(X, Y))) then
      Screen.Cursor := crHandPoint
    else
      Screen.Cursor := crDefault;
  end
  else if bDrawing then
  begin
    DrawGraphics(BeginPoint, EndPoint, pmNotXor);
    EndPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
    DrawGraphics(BeginPoint, EndPoint, pmNotXor);
  end;
end;

procedure TMainForm.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  { 如果是画图形时松开鼠标，则生成新的图形对象 }
  if bDrawing then
  begin
    DrawGraphics(BeginPoint, EndPoint, pmNotXor);
    EndPoint := Point((X - X mod GRID_SPACE), (Y - Y mod GRID_SPACE));
    DrawGraphics(BeginPoint, EndPoint, pmCopy);
    CreateGraphics;
  end
  { 如果是移动图形时或改变图形大小时松开鼠标，则重画 }
  else if bMoving or bResizing then
    PaintBox.Invalidate;

  bMoving := False;
  bDrawing := False;
  bResizing := False;
end;

procedure TMainForm.ToolSelectActExecute(Sender: TObject);
begin
  curTool := TDrawTool(TComponent(Sender).Tag);

  if curTool = dtSelect then
    PaintBox.Cursor := crDefault
  else
    PaintBox.Cursor := crCross;
end;

procedure TMainForm.PaintBoxPaint(Sender: TObject);
var
  i, j: Integer;
  iRowCount, iColCount: Integer;
begin
  with PaintBox do
  begin
    iRowCount := Height div GRID_SPACE;
    iColCount := Width div GRID_SPACE;
    for i := 0 to iRowCount do
      for j := 0 to iColCount do
        Canvas.Pixels[j * GRID_SPACE, i * GRID_SPACE] := clGreen;
  end;
  VectorGraph.Paint(PaintBox.Canvas);
end;

procedure TMainForm.DeleteActExecute(Sender: TObject);
begin
  VectorGraph.DeleteSelection;
  SelectedGraphics := nil;
  PaintBox.Invalidate;
end;

end.