Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1139
  • Last Modified:

Displaying a TPaintBox over a TGraphicControl

This might be a tough one - or maybe it's easy and I'm just unaware.

I am using a component decended from a TGraphics control as a Magnifier image in my application.  The source for component uis below.  However, I need to display some lines (in a TPaintbox or some other way) over top of the image in the component.  They are guide markings outlining specific areas of the magnified array of pixels.)  However, even though my TPaintBox is on top of the Magnifier component, as soon as it Paints the markings on the TPaintBox are erased or overwritten.

At this point I have two possible solutions - but I don't like either one.

Solution 1: modify the component code to accept the TPaintBox as a property and do a masked merge after each StretchBLT.  I haven't tried this one - yet.  But it would be an intensive solution, the tomer interval for the component is set at 100!

Solution 2: Overlay the magnifier component with a transparent form an draw the markings on that.  I've tested this and it works.  But it seems like a kludge.

There must be a better way.  Anybody have a better idea?

BTW, the component is already modified.  I added the Screen.Destop... calls because the original code did not properly handle dual monitors - and I added the Hold proeprty to stop the image rewrite without the Invalidate so that the image is retained.

I know this is a complicated question.
{************************************************************}
{*                                                          *}
{*     ThkMagnifier v1.0                                    *}
{*     Copyright (c) 2004 Hristo Kostov (Runner).           *}
{*     All rights reserved.                                 *}
{*                                                          *}
{*     E-mail:     runner@bulgaria.com                      *}
{*     Home page:  http://runner.hit.bg                     *}
{*                                                          *}
{************************************************************}
 
unit hkMagnifier;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms;
 
type
  ThkAboutInfo = type string;
 
  ThkCopyMode = (cmBlackness, cmDstInvert, cmMergeCopy, cmMergePaint,
    cmNotSrcCopy, cmNotSrcErase, cmPatCopy, cmPatInvert, cmPatPaint,
    cmSrcAnd, cmSrcCopy, cmSrcErase, cmSrcInvert, cmSrcPaint, cmWhiteness);
 
  ThkMagnifier = class(TGraphicControl)
  private
    FAbout: ThkAboutInfo;
    FActive: Boolean;
    FHold: Boolean;
    FCopyMode: ThkCopyMode;
    FDC: HDC;
    FTimer: TTimer;
    FZoom: Byte;
    function GetInterval: Cardinal;
    procedure SetAbout(Value: ThkAboutInfo);
    procedure SetActive(Value: Boolean);
    procedure SetHold(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetZoom(Value: Byte);
    procedure TimerHandler(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About: ThkAboutInfo read FAbout write SetAbout stored False;
    property Active: Boolean read FActive write SetActive default True;
    property Hold: Boolean read FHold write SetHold default True;
    property CopyMode: ThkCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
    property Interval: Cardinal read GetInterval write SetInterval default 100;
    property Zoom: Byte read FZoom write SetZoom default 2;
 
    property Align;
    property Anchors;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Runner', [ThkMagnifier]);
end;
 
{ ThkMagnifier }
 
constructor ThkMagnifier.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 110;
  Height := 110;
  FAbout := 'ThkMagnifier v1.0, Copyright (c) 2004 Hristo Kostov';
  FActive := True;
  FCopyMode := cmSrcCopy;
  FDC := GetDC(GetDesktopWindow);
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 100;
  FTimer.OnTimer := TimerHandler;
  FZoom := 2;
end;
 
destructor ThkMagnifier.Destroy;
begin
  ReleaseDC(GetDesktopWindow, FDC);
  inherited Destroy;
end;
 
procedure ThkMagnifier.Paint;
begin
  if not FActive then
    with inherited Canvas do
    begin
      Brush.Color := Color;
      FillRect(ClientRect);
    end;
end;
 
function ThkMagnifier.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;
 
procedure ThkMagnifier.SetAbout(Value: ThkAboutInfo);
begin
  { do nothing }
end;
 
procedure ThkMagnifier.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    FTimer.Enabled := FActive;
    Invalidate;
  end;
end;
 
procedure ThkMagnifier.SetHold(Value: Boolean);
begin
  if FHold <> Value then
  begin
    FHold := Value;
    FTimer.Enabled := not FHold;
  end;
end;
 
procedure ThkMagnifier.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;
 
procedure ThkMagnifier.SetZoom(Value: Byte);
begin
  if Value < 1 then Value := 1;
  FZoom := Value;
end;
 
procedure ThkMagnifier.TimerHandler(Sender: TObject);
const
  CopyModes: array[ThkCopyMode] of TCopyMode =
    (BLACKNESS, DSTINVERT, MERGECOPY, MERGEPAINT, NOTSRCCOPY,
     NOTSRCERASE, PATCOPY, PATINVERT, PATPAINT, SRCAND, SRCCOPY,
     SRCERASE, SRCINVERT, SRCPAINT, WHITENESS);
var
  P: TPoint;
  SrcWidth, SrcHeight, MaxX, MaxY: Integer;
begin
  GetCursorPos(P);
  SrcWidth := Width div FZoom;
  SrcHeight := Height div FZoom;
  MaxX := Screen.DesktopWidth - SrcWidth;
  MaxY := Screen.DesktopHeight - SrcHeight;
  P.X := P.X - SrcWidth div 2;
  P.Y := P.Y - SrcHeight div 2;
  if P.X < 0 then P.X := 0;
  if P.Y < 0 then P.Y := 0;
  if P.X > MaxX then P.X := MaxX;
  if P.Y > MaxY then P.Y := MaxY;
  StretchBlt(Canvas.Handle, 0, 0, Width, Height, FDC,
    P.X, P.Y, SrcWidth, SrcHeight, CopyModes[FCopyMode]);
end;
 
end.

Open in new window

0
DMTrump
Asked:
DMTrump
  • 5
  • 2
1 Solution
 
MerijnBSr. Software EngineerCommented:
Can't you do the extra drawing directly after the StrechBlt which is already there?
So StrechBlt (do the magnifing) and draw your markings directly after that _inside_ ThkMagnifier.TimerHandler.
0
 
DMTrumpAuthor Commented:
I could - I considered that - however the required drawing routines vary from instance to instance.  I'm using the ThMagnifier in three different ways. and although in one instance all I need is a 9x9 pixel box, in another there are dozens of different shapes that might be needed.  I'd sure rather draw those shapes only once and display them "on top of" the constantly changing StretchBlt.

It's a valid idea, but I think it is not quite as elegant as doing a merge.  The decision as to which drawing needs to be done is a single decision made before the Magnifier goes into use.  To have to make that inside the magnifier component would exponentially increase the code path.

However, here is another idea:  suppose I  manually call the PaintBox paint method inside the Timer Handler just after the StretchBlt?

 I'll give it a try!  (Suggestions on implementation welcome!)
0
 
MerijnBSr. Software EngineerCommented:
I was about to suggest something similar. After the StretchBlt, generate an OnAfterPaint event in which you supply the canvas, this way, you can do any custom painting from outside the object.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
DMTrumpAuthor Commented:
Success!  MerijnB, I guess we worked this out together, but since I wouldn't have tried it without your suggestions you get all the points - and well deserved - this was a tough one.

Here is what I did:

In the hkMagnifier I added:
type TMagPB = class(TPaintBox);
just after the uses clause

Then I added:
    FPaintBox: TPaintBox;
    function GetPaintBox: TPaintBox;
    procedure SetPaintBox(Value: TPaintBox);
then to the published properties:
    property PaintBox: TPaintBox read GetPaintBox write SetPaintBox default NIL;

in the implementation:


function ThkMagnifier.GetPaintBox: TPaintBox;
begin
  result:= FPaintBox;
end;

procedure ThkMagnifier.SetPaintBox(Value: TPaintBox);
begin
  FPaintBox:=Value;
end;

Then in TimerHandler, just after the StretchBlt statment, as the last line of the TimerHandler

  TMagPB(PaintBox).Paint;

It works!  

Thanks a lot!
0
 
DMTrumpAuthor Commented:
Here is the entire modified ThkMagnifier source:
{************************************************************}
{*                                                          *}
{*     ThkMagnifier v1.0                                    *}
{*     Copyright (c) 2004 Hristo Kostov (Runner).           *}
{*     All rights reserved.                                 *}
{*                                                          *}
{*     E-mail:     runner@bulgaria.com                      *}
{*     Home page:  http://runner.hit.bg                     *}
{*                                                          *}
{************************************************************}
 
{************************************************************}
{*                                                          *}
{*  Modified by DMTrump  Feb 23, 2009                       *}
{*    Added                                                 *}
{*      Hold Property                                       *}
{*      PaintBox Property                                   *}
{*    Used Screen.DesktopWidth and Height to accomodate     *}                                                  *}
{*    multiple monitor desktops                             *}
{*     E-mail:     davet@ewztech.com                        *}
{*                                                          *}
{************************************************************}
 
unit hkMagnifier;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms;
 
type TMagPB = class(TPaintBox);
 
type
  ThkAboutInfo = type string;
 
  ThkCopyMode = (cmBlackness, cmDstInvert, cmMergeCopy, cmMergePaint,
    cmNotSrcCopy, cmNotSrcErase, cmPatCopy, cmPatInvert, cmPatPaint,
    cmSrcAnd, cmSrcCopy, cmSrcErase, cmSrcInvert, cmSrcPaint, cmWhiteness);
 
  ThkMagnifier = class(TGraphicControl)
  private
    FAbout: ThkAboutInfo;
    FActive: Boolean;
    FHold: Boolean;
    FCopyMode: ThkCopyMode;
    FDC: HDC;
    FTimer: TTimer;
    FZoom: Byte;
    FPaintBox: TPaintBox;
    function GetPaintBox: TPaintBox;
    procedure SetPaintBox(Value: TPaintBox);
    function GetInterval: Cardinal;
    procedure SetAbout(Value: ThkAboutInfo);
    procedure SetActive(Value: Boolean);
    procedure SetHold(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetZoom(Value: Byte);
    procedure TimerHandler(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About: ThkAboutInfo read FAbout write SetAbout stored False;
    property Active: Boolean read FActive write SetActive default True;
    property Hold: Boolean read FHold write SetHold default True;
    property CopyMode: ThkCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
    property Interval: Cardinal read GetInterval write SetInterval default 100;
    property Zoom: Byte read FZoom write SetZoom default 2;
    property PaintBox: TPaintBox read GetPaintBox write SetPaintBox default NIL;
 
    property Align;
    property Anchors;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Runner', [ThkMagnifier]);
end;
 
{ ThkMagnifier }
 
constructor ThkMagnifier.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 110;
  Height := 110;
  FAbout := 'ThkMagnifier v1.0, Copyright (c) 2004 Hristo Kostov';
  FActive := True;
  FCopyMode := cmSrcCopy;
  FDC := GetDC(GetDesktopWindow);
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 100;
  FTimer.OnTimer := TimerHandler;
  FZoom := 2;
end;
 
destructor ThkMagnifier.Destroy;
begin
  ReleaseDC(GetDesktopWindow, FDC);
  inherited Destroy;
end;
 
function ThkMagnifier.GetPaintBox: TPaintBox;
begin
  result:= FPaintBox;
end;
 
procedure ThkMagnifier.SetPaintBox(Value: TPaintBox);
begin
  FPaintBox:=Value;
end;
 
procedure ThkMagnifier.Paint;
begin
  if not FActive then
    with inherited Canvas do
    begin
      Brush.Color := Color;
      FillRect(ClientRect);
    end;
end;
 
function ThkMagnifier.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;
 
procedure ThkMagnifier.SetAbout(Value: ThkAboutInfo);
begin
  { do nothing }
end;
 
procedure ThkMagnifier.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    FTimer.Enabled := FActive;
    Invalidate;
  end;
end;
 
procedure ThkMagnifier.SetHold(Value: Boolean);
begin
  if FHold <> Value then
  begin
    FHold := Value;
    FTimer.Enabled := not FHold;
  end;
end;
 
procedure ThkMagnifier.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;
 
procedure ThkMagnifier.SetZoom(Value: Byte);
begin
  if Value < 1 then Value := 1;
  FZoom := Value;
end;
 
procedure ThkMagnifier.TimerHandler(Sender: TObject);
const
  CopyModes: array[ThkCopyMode] of TCopyMode =
    (BLACKNESS, DSTINVERT, MERGECOPY, MERGEPAINT, NOTSRCCOPY,
     NOTSRCERASE, PATCOPY, PATINVERT, PATPAINT, SRCAND, SRCCOPY,
     SRCERASE, SRCINVERT, SRCPAINT, WHITENESS);
var
  P: TPoint;
  SrcWidth, SrcHeight, MaxX, MaxY: Integer;
begin
  GetCursorPos(P);
  SrcWidth := Width div FZoom;
  SrcHeight := Height div FZoom;
  MaxX := Screen.DesktopWidth - SrcWidth;
  MaxY := Screen.DesktopHeight - SrcHeight;
  P.X := P.X - SrcWidth div 2;
  P.Y := P.Y - SrcHeight div 2;
  if P.X < 0 then P.X := 0;
  if P.Y < 0 then P.Y := 0;
  if P.X > MaxX then P.X := MaxX;
  if P.Y > MaxY then P.Y := MaxY;
  StretchBlt(Canvas.Handle, 0, 0, Width, Height, FDC,
    P.X, P.Y, SrcWidth, SrcHeight, CopyModes[FCopyMode]);
  TMagPB(PaintBox).Paint;
end;
 
end.

Open in new window

0
 
DMTrumpAuthor Commented:
Important Note:  If using the above component, please change the last line of the Timer Handler to this:
if PaintBox<> NIL then TMagPB(PaintBox).Paint;

Otherwise you will get an error when you place the component on a form becasue the default value for Active is true (meaning you'll see the Magnifier in action immediately and you will not have entered a TPaintBox in the PaintBox property (under Linkage)
0
 
Geert GruwezOracle dbaCommented:
or

var
  P: TPoint;
  SrcWidth, SrcHeight, MaxX, MaxY: Integer;
begin
  if FActive and Assigned(fPaintBox) then
  begin
    GetCursorPos(P);
    SrcWidth := Width div FZoom;

you also need to add FreeNotification for when somebody deletes the paintbox
0
 
DMTrumpAuthor Commented:
Thanks, Geert_Gruwez!

Of course this is not my component.  I've emailed the original author with the changes I've made and he may or may not incorporate them into his distribution.  
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

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

  • 5
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now