How do I do this in Delphi...

you can access TImage pixels and copy them into a new invisible timage

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.

Hmmm?!

Thanks.

perhaps this may help:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, clipbrd,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  org,current : TPoint;
  selecting : boolean;

implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     org.x := x;
     org.y := y;
     current := org;
     selecting := true;
     image1.picture.bitmap.canvas.DrawFocusRect(rect(org.x,org.y,x,y));
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   t : TBitmap;
begin
     if selecting then
     begin
          selecting := false;
          image1.picture.bitmap.canvas.DrawFocusRect(rect(org.x,org.y,x,y));
          t := TBitmap.create;
          t.width := x-org.x;
          t.height := y-org.y;
          t.PixelFormat := image1.picture.bitmap.pixelFormat;
          t.canvas.copyRect(t.canvas.clipRect,image1.picture.bitmap.canvas,rect(org.x,org.y,x,y));
          clipBoard.assign(t);
          t.free;
     end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     if selecting then
     begin
          image1.picture.bitmap.canvas.DrawFocusRect(rect(org.x,org.y,current.x,current.y));
          current.x := x;
          current.y := y;
          image1.picture.bitmap.canvas.DrawFocusRect(rect(org.x,org.y,current.x,current.y));
     end;
end;

end.



here i used a TImage (already loaded with setup.bmp) the TImage will draw the selection box and copy the selection to the clipboard.

GL
Mike

foxvision ,
hee is the code for the "marching ants" effect just drop some labels randomly on your form to test it.:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
                            Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState;
                            X,Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
                          Shift: TShiftState; X, Y: Integer);
  private
    X1,Y1,X2,Y2 : Integer;
    procedure RemoveTheRect;
    procedure DrawTheRect;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Counter : Byte;
  CounterStart : Byte;
  Looper : LongInt;

implementation

{$R *.DFM}

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.FormCreate(Sender: TObject);
begin
  X1 := 0; Y1 := 0;
  X2 := 0; Y2 := 0;
  Canvas.Pen.Color := Color;
  Canvas.Brush.Color := Color;
  CounterStart := 128;
  Timer1.Interval := 100;
  Timer1.Enabled := True;
  Looper := 0;
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.FormMouseDown(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: Integer);
begin
  RemoveTheRect;                               // Erase any existing rectangle
  X1 := X; Y1 := Y; X2 := X; Y2 := Y;
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.

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?!

Image2.Assign(ClipBoard.???);

Thanks.

Thanks everyone especially inthe, your answer works, however Mike is just a little bit faster and it is on TImage.

Thanks a lot.

Glad to be of service :)

Gl
Mike