Solved

Shifting target enlargement

Posted on 2002-06-05
3
259 Views
Last Modified: 2010-05-18
Hi All,
What is below targets (drawfocusrect) correctly when the Image1 is placed to the top left corner of
Form1. The target area is enlarged correctly.

However if the Image1 is placed some where else on the Form1  the target area(drawfocusrect)
shows correctly but  enlarges something else that is not the targeted area .  I need to get it so that
the targeted area and the enlarged area are the same, but Image1 not located in the top left hand
part of the form1.

Thanks in advance.

unit Unitdrawfocusrect;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, 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 }
    MyPoint: TPoint;
    FDrawing: boolean;
    MyDrawRect: TRect;
  public
{ Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDrawing := true;
  MyDrawRect.Left := image1.Left + X;
  MyDrawRect.Top := image1.Top + Y;
  MyDrawRect.BottomRight := MyDrawRect.TopLeft;
  MyPoint := point(image1.Left + x, image1.Top + y);
  drawfocusrect(self.Canvas.Handle, MyDrawRect);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Bmp: TBitmap;
begin
  FDrawing := false;
  drawfocusrect(self.canvas.handle, MyDrawRect);
  Bmp := TBitmap.Create;
  Bmp.Width := MyDrawRect.Right - MyDrawRect.Left;
  Bmp.Height := MyDrawRect.Bottom - MyDrawRect.Top;
  Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), image1.Picture.Bitmap.Canvas,
MyDrawRect);
  image1.Picture.Bitmap.Canvas.StretchDraw(Rect(0, 0, image1.Width, image1.Height), Bmp);
  Bmp.Free;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDrawing = true then
  begin
    drawfocusrect(self.Canvas.Handle, MyDrawRect);
    if (image1.Left + x) > MyPoint.X then
    begin
      MyDrawRect.Left := MyPoint.X;
      MyDrawRect.Right := image1.Left + x;
    end
    else
    begin
      MyDrawRect.Left := image1.Left + x;
      MyDrawRect.Right := MyPoint.X
    end;
    if Y > MyPoint.Y then
    begin
      MyDrawRect.Top := mypoint.Y;
      MyDrawRect.Bottom := image1.Top + Y;
    end
    else
    begin
      MyDrawRect.Top := image1.Top + y;
      MyDrawRect.Bottom := MyPoint.Y
    end;
    Drawfocusrect(self.Canvas.Handle, MyDrawrect);
  end;
end;

end.


Delphi3
0
Comment
Question by:delphi3
3 Comments
 
LVL 10

Accepted Solution

by:
Jacco earned 50 total points
ID: 7057062
Hi Delphi3,

Here is a working sample. Hopefully you'll find some usefull tricks in it. Good luck.

Regards Jacco

unit Unitdrawfocusrect;

interface

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

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

var
 Form1: TForm1;

implementation

{$R *.dfm}

function CorrectRect(aRect: TRect): TRect;
var
  liTmp: Integer;
begin
  Result := aRect;
  with Result do
  begin
    if Left > Right then
    begin
      liTmp := Left;
      Left  := Right;
      Right := liTmp;
    end;
    if Top > Bottom then
    begin
      liTmp  := Top;
      Top    := Bottom;
      Bottom := liTmp;
    end;
  end;
end;


procedure TForm1.DrawEnlargeRect(aRect: TRect);
begin
  aRect := CorrectRect(aRect);
  OffsetRect(aRect, Image1.Left, Image1.Top);
  DrawFocusRect(Self.Canvas.Handle, aRect);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  lClip: TRect;
begin
  FDragging := True;
  with FRect do
  begin
    TopLeft     := Point(X,Y);
    BottomRight := TopLeft;
  end;
  lClip.TopLeft     := Image1.ClientToScreen(Point(0, 0));
  lClip.BottomRight := Image1.ClientToScreen(Point(Image1.Width, Image1.Height));
  ClipCursor(@lClip);
  DrawEnlargeRect(FRect);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
  if FDragging = True then
  begin
    DrawEnlargeRect(FRect);
    FRect.BottomRight := Point(X, Y);
    DrawEnlargeRect(FRect);
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Bmp: TBitmap;
begin
  if FDragging then
  begin
    FDragging := false;
    DrawEnlargeRect(FRect);
    FRect := CorrectRect(FRect);
    Bmp := TBitmap.Create;
    try
      Bmp.Width  := FRect.Right - FRect.Left;
      Bmp.Height := FRect.Bottom - FRect.Top;
      Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), Image1.Picture.Bitmap.Canvas, FRect);
      Image1.Picture.Bitmap.Canvas.StretchDraw(Rect(0, 0, Image1.Width, Image1.Height), Bmp);
    finally
      Bmp.Free;
    end;
    ClipCursor(nil);
  end;
end;

end.
0
 
LVL 33

Expert Comment

by:Slick812
ID: 7057562
hello delphi3, I have had so many probmems (Flicker and others) with TImage that I don't use it anymore, I don't think a TImage was made so you could draw on it, It's canvas is updated when the Picture Bitmap changes, and The Picture Bitmap Canvas is updated when the TImage Canvas is drawn, so I get flicker. I use a TPaintBox any time I need to Draw on the Display, It is more controlable for when it will be updated., I create a Bitmap to display in the PaintBox in the FormCreate, But you could load it from File or Resource.


procedure TForm1.FormCreate(Sender: TObject);
begin
fDrawing := False;
PBbmp := TBitmap.Create;
PBbmp.Width := PaintBox1.Width;
PBbmp.Height := PaintBox1.Height;
PBbmp.Canvas.Brush.Color := clRed;
PBbmp.Canvas.FillRect(PaintBox1.ClientRect);
PBbmp.Canvas.Font.Name := 'Arial';
PBbmp.Canvas.Font.Size := 48;
PBbmp.Canvas.TextOut(20,5,'PaintBox');
PBbmp.Canvas.TextOut(40,64,'Bitmap');
MyDrawRect := Rect(0,0,PaintBox1.Width, PaintBox1.Height);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
{you will have to Draw the PBbmp in this Paint event}
if Assigned(PBbmp) and not PBbmp.Empty then
PaintBox1.Canvas.Draw(0,0, PBbmp);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
FDrawing := true;
MyDrawRect.Left := X;
MyDrawRect.Top := Y;
MyDrawRect.BottomRight := MyDrawRect.TopLeft;
{I don't use a DrawFocusRect to avoid the non draw of a Rect
with Top more than Bottom}
PaintBox1.Canvas.Brush.Style := bsClear;
PaintBox1.Canvas.Pen.Color := clBlack;
PaintBox1.Canvas.Pen.Style := psSolid;
PaintBox1.Canvas.Pen.Mode := pmNot;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if FDrawing then
  begin
  PaintBox1.Canvas.Rectangle(MyDrawRect);
  MyDrawRect.Left := X;
  MyDrawRect.Top := Y;
  PaintBox1.Canvas.Rectangle(MyDrawRect);
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
Temp: Integer;
begin
FDrawing := false;
PaintBox1.Canvas.Rectangle(MyDrawRect);
 if MyDrawRect.Top > MyDrawRect.Bottom then
   begin
   Temp := MyDrawRect.Bottom;
   MyDrawRect.Bottom := MyDrawRect.Top;
   MyDrawRect.Top := Temp;
   end;
 if MyDrawRect.Left> MyDrawRect.Right then
   begin
   Temp := MyDrawRect.Right;
   MyDrawRect.Right := MyDrawRect.Left;
   MyDrawRect.Left := Temp;
   end;
{I use API StretchBlt here so I don't have to copy a bitmap}
 StretchBlt(PaintBox1.Canvas.Handle, 0, 0,PaintBox1.Width, PaintBox1.Height, PBbmp.Canvas.Handle,
            MyDrawRect.Left, MyDrawRect.Top, MyDrawRect.Right - MyDrawRect.Left, MyDrawRect.Bottom - MyDrawRect.Top, SRCCOPY);
{I use API BitBlt here so I can draw the paintbox canvas}
 BitBlt(PBbmp.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height, PaintBox1.Canvas.Handle, 0, 0, SRCCOPY);
end;

- - - - - - - - - - - - - - - - - - - - - - - - -

adding the ClipCursor is a good idea, If you continue to use TImage and draw on it or other, you will probally get flicker or other wierd stuff. Also Unlike the TImage you can Not change the bitmap, or copy the bitmap to another bitmap for an "Undo" option
0
 
LVL 4

Author Comment

by:delphi3
ID: 7058279
Hi Jacco and  Slick812,

Both of you did a splendid job.

Jacco's solution, for me, was the first to offer a most ready solution and I thank you for that and award the points and grade to you.

Slick812's solution needed some adjustments and I made those adjustments. Using My D4 standard edition required corrections for the line :
PaintBox1.Canvas.Rectangle(MyDrawRect);
Changed to:
  PaintBox1.Canvas.Rectangle(MyDrawRect.TopLeft.x, MyDrawRect.TopLeft.y, MyDrawRect.BottomRight.x, MyDrawRect.BottomRight.y); and with other additions it worked equally well.

Then I tried to load a .bmp file in both solutions, using an OpenDialog1. I was able to do it easily in Jacco's program.

Loading the .bmp in Slick812's program, while it was visible, it did not 'stick'. When I  moved over the new region with the viewing rectangle, it showed the region of the original image.

I thank you both for your efforts.

Delphi3

0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now