delphi 计算器 入门级示例

【例子介绍】
【相关图片】
【源码结构】

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons,
  Vcl.ComCtrls;

type
  //TDayofWeek = (Sunday, Monday, Tue);
  TDrawType = (dtLine, dtCircle, dtRect);  // Enum, 枚举
  TForm1 = class(TForm)
    Panel1: TPanel;
    btnLine: TButton;
    btnCircle: TButton;
    btnRect: TButton;
    Panel2: TPanel;
    Panel3: TPanel;
    PaintBox1: TPaintBox;
    Memo1: TMemo;
    btnPenColor: TBitBtn;
    btnBrushColor: TBitBtn;
    dlgColor: TColorDialog;
    TrackBar1: TTrackBar;
    lblPenColor: TLabel;
    clrboxPen: TColorBox;
    lblBrushColor: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    clrboxBrush: TColorBox;
    cmbBrushStyle: TComboBox;
    procedure btnLineClick(Sender: TObject);
    procedure btnCircleClick(Sender: TObject);
    procedure btnRectClick(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TrackBar1Change(Sender: TObject);
    procedure clrboxPenChange(Sender: TObject);
    procedure cmbBrushStyleChange(Sender: TObject);
    procedure clrboxBrushChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ptStart, ptLast, ptEnd : TPoint;
  DrawType: TDrawType;
  isDrawing: Boolean;
  PenColor, BrushColor: TColor;
  BrushStyle: TBrushStyle;
implementation

{$R *.dfm}

procedure TForm1.btnCircleClick(Sender: TObject);
begin
  DrawType:= dtCircle;
  Memo1.Lines.Add(TimeToStr(Now) ': 画椭圆');
  Memo1.Lines.Add('按住Shift键画圆');
end;

procedure TForm1.btnLineClick(Sender: TObject);

begin
  DrawType := dtLine;
  Memo1.Lines.Add(TimeToStr(Now) ': 画直线');
end;

procedure TForm1.btnRectClick(Sender: TObject);
begin
  DrawType:=dtRect;
  Memo1.Lines.Add(TimeToStr(Now) ': 画矩形');
  Memo1.Lines.Add('按住Shift键画正方形');
end;

procedure TForm1.clrboxBrushChange(Sender: TObject);
begin
  BrushColor:=clrboxBrush.Selected;
  PaintBox1.Canvas.Brush.Color:=BrushColor;
end;

procedure TForm1.clrboxPenChange(Sender: TObject);
begin
    PenColor:=clrboxPen.Selected;
    PaintBox1.Canvas.Pen.Color:=PenColor;
end;

procedure TForm1.cmbBrushStyleChange(Sender: TObject);
begin
  BrushStyle:= TBrushStyle(cmbBrushStyle.ItemIndex);
  PaintBox1.Canvas.Brush.Style := BrushStyle;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  isDrawing:=False;
  PenColor:=PaintBox1.Canvas.Pen.Color;
  BrushColor:=PaintBox1.Canvas.Brush.Color;
  BrushStyle:=PaintBox1.Canvas.Brush.Style;
  TrackBar1Change(Sender);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //开始画图
  isDrawing:=True;
  //记录ptStart, ptLast
  ptStart.X:=X;
  ptStart.Y:=Y;
  Memo1.Lines.Add(Format('起点：(%d,%d)',[x,y]));

  ptLast:=ptStart;

end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var deltaX, deltaY : integer;
begin
  if not isDrawing then Exit;

  //计算ptEnd的值 //如果用户按着Shift，则要画正圆和正方形
  if (ssShift in Shift) then
  begin
    deltaX:= X - ptStart.X;
    deltaY:= Y - ptStart.Y;
    if deltaX > deltaY then  // x 方向比较长， 缩短它
    begin
      ptEnd.X:= ptStart.X deltaY;
      ptEnd.Y:= Y;
    end else begin           // y 方向比较长， 缩短它
      ptEnd.Y:= ptStart.Y deltaX;
      ptEnd.X:= X;
    end;

  end else begin            // 没有按住Shift键， 该咋画咋画
    ptEnd.X:=X;
    ptEnd.Y:=Y;
  end;
  //输出信息
  if (ptEnd.X<>X) and (ptEnd.Y<>Y) then
  begin
    Memo1.Lines.Add(Format('实际X,Y=%d,%d',[X,Y]));
    Memo1.Lines.Add(Format('ptEnd  =%d,%d',[ptEnd.X,ptEnd.Y]));
  end;

  //橡皮筋效果
  PaintBox1.Canvas.Pen.Mode:=pmNotXor;
  //橡皮筋之前，保存旧的BrushStyle
  BrushStyle:= PaintBox1.Canvas.Brush.Style;
  //PaintBox1.Canvas.Brush.Style:=bsClear;  有问题
  case DrawType of
  dtLine:
    begin
      // Clear the last graph
      PaintBox1.Canvas.MoveTo(ptStart.X, ptStart.Y);
      PaintBox1.Canvas.LineTo(ptLast.X, ptLast.Y);
      // Draw new graph
      PaintBox1.Canvas.MoveTo(ptStart.X, ptStart.Y);
      PaintBox1.Canvas.LineTo(ptEnd.X, ptEnd.Y);
    end;
  dtCircle:
    begin
      PaintBox1.Canvas.Ellipse(ptStart.X, ptStart.Y, ptLast.X, ptLast.Y);
      PaintBox1.Canvas.Ellipse(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y);
    end;
  dtRect:
    begin
      PaintBox1.Canvas.Rectangle(ptStart.X, ptStart.Y, ptLast.X, ptLast.Y);
      PaintBox1.Canvas.Rectangle(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y);
    end;

  end;
  //更新ptLast， 重要！！！
  ptLast.X:= ptEnd.X;
  ptLast.Y:= ptEnd.Y;
  //恢复BrushStyle
  PaintBox1.Canvas.Brush.Style:=BrushStyle;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add(Format('当前位置：(%d,%d)',[x,y]));
  Memo1.Lines.Add(Format('终点：(%d,%d)',[ptEnd.X, ptEnd.Y]));

  isDrawing:= False;    //结束画图状态
  PaintBox1.Canvas.Pen.Mode:= pmCopy;
  //画最终图形之前，恢复保存的BrushStyle
  PaintBox1.Canvas.Brush.Style:=BrushStyle;

  //画最终的图形
  //输出最终图形的坐标信息
  if (ptEnd.X<>X) and (ptEnd.Y<>Y) then
  begin
    Memo1.Lines.Add(Format('@MouseUp, 实际X,Y=%d,%d',[X,Y]));
    Memo1.Lines.Add(Format('@MouseUp, ptEnd  =%d,%d',[ptEnd.X,ptEnd.Y]));
  end;

  case DrawType of
  dtLine:
    begin
      PaintBox1.Canvas.MoveTo(ptStart.X,ptStart.Y);
      PaintBox1.Canvas.LineTo(ptEnd.X, ptEnd.Y);
    end;
  dtCircle:
    begin
      PaintBox1.Canvas.Ellipse(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y);
    end;
  dtRect:
    begin
      PaintBox1.Canvas.Rectangle(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y);
    end;
  end;

end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  PaintBox1.Canvas.Pen.Width:=TrackBar1.Position;
  lblPenColor.Caption:='画笔宽度 ' IntToStr(TrackBar1.Position);
end;

end.