Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Shifting target enlargement

Posted on 2002-06-05
3
Medium Priority
?
295 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 10

Accepted Solution

by:
Jacco earned 200 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 34

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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses

722 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