unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, Buttons, ComCtrls, StdCtrls;
type
tdrawingtool=(dtline,dtrectangle,dtellipse,dtroundrect);
TForm1 = class(TForm)
MainMenu1: TMainMenu;
file1: TMenuItem;
open1: TMenuItem;
save1: TMenuItem;
saveas1: TMenuItem;
frint1: TMenuItem;
exit1: TMenuItem;
edit1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
shape: TPanel;
brush: TPanel;
lineButton: TSpeedButton;
rectangleButton: TSpeedButton;
ellipseButton: TSpeedButton;
roundrectButton: TSpeedButton;
penButton: TSpeedButton;
brushButton: TSpeedButton;
erasebutton: TSpeedButton;
solidpen: TSpeedButton;
dashpen: TSpeedButton;
dotpen: TSpeedButton;
dashdotpen: TSpeedButton;
dashdotdotpen: TSpeedButton;
clearpen: TSpeedButton;
pencolor: TSpeedButton;
solidbrush: TSpeedButton;
clearbrush: TSpeedButton;
verticalbrush: TSpeedButton;
horizontalbrush: TSpeedButton;
fdiagonalbrush: TSpeedButton;
bdiagonalbrush: TSpeedButton;
crossbrush: TSpeedButton;
diagcrossbrush: TSpeedButton;
pen: TPanel;
Label1: TLabel;
Label2: TLabel;
pensize: TEdit;
penwidth: TUpDown;
Image1: TImage;
ColorDialog1: TColorDialog;
StatusBar1: TStatusBar;
brushcolor: TSpeedButton;
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 erasebuttonClick(Sender: TObject);
procedure setpenstyle(Sender: TObject);
procedure pencolorClick(Sender: TObject);
procedure pensizeChange(Sender: TObject);
procedure setbrushstyle(Sender: TObject);
procedure brushcolorClick(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
originpencolor:tcolor;
originpenwidth:integer;
drawing:boolean;
origin,movept:tpoint;
drawingtool:tdrawingtool;
{ Public declarations }
procedure drawshape(topleft,bottomright:tpoint;amode:tpenmode);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.setpenstyle(Sender: TObject);
begin
with image1.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.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.penButtonClick(Sender: TObject);
begin
pen.Visible:=penbutton.Down;
end;
procedure TForm1.brushButtonClick(Sender: TObject);
begin
brush.Visible:=brushbutton.Down;
end;
procedure TForm1.erasebuttonClick(Sender: TObject);
begin
if erasebutton.Down=true then
begin
image1.Cursor:=crcross;
originpencolor:=image1.canvas.pen.color;
originpenwidth:=image1.canvas.pen.width;
image1.canvas.pen.color:=clwhite;
image1.canvas.pen.width:=10;
end
else
begin
image1.Cursor:=crdefault;
image1.Canvas.Pen.Color:=originpencolor;
image1.Canvas.Pen.width:=originpenwidth;
end;
end;
procedure TForm1.pencolorClick(Sender: TObject);
begin
colordialog1.color:= image1.Canvas.Pen.Color;
if colordialog1.execute then
image1.Canvas.Pen.Color:=colordialog1.Color;
end;
procedure TForm1.pensizeChange(Sender: TObject);
begin
image1.Canvas.Pen.Width:=strtoint(pensize.Text);
end;
procedure TForm1.setbrushstyle(Sender: TObject);
begin
with image1.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.brushcolorClick(Sender: TObject);
begin
colordialog1.color:= image1.Canvas.brush.Color ;
if colordialog1.execute then
image1.Canvas.brush.Color:=colordialog1.Color;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
drawing:=true;
image1.Canvas.MoveTo(x,y);
origin:=point(x,y);
movept:=origin;
statusbar1.Panels[0].Text:=format('起点
![Frown :( :(](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f641.png)
%d,%d)',[x,y]);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if drawing then
if erasebutton.Down=true then
begin
image1.Canvas.LineTo(x,y);
image1.Canvas.moveTo(x,y);
end
else
begin
drawshape(origin,movept,pmnotxor);
movept:=point(x,y);
drawshape(origin,movept,pmnotxor);
end ;
statusbar1.Panels[1].Text:=format('当前位置
![Frown :( :(](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f641.png)
%d,%d)',[x,y]);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if drawing then
begin
if erasebutton.Down=false then
drawshape(origin,point(x,y),pmcopy);
drawing:=false;
end;
end;
procedure TForm1.drawshape(topleft,bottomright:tpoint;amode:tpenmode);
begin
with Image1.canvas do
begin
pen.mode:=amode;
case drawingtool of
dtline:
begin
image1.Canvas.MoveTo(topleft.X,topleft.y);
image1.Canvas.lineTo(bottomright.X,bottomright.y);
end;
dtrectangle:
image1.Canvas.Rectangle(topleft.X,topleft.y,bottomright.X,bottomright.y);
dtellipse:
image1.Canvas.ellipse(topleft.X,topleft.y,bottomright.X,bottomright.y);
dtroundrect:
image1.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;
end.