谁能给一个简单的图形编辑软件,能画图的那种 ( 积分: 100 )

  • 主题发起人 主题发起人 waterspace
  • 开始时间 开始时间
W

waterspace

Unregistered / Unconfirmed
GUEST, unregistred user!
我现在在做一个绘图程序,但是一点头绪也没有。我是新手,没弄过这方面的东西。求一个简单的图形编辑软件代码,不用太难的
为防止意外,该贴50分,给代码的另开贴给300分。邮箱waterspace@163.com
 
我现在在做一个绘图程序,但是一点头绪也没有。我是新手,没弄过这方面的东西。求一个简单的图形编辑软件代码,不用太难的
为防止意外,该贴50分,给代码的另开贴给300分。邮箱waterspace@163.com
 
还是请看:
http://www.codeidea.com
 
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('起点:(%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('当前位置:(%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.
 
前段时间出差了。这个程序好象不能用吧?我怎么试也试不出来。谁能给一个啊
 
http://www.devn.org/Project.php?ProjectId=37
 
不要用第三方控件的
 
到邮箱里去看看吧,是不是你想要的。
 
如果这个没有用第三方控件的话就可以。可以把完整的源程序发给我吗?发了跟下帖,收到立刻给分
 
没有用第三方控件的
 
jiabs到这个帖领分吧,谢谢了
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3119315
 
给我发一个好吗,现在也正想要呀.
 
给我发一个好吗,我也要用呀.
 
jiabs,你好,如果你看到这个贴的话,能不能给我也发一个呀.我找了好多地方,也想要用一个这个能画简单的图片的画图程序.要求能加入文字.发了就给通知给我,我给分你.
 
sxwy你是说能够加入文本的简单的画图程序吗?我倒是有,但是那是一个朋友给的,我答应他不往外传的。
不过你如果要waterspace的那一种,我倒是可以发给你一份。
 
jiabs,你好,能不能跟你朋友说一下,再给我一份,或者把你朋友的联系方式告诉我一下,让我跟它联系也好,我手头上有一个画矢量图的,好像很复杂.看了很久看不懂.没有办法.想找一个简单一点的画图程序.但要能输入汉字的.不知哪位朋友有,或者加我QQ也可以.175287606.
 
楼上的矢量图的名字叫什么,可否给我发一份?
QQ:88188680
 
sxwy,你的矢量图是SIMPLEGRAPH吧?
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
872
DelphiTeacher的专栏
D
后退
顶部