[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
    The following is a unit I wrote yesterday. I am uploading it because it is a
    failed component - failed because it ultimately could not do what I needed.
    What I needed were resizeable bloxes (hotspots if you will) over a graphic.
    I created a component and setup 8 boxes at the perimeter for resizing and
    developed the code for the control to be moved (by clicking and holding
    while moving inside the control) or resized (at one of the 8 resize blocks
    around the edge).  The failure was that after I got all this working I could
    not find a way to make the window transparent or automatically copy the area
    underneath to its canvas.  I had to have a transparent hotspot - not one
    pushbutton grey!

    Anyway, when the user presses the mouse button down I take the X,Y, make it
    a point and do ClientToScreen on it - I also store the location of the
    control in parent coordinates.  Later, when I get the OnMouseMove call, I
    take the new X,Y position, convert it to screen coordinates and take the
    difference of the original mouse X,Y to the new mouse X,Y and apply that to
    the original window X,Y.

    I am redoing this control as a descendant of TPaintBox so it can have the
    graphic and handling the hotspots as a TList instead of individual windows.
    Easier on resources as well.
    }
    unit Hotspot;

    interface

    uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs;

    type
      THotspot = class(TCustomControl)
      private
        { Private declarations }
        xDown: Integer;
        yDown: Integer;
        ptDown: TPoint;
        dragging: Integer;
        wDrag: Integer;
        rcDown: TRect;
        rcDrag: Array [0..7] of TRect;
        rcCursor: Array [0..7] of TCursor;

      protected
        { Protected declarations }
        property OnMouseDown;
        property OnMouseUp;
        property OnMouseMove;

      public
        { Public declarations }
    		constructor Create(AOwner: TComponent); override;

    		procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
        procedure Paint; override;
    		procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
        procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);
        procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);

      published
        { Published declarations }
      end;

    procedure Register;

    implementation

    procedure Register;
    begin
      RegisterComponents('Samples', [THotspot]);
    end;

    constructor THotspot.Create(AOwner: TComponent);
    var
    	win: Longint;
    begin
    	inherited Create(AOwner);
      Canvas.Brush.Style := bsClear;
      dragging := -1;
      wDrag := 5;

      OnMouseMove := MouseMove;
      OnMouseDown := MouseDown;
      OnMouseUp := MouseUp;
      ParentColor := True;

      rcCursor[0] := crSizeNWSE;
      rcCursor[1] := crSizeNS;
      rcCursor[2] := crSizeNESW;
      rcCursor[3] := crSizeWE;
      rcCursor[4] := crSizeNWSE;
      rcCursor[5] := crSizeNS;
      rcCursor[6] := crSizeNESW;
      rcCursor[7] := crSizeWE;
    end;

    procedure THotspot.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    var
    	r,b,r2,b2: Integer;
    	wDrag2: Integer;
    begin
    	r := AWidth;
      b := AHeight;
      r2:= r div 2;
      b2 := b div 2;
    	wDrag2 := wDrag div 2;

      rcDrag[0] := Rect(0,0,wDrag,wDrag);
      rcDrag[1] := Rect(r2-wDrag2,0,r2+wDrag2,wDrag);
      rcDrag[2] := Rect(r-wDrag+1,0,r,wDrag);
      rcDrag[3] := Rect(r-wDrag+1,b2-wDrag2,r,b2+wDrag2);
      rcDrag[4] := Rect(r-wDrag+1,b-wDrag,r,b);
      rcDrag[5] := Rect(r2-wDrag2,b-wDrag,r2+wDrag2,b);
      rcDrag[6] := Rect(0,b-wDrag,wDrag,b);
      rcDrag[7] := Rect(0,b2-wDrag2,wDrag,b2+wDrag2);

    	inherited SetBounds(ALeft,ATop,AWidth,AHeight);
    end;

    procedure THotspot.Paint;
    var
    	rc: TRect;
      i,w: Integer;
    begin
    	with Canvas do begin
        Pen.Style := psDot;
        if dragging = -1 then
          Pen.Color := clBlack
        else
          Pen.Color := clWhite;
        rc := GetClientRect;
        w := wDrag div 2;
        Rectangle(w,w,rc.right-w,rc.bottom-w);

        Brush.Style := bsSolid;
        Brush.Color := Pen.Color;
        Pen.Style := psSolid;
        for i := 0 to 7 do
        	Rectangle(rcDrag[i].Left,rcDrag[i].Top,rcDrag[i].Right,rcDrag[i].Bottom);
        Brush.Style := bsClear;
    	end;
    end;

    procedure THotspot.MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
    Integer);
    var
    	i: Integer;
      pt: TPoint;
      xDif,yDif: Integer;

      procedure SetW(leftOff,topOff,rightOff,bottomOff: Integer);
      var
      	rc: TRect;
      begin
      	rc := rcDown;
        Inc(rc.Left,leftOff);
        Inc(rc.Top,topOff);
        Inc(rc.Right,rightOff);
        Inc(rc.Bottom,bottomOff);
        SetBounds(rc.Left,rc.Top,rc.Right-rc.Left+1,rc.Bottom-rc.Top+1);
      end;

    begin
    	pt := ClientToScreen(Point(X,Y));
    	xDif := pt.X - ptDown.X;
      yDif := pt.Y - ptDown.Y;
    	if ssLeft in Shift then
        case dragging of
        -1:	SetBounds(left + (X-xDown),top + (Y-yDown),width,height);
        0: SetW(xDif,yDif,0,0);
        1: SetW(0,yDif,0,0);
        2: SetW(0,yDif,xDif,0);
        3: SetW(0,0,xDif,0);
        4: SetW(0,0,xDif,yDif);
        5: SetW(0,0,0,yDif);
        6: SetW(xDif,0,0,yDif);
        7: SetW(xDif,0,0,0);
        end
      else begin
    	 	pt := Point(X,Y);
      	Cursor := crArrow;
    	  for i := 0 to 7 do
    			if PtInRect(rcDrag[i],pt) then
          	Cursor := rcCursor[i];
      end;
    end;

    procedure THotspot.MouseDown(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);
    var
    	i: Integer;
      pt: TPoint;
    begin
     	pt := Point(X,Y);
      ptDown := ClientToScreen(pt);
    	xDown := X;
      yDown := Y;
      rcDown := Rect(left,top,left+Width,top+Height);
      dragging := -1;
      for i := 0 to 7 do
    		if PtInRect(rcDrag[i],pt) then
        	dragging := i;
      if dragging <> -1 then
      	Cursor := rcCursor[i]
      else if Cursor <> crArrow then
      	Cursor := crArrow;
      Paint;
    end;

    procedure THotspot.MouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);
    begin
    	dragging := -1;
      Paint;
    end;

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]