要个delphi画图程序的代码!(能运行的)急须!!!!!

以下代码是用画布做的，是画椭圆、直线和矩形

希望我的回答对你有帮组！

procedure TForm1.Image1MouseDown(Sender: TObject Button: TMouseButton

Shift: TShiftState X, Y: Integer)

begin

st.X:=x

st.Y:=y

et:=st

cp:=true

with image1.canvas do

begin

pen.Mode:=pmnot

pen.Color:=clblue

brush.Style:=bsclear

end

end

procedure TForm1.Image1MouseMove(Sender: TObject Shift: TShiftState X,

Y: Integer)

begin

if cp then

case shapekind of

1:

begin

image1.Canvas.Ellipse(st.X,st.Y,et.x,et.y)

image1.Canvas.Ellipse(st.X,st.Y,x,y)

end

2:

with image1.Canvas do

begin

MoveTo(st.X,st.y)

LineTo(et.x,et.y) //画的过程中能看到线

MoveTo(st.X,st.y)

LineTo(x,y)

end

3:

begin

image1.Canvas.rectangle(st.X,st.Y,et.x,et.y)

image1.Canvas.rectangle(st.X,st.Y,x,y)

end

end

et.X:=x     //不写会看到移动的轨迹

et.Y:=y

end

procedure TForm1.Image1MouseUp(Sender: TObject Button: TMouseButton

Shift: TShiftState X, Y: Integer)

begin

cp:=false

with image1.Canvas do

begin

pen.Mode:=pmcopy

//pen.Width:=3

pen.Color:=clred

brush.Color:=clgreen

brush.Style:=bsdiagcross

case shapekind of

1: begin           //画椭圆

//image1.Canvas.Ellipse(st.X,st.Y,et.x,et.y)

image1.Canvas.Ellipse(st.X,st.Y,x,y)

end

2: begin           //画直线

moveto(st.X,st.y)

lineto(et.X,et.y)

moveto(st.X ,st.y)

lineto(x,y)

end

3: begin         //画矩形

image1.Canvas.rectangle(st.X,st.Y,et.x,et.y)

image1.Canvas.rectangle(st.X,st.Y,x,y)

end

end

end

end

procedure TForm1.RadioGroup1Click(Sender: TObject)

begin

case radiogroup1.itemindex of

0:shapekind:=1

1:shapekind:=2

2:shapekind:=3

end

end

给你个在TImage上画线例子

原理是当mousedown时把画板上的图复制到临时画板中保存

当mousemove时恢复保存的图像并用lineto在画板上画出线

var

isdrawing: boolean

tb: TBitmap

crect: TRect

ps: TPoint

procedure TForm1.FormCreate(Sender: TObject)

begin

tb := TBitmap.Create

tb.Width := img.Width

tb.Height := img.Height

crect := Rect(0, 0, img.Width, img.Height)

end

procedure TForm1.FormCloseQuery(Sender: TObjectvar CanClose: Boolean)

begin

tb.Free

end

procedure TForm1.imgMouseDown(Sender: TObjectButton: TMouseButton

Shift: TShiftStateX, Y: Integer)

begin

ps.X := X

ps.Y := Y

tb.Canvas.CopyRect(crect, img.Canvas, crect)

isdrawing := not isdrawing

end

procedure TForm1.imgMouseMove(Sender: TObjectShift: TShiftStateX,

Y: Integer)

begin

if not isdrawing then Exit

img.Canvas.CopyRect(crect, tb.Canvas, crect)

img.Canvas.MoveTo(ps.X, ps.Y)

img.Canvas.LineTo(X, Y)

end

---