I've loaded a JPG into TImage. What I need to do now is, like the rectangle area selection function in PaintBrush(of Windows 9x), where user press the mouse button at a point, move the mouse to a final point, release the button and a dashed line rectangle should appear at the area.
Then, what I need to do with this area is: Cut the area when user press the 'D' key so that the area which the user selected will be a white area, and this area has been copied to an invisible TImage for some other purpose.
I have look at some similar codes in C++ but was unable to translate them into Delphi.
you can access TImage pixels and copy them into a new invisible timage
0
foxvisionAuthor Commented:
Hi Bryan,
Can I have the codes to draw that rectangle before I can do any other thing else?!
I've been trying the below:
OnMouseMove
Image1.Picture.Bitmap.Canvas.Rectangle(,,,)
and setting the Canvas mode to cmPatCopy but what I get is a white rectangle which cover the orginal image.
procedure MovingDots(X,Y: Integer; TheCanvas: TCanvas); stdcall;
begin
Inc(Looper);
Counter := Counter shl 1; // Shift the bit left one
if Counter = 0 then Counter := 1; // If it shifts off left, reset it
if (Counter and 224) > 0 then // Are any of the left 3 bits set?
TheCanvas.Pixels[X,Y] := Form1.Color // Erase the pixel
else
TheCanvas.Pixels[X,Y] := clBlack; // Draw the pixel
end;
function NormalizeRect(R: TRect): TRect;
begin
// This routine normalizes a rectangle. It makes sure that the Left,Top
// coords are always above and to the left of the Bottom,Right coords.
with R do
if Left > Right then
if Top > Bottom then
Result := Rect(Right,Bottom,Left,Top)
else
Result := Rect(Right,Top,Left,Bottom)
else
if Top > Bottom then
Result := Rect(Left,Bottom,Right,Top)
else
Result := Rect(Left,Top,Right,Bottom);
end;
procedure TForm1.RemoveTheRect;
var
R : TRect;
begin
R := NormalizeRect(Rect(X1,Y1,X2,Y2)); // Rectangle might be flipped
InflateRect(R,1,1); // Make the rectangle 1 pixel larger
InvalidateRect(Handle,@R,True); // Mark the area as invalid
InflateRect(R,-2,-2); // Now shrink the rectangle 2 pixels
ValidateRect(Handle,@R); // And validate this new rectangle.
// This leaves a 2 pixel band all the way around
// the rectangle that will be erased & redrawn
UpdateWindow(Handle);
end;
procedure TForm1.DrawTheRect;
begin
// Determines starting pixel color of Rect
Counter := CounterStart;
// Use LineDDA to draw each of the 4 edges of the rectangle
LineDDA(X1,Y1,X2,Y1,@MovingDots,LongInt(Canvas));
LineDDA(X2,Y1,X2,Y2,@MovingDots,LongInt(Canvas));
LineDDA(X2,Y2,X1,Y2,@MovingDots,LongInt(Canvas));
LineDDA(X1,Y2,X1,Y1,@MovingDots,LongInt(Canvas));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
CounterStart := CounterStart shr 2; // Shl 1 will move rect slower
if CounterStart = 0 then CounterStart := 128; // If bit is lost, reset it
DrawTheRect; // Draw the rectangle
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if ssLeft in Shift then
begin
RemoveTheRect; // Erase any existing rectangle
X2 := X; Y2 := Y; // Save the new corner where the mouse is
DrawTheRect; // Draw the Rect now... don't wait for the timer!
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
R1,R2,R3 : TRect;
a : Integer;
begin
// Color all labels red that are in the rectangle
For a := 0 to ControlCount-1 do
if Controls[a] is TLabel then
begin
R1 := (Controls[a] as TLabel).BoundsRect;
R2 := NormalizeRect(Rect(X1,Y1,X2,Y2));
if IntersectRect(R3,R1,R2) then
(Controls[a] as TLabel).Font.Color := clRed
else
(Controls[a] as TLabel).Font.Color := clWindowText;
end;
end;
end.
0
foxvisionAuthor Commented:
Hi Mike,
Yes! That's what I want, however, not quite. The rectangle disappear once I release my mouse. I want the rectagle to remain there.
To copy the image from the clipboard again, will this do?!