Selam,
Aşağıda herhangi bir paintbox üzerine dörtgen, poligon ve çember çizdirebileceğin bir proje gönderiyorum. Uzun gibi duruyor, ama inan bana %80'i hikaye, aslında toplasan sanırım 20-30 satırı gerçekten de dikkat edilmesi gereken kod.
Forma 3 tane RadioButton, 1 tane buton ve bir tane de PaintBox.
RadioButton1 = Dörtgen
RadioButton2 = Poligon
RadioButton3 = Elips
Başlangıçta hiç birisi seçili olmasın. Kodu ona göre yazdım.
Button1'in Enabled değerini false yap ve başlığını da Poligonu çiz olarak değiştir.
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Math;
type TPaintTools = (ptNone, ptRectangle, ptEllipse, ptPolygon);
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Button1: TButton;
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FActiveTool: TPaintTools;
procedure SetActiveTool(const Value: TPaintTools);
private
MouseDownPos:TPoint;
Buffer:TBitmap;
Img:TBitmap;
PolygonPointList:TList;
property ActiveTool:TPaintTools read FActiveTool write SetActiveTool;
procedure PreviewPolygon;
procedure ClearPolygonBuffer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt:PPoint;
begin
if Button = mbLeft then
begin
MouseDownPos := Point(X,Y);
if ActiveTool = ptPolygon then
begin
New(pt);
pt.X := X;
pt.Y := Y;
PolygonPointList.Add(pt);
PreviewPolygon;
end;
end;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Area:TRect;
begin
if not (ssLeft in Shift) then Exit;
case ActiveTool of
ptRectangle:
begin
Buffer.Assign(Img);
if ssCtrl in Shift then
begin
Area.TopLeft := MouseDownPos;
if (abs(MouseDownPos.X - X) > abs(MouseDownPos.Y - Y)) then
Area.BottomRight := Point(X, X)
else
Area.BottomRight := Point(Y, Y);
end
else
Area:=Rect(MouseDownPos, Point(X,Y));
Buffer.Canvas.Rectangle(Area);
PaintBox1.Repaint;
end;
ptPolygon:
begin
Exit;
end;
ptEllipse:
begin
Buffer.Assign(Img);
if ssCtrl in Shift then
begin
Area.TopLeft := MouseDownPos;
if (abs(MouseDownPos.X - X) > abs(MouseDownPos.Y - Y)) then
Area.BottomRight := Point(X, X)
else
Area.BottomRight := Point(Y, Y);
end
else
Area:=Rect(MouseDownPos, Point(X,Y));
Buffer.Canvas.Ellipse(Area);
PaintBox1.Repaint;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered:=true;
Img:=TBitmap.Create;
Img.Width:=PaintBox1.Width;
Img.Height:=PaintBox1.Height;
Img.PixelFormat:=pf24bit;
Buffer:=TBitmap.Create;
Buffer.Assign(Img);
PolygonPointList:=TList.Create;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0, 0, Buffer);
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
case ActiveTool of
ptRectangle, ptEllipse :
Img.Assign(Buffer);
end;
end;
procedure TForm1.SetActiveTool(const Value: TPaintTools);
begin
FActiveTool := Value;
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
ActiveTool:=ptRectangle;
Button1.Enabled:=false;
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
ActiveTool := ptPolygon;
ClearPolygonBuffer;
Button1.Enabled:=true;
end;
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
ActiveTool:=ptEllipse;
Button1.Enabled:=false;
end;
procedure TForm1.ClearPolygonBuffer;
var
I:integer;
pt:PPoint;
begin
for I:=0 to PolygonPointList.Count-1 do
begin
pt:=PolygonPointList.Items[I];
Dispose(pt);
end;
PolygonPointList.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I:integer;
Pt:PPoint;
Points:array of TPoint;
begin
SetLength(Points,PolygonPointList.Count);
for I:=0 to PolygonPointList.Count-1 do
begin
pt := PolygonPointList.Items[I];
Points[I].X := pt.X;
Points[I].Y := pt.Y;
end;
Buffer.Assign(Img);
Buffer.Canvas.Polygon(Points);
Img.Assign(Buffer);
PaintBox1.Repaint;
ClearPolygonBuffer;
end;
procedure TForm1.PreviewPolygon;
var
I:integer;
Pt:PPoint;
begin
if PolygonPointList.Count = 0 then Exit;
Pt:=PolygonPointList.Items[0];
Buffer.Canvas.PenPos := Pt^;
Buffer.Canvas.Ellipse(pt.X - 2, pt.Y - 2, pt.X + 2, pt.Y + 2);
for I:=1 to PolygonPointList.Count-1 do
begin
pt := PolygonPointList.Items[I];
Buffer.Canvas.Ellipse(pt.X - 2, pt.Y - 2, pt.X + 2, pt.Y + 2);
Buffer.Canvas.LineTo(pt.X, pt.Y);
end;
PaintBox1.Repaint;
end;
end.
Kodu sadece örnek olması için yazdım ve nesne yönelimli programlamaya göre bazı hatalar var. Zaten yarattığım nesnelerin hiçbirisini silmiyorum, ama en azından sana yol gösterecektir. Küçük bir hatırlatma: Bu tür çizim projelerinde direkt orjinal resim üzerine çizdirme. Önce geçici bir resme çizdir, sonra da orjinal resme kopyala. Sana gönderdiğim örnekte de Img orjinal resim, Buffer'da geçici resim.
Bu arada kodu yazdığımda belki online'sındır diye seni MSN listeme ekledim, ama malesef değilmişsin. Eğer kodda anlamadığın bir yer olursa MSN'den sorabilirsin.
Kolay gelsin,
Bahadır Alkaç
bu werdiğin kodlar tamda benim yapmak istediğim şey. sağol warol