من میخوام از ساده ترین راه یه ناحیه از تصویر رو در برنامه خودم انتخاب کنم.
از این ساده تر
اینم عکس برنامه هنگام اجرا
Select.jpg
{...}
var
dx, dy: Integer;
mx, my: Integer;
mdown: boolean;
CLR_CLEAR: TColor;
procedure TForm3.img_SourceMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
dx := X;
dy := Y; // store mouse down x and y
{ mdown := true; }
with img_Source do
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := psDash;
Canvas.Pen.Mode := pmNot;
mx := X;
my := Y;
Canvas.Rectangle(dx, dy, mx, my);
end;
end;
procedure TForm3.img_SourceMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if ssLeft in Shift { mdown } then
begin
with img_Source do
begin
Canvas.Rectangle(dx, dy, mx, my);
mx := X;
my := Y;
Canvas.Rectangle(dx, dy, mx, my);
end;
end;
end;
procedure TForm3.img_SourceMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r: Trect;
function normalizerect(r: Trect): Trect;
begin
result := r;
with result do
begin
if right < left then
begin
left := r.right;
right := r.left;
end;
if bottom < top then
begin
top := r.bottom;
bottom := r.top;
end;
end;
end;
begin
{ mdown := FALSE; }
img_Source.Canvas.Rectangle(dx, dy, mx, my);
img_Destination.Canvas.Brush.Color := CLR_CLEAR;
img_Destination.Canvas.FillRect(Rect(0, 0, img_Destination.Width,
img_Destination.Height));
r := normalizerect(Rect(X, Y, dx, dy));
img_Destination.Canvas.CopyRect(Rect(0, 0, r.right - r.left,
r.bottom - r.top), img_Source.Canvas, r);
end;
موفق باشید.
پاسخ با نقل قول
نوشته شده توسط hp1361
