كيف أحمل صورة في PaintBox وكيف اطبعها ؟
|
كيف أحمل صورة في PaintBox وكيف اطبعها ؟
|
24-02-2010, 05:14 PM
السلام عليكم
--------------- هل أستطيع أن أحمل صورة في PaintBox مثل Loadfromfile في Image وكيف أستطيع حفظها ------------------- وسؤال مشترك بين Image و PaintBox كيف أستطيع طباعة الصورة الموجودة بداخل كل منهما وجزاكم الله خيراً
25-02-2010, 10:31 AM
(آخر تعديل لهذه المشاركة: 25-02-2010, 12:39 PM بواسطة AL-MOB4RM3G.)
شوف المثال أن شاء الله يفيدك
كود : unit bmpeditu;
interface
uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
stdctrls, extctrls;
type
tform1 = class(tform)
paintbox1: Tpaintbox;
button1: Tbutton;
panel1: Tpanel;
cd: Tcolordialog;
rgzoom: Tradiogroup;
rgtool: Tradiogroup;
procedure button1click(sender: Tobject);
procedure paintbox1mousedown(sender: Tobject; button: Tmousebutton;
shift: Tshiftstate; x, y: Integer);
procedure panel1click(sender: Tobject);
procedure rgzoomclick(sender: Tobject);
procedure formcreate(sender: Tobject);
procedure formdestroy(sender: Tobject);
procedure paintbox1mousemove(sender: Tobject; shift: Tshiftstate; x,
y: Integer);
procedure paintbox1mouseup(sender: Tobject; button: Tmousebutton;
shift: Tshiftstate; x, y: Integer);
private
{ private declarations }
zoom:integer;
xd,yd,xu,yu:integer;
bm:tbitmap;
procedure drawpixes(x, y: Integer; col: Tcolor);
procedure drawline(xs, ys, xe, ye, size: Integer; col: Tcolor);
procedure drawcircle(xs,ys,xe,ye,size:integer; col:tcolor);
procedure drawbox(xs, ys, xe, ye, size: Integer; col: Tcolor);
procedure flood(xs, ys: Integer; col: Tcolor);
public
{ public declarations }
end;
var
form1: Tform1;
implementation
{$r *.dfm}
procedure tform1.button1click(sender: Tobject);
begin
bm.loadfromfile('d:\my documents\my programs\glyphs\account.bmp');
paintbox1.canvas.draw(0,0,bm);
end;
procedure tform1.paintbox1mousedown(sender: Tobject; button: Tmousebutton;
shift: Tshiftstate; x, y: Integer);
begin
xd:=x;yd:=y;
end;
procedure tform1.drawpixes(x,y:integer;col:tcolor);
var i,j,x1,y1:integer;
begin
if (zoom > 0) and (bm<>nil) then
begin
x1:=x div zoom * zoom;
y1:=y div zoom * zoom;
for i:= 1 to zoom do
for j:= 1 to zoom do
paintbox1.canvas.pixels[x1+i,y1+j]:=col;
end;
end;
procedure tform1.panel1click(sender: Tobject);
begin
cd.execute;
panel1.color:=cd.color;
end;
procedure tform1.rgzoomclick(sender: Tobject);
var w,h:integer;
begin
w:=bm.width;
h:=bm.height;
paintbox1.width:=w*16;
paintbox1.height:=h*16;
case rgzoom.itemindex of
0: Begin zoom:=1; w:=bm.width; h:=bm.height; end;
1: Begin zoom:=4; w:=bm.width*4; h:=bm.height*4; end;
2: Begin zoom:=16; w:=bm.width*16; h:=bm.height*16; end;
end;
paintbox1.refresh;
paintbox1.canvas.stretchdraw(rect(0,0,w,h),bm);
end;
procedure tform1.formcreate(sender: Tobject);
begin
bm:=tbitmap.create;
end;
procedure tform1.formdestroy(sender: Tobject);
begin
bm.free;
end;
procedure tform1.paintbox1mousemove(sender: Tobject; shift: Tshiftstate; x,
y: Integer);
begin
if (ssleft in shift) and (rgtool.itemindex=0)then
drawpixes(x,y,panel1.color);
end;
procedure tform1.paintbox1mouseup(sender: Tobject; button: Tmousebutton;
shift: Tshiftstate; x, y: Integer);
begin
xu:=x;yu:=y;
case rgtool.itemindex of
0: If (xu = xd) and (yu=yd) then drawpixes(x,y,panel1.color);
1: Drawline(xd,yd,xu,yu,zoom, panel1.color);
2: Drawcircle(xd,yd,xu,yu,zoom, panel1.color);
3: Drawbox(xd,yd,xu,yu,zoom, panel1.color);
4: Flood(xd,yd, panel1.color);
end;
end;
procedure tform1.drawline(xs,ys,xe,ye,size:integer; col:tcolor);
begin
paintbox1.canvas.moveto(xs,yd);
paintbox1.canvas.pen.color :=col;
paintbox1.canvas.pen.width:=size;
paintbox1.canvas.lineto(xe,ye);
end;
procedure tform1.drawcircle(xs,ys,xe,ye,size:integer; col:tcolor);
begin
paintbox1.canvas.moveto(xs,yd);
paintbox1.canvas.pen.color :=col;
paintbox1.canvas.pen.width:=size;
paintbox1.canvas.brush.style :=bsclear;
paintbox1.canvas.ellipse(xs,ys,xe,ye);
end;
procedure tform1.drawbox(xs,ys,xe,ye,size:integer; col:tcolor);
begin
paintbox1.canvas.moveto(xs,yd);
paintbox1.canvas.pen.color :=col;
paintbox1.canvas.pen.width:=size;
paintbox1.canvas.brush.style :=bsclear;
paintbox1.canvas.rectangle(xs,ys,xe,ye);
end;
procedure tform1.flood(xs,ys :integer; col:tcolor);
var c:tcolor;
begin
paintbox1.canvas.brush.color:=col;
c:=paintbox1.canvas.pixels[xs,ys];
paintbox1.canvas.floodfill(xs,ys,c,fssurface);
end;
end.
(*
===========================================
the form:
===========================================
*)
object form1: Tform1
left = 233
top = 107
width = 696
height = 480
caption = 'form1'
color = clbtnface
font.charset = default_charset
font.color = clwindowtext
font.height = -11
font.name = 'ms shell dlg 2'
font.style = []
oldcreateorder = false
oncreate = formcreate
ondestroy = formdestroy
pixelsperinch = 96
textheight = 13
object paintbox1: Tpaintbox
left = 32
top = 24
width = 321
height = 329
onmousedown = paintbox1mousedown
onmousemove = paintbox1mousemove
onmouseup = paintbox1mouseup
end
object button1: Tbutton
left = 32
top = 368
width = 75
height = 25
caption = 'load'
taborder = 0
onclick = button1click
end
object panel1: Tpanel
left = 32
top = 400
width = 73
height = 25
caption = 'color'
taborder = 1
onclick = panel1click
end
object rgzoom: Tradiogroup
left = 128
top = 360
width = 89
height = 65
caption = 'zoom'
itemindex = 0
items.strings = (
'1'
'4'
'16')
taborder = 2
onclick = rgzoomclick
end
object rgtool: Tradiogroup
left = 248
top = 328
width = 89
height = 113
caption = 'rgtool'
itemindex = 0
items.strings = (
'free line'
'line'
'circle'
'rectangle'
'flodfill')
taborder = 3
end
object cd: Tcolordialog
ctl3d = true
left = 16
top = 400
end
end |
|
|
