Solved

Change source code - moving and resizing.

Posted on 2001-07-06
4
481 Views
Last Modified: 2010-08-05
Change source code - moving and resizing.

--------------------------------
This is a source code (component) for resizing and moving specific control.
I need to do changes on it. That it has ability to enable and disable moving and resizing.
Something like that :
SizePan1.enablemoving := True;  or SizePan1.enablemoving := False;
SizePan1.enableresizing := True;  or SizePan1.enableresizing := False;

And one more thing. In this code is not working OnClick event and maybe others too.
I need that OnClick and other events are enabled. That they are working.
If it is posible to do something like that :
SizePan1.enableevents := True; or SizePan1.enableevents := False;
-------------------------------

unit Sizeable;

interface

uses Windows, Messages, Classes, Controls, ExtCtrls, Forms, AdvGrid;

// declare the record types to translate mouse messages...
type TCMMouseEnter = record
 Msg : Cardinal;
 Unused : Integer;
 Sender : TControl;
 Result : LongInt;
end;

type TCMMouseLeave = TCMMouseEnter;


type TSizePan = class(TPanel)
 CONSTRUCTOR Create(AOwner:TComponent); override;
 private
    // variable to hold the value passed to WM_SYSCOMMAND...
   fSysCmd:integer;
   // variable to hold the "default" cursor, just in case it isn't "crDefault"
   fSavedCursor:TCursor;

   // -> Bug fix (explained below)
   fClientControl:TWinControl;
   fClientMouseMove:TMouseMoveEvent;
   procedure ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
   // <-

   // Custom events to trap the MouseEnter and mouse leave messages...
   // note the  CM_  prefix - these are custom Windows messages
   // similar to standard  WM_ messages, but used internally by Delphi applications...
   procedure CMMouseEnter(var Msg : TCMMouseEnter); message CM_MouseEnter;
   procedure CMMouseLeave(var Msg : TCMMouseLeave); message CM_MouseLeave;

 protected
   // override these default mouse events
   procedure MouseMove(Shift: TShiftState; X, Y: Integer);  override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   property OnClientMouseMove:TMouseMoveEvent read fClientMouseMove write fClientMouseMove;
end;

procedure Register;

implementation

// Added this procedure to install the component on the pallette...
procedure Register;
begin
 RegisterComponents('Samples', [TSizePan]);
end;



// constants passed to WM_SYSCOMMAND
// For some reason, these are not listed in the help file,
// I had to play around a bit to find them...
const
 SizeE  = $F002; // east
 SizeW  = $F001; // west
 SizeN  = $F003; // north
 SizeS  = $F006; // south
 SizeNW = $F004; // northwest
 SizeNE = $F005; // northeast
 SizeSW = $F007; // southwest
 SizeSE = $F008; // southeast

// Drags the entire panel ...
 MoveIt = $F012;


(*
begin bug fix -
For some reason, the CMouseLeave event isn't always called.
Windows seems to drop the ball if the mouse leaves the control too quickly.
So we need to jump through some hoops here to be sure the cursor gets restored
*)

// Declare a "dummy" class
// this "trick" just exposes the protected methods of TWinControl...
type DummyClass=class(TWinControl);

// the constructor is only needed here for the bug fix,
// but you might need it later if you decide to enhance the control...
CONSTRUCTOR TSizePan.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 // I assume that the Parent control will be the same as AOwner...
 fClientControl:=TWinControl(AOwner);
 // Save the defined Client MouseMove event (if there is one)...
 fClientMouseMove:=DummyClass(fClientControl).OnMouseMove;
 // and assign the new one...
 DummyClass(fClientControl).OnMouseMove:=ClientMouseMove;
 // save the default screen cursor...
 fSavedCursor:=Screen.Cursor;
end;

procedure TSizePan.ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
begin
 inherited;
 // restore the cursor...
 Screen.Cursor:=crDefault;
 // call any other code that is attached to this event...
 if assigned(fClientMouseMove) then fClientMouseMove(Sender,Shift,X,Y);
end;

(* end bug fix *)

 // save the value of the screen cursor when we enter the panel...
procedure TSizePan.CMMouseEnter(var Msg : TCMMouseEnter);
begin
  inherited;
 fSavedCursor:=Screen.Cursor;
end;

// and restore it when we leave...
procedure TSizePan.CMMouseLeave(var Msg : TCMMouseLeave);
begin
 inherited;
 Screen.Cursor:=fSavedCursor;
end;


// Note that nothing is really "happening" here as far as sizing the panel-
// we are just setting things up in case MouseDown gets called...
procedure TSizePan.MouseMove(Shift: TShiftState; X, Y: Integer);
const
 Edge=10; // how close to the edge do we get before saying we're "on" it? (in  pixels)
 Corner=20; // the corners are a bit harder to detect, so we add some tolerance
var
 P:TPoint;
begin
 // Create a TPoint from from the mouse coordinates passed to the function...
 P:=point(X,Y);

 // All this if-then-else stuff decides which constant will be passed to WM_SYSCOMMAND
 // Here we just use some math to create a small square at each corner,
 // then check to see if the mouse is within any them...
 if ptInRect(Rect(0,0,Corner,Corner),P) then fSysCmd:=SizeNW
 else if ptInRect(Rect(0,Height-Corner,Corner,Height),P) then fSysCmd:=SizeSW
 else if ptInRect(Rect(Width-Corner,Height-Corner,Width,Height),P) then fSysCmd:=SizeSE
 else if ptInRect(Rect(Width-Corner,0,Width,Corner),P) then fSysCmd:=SizeNE

 // if it's not in a corner, then is it near an edge?
 else if (X < Edge) then fSysCmd:=SizeW
 else if ( X > (Width-Edge) ) then fSysCmd:=SizeE
 else if (Y < Edge) then fSysCmd:=SizeN
 else if ( Y > (Height-3) ) then fSysCmd:=SizeS

 // if it's none of the above, then MouseDown should drag the whole panel...
 else fSysCmd:=MoveIt;

 // Now that we have the correct system command, we can use its
 // value to determine which screen cursor to display...
 with Screen do case fSysCmd of
   SizeE,SizeW:Cursor:=crSizeWE;
   SizeN,SizeS:Cursor:=crSizeNS;
   SizeNE,SizeSW:Cursor:=crSizeNESW;
   SizeNW,SizeSE:Cursor:=crSizeNWSE;
   else Cursor:=crDefault;
 end;
end;

procedure TSizePan.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// Give the new cursor a unique integer constant...
const crMove=-5;

// I declared a variable to hold the value of the "Align" property
// this is more-or-less "reserved for future enhancements" ...
var realign:TAlign;

begin
 // the four-sided arrow (move) cursor is not available in Delphi 2,
 // so I borrow this one from Windows...
 Screen.Cursors[crMove]:=LoadCursor(0,IDC_SIZEALL);
 // make sure the default MouseMove stuff gets executed...
 inherited MouseDown(Button,Shift,X,Y);
 // We don't drag with the right button, so bail out if it's down...
 if Button=mbRight then EXIT;
 // if the Left button is down, and we're not on an edge, then we must be moving...
 if (ssLeft in Shift) and (Screen.Cursor=crDefault) then Screen.Cursor:=crMove;
 // save the setting of the Align property...
 // this really isn't needed here, but I had hoped to adapt this code
 // to create something like a "dockable" panel...
 realign:=Align;
 Align:=alNone;
 // Let go of the mouse capture...
 // not sure about this, but I read somewhere that it's a good idea...
 ReleaseCapture;
 // "Perform" tells the component to execute an API call on itself...
 Perform(WM_SysCommand,fSysCmd,0); //<- And here's the heart of the whole component!
 // Restore the settings, and we're done!
 Screen.Cursor:=crDefault;
 Align:=realign;
end;

END.
0
Comment
Question by:gfdas
  • 2
4 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6259395
go to
http://www.devexpress.com/index.shtm

register yourself in the supportforum there
you will receive a welcome-mail with a link to the free
forum-comoponent-library and a password for this zip-file

this library contains a component, where you can design any control at runtime, if its active-property
is set to true

meikl ;-)
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6259402
just for avoiding to invent something twice.

on the otherhand place a boolean-property in your component, and jump over the sizing code if is set to false
(just some ifs)
0
 

Author Comment

by:gfdas
ID: 6259653
Is possible to do changes on this code as I mention ?
I tried Design example from deveexpress, but I am not satisified with it as I'm with sizeable.

Thanks.
0
 
LVL 13

Accepted Solution

by:
Epsylon earned 200 total points
ID: 6259949
unit Sizeable;
       
interface

uses Windows, Messages, Classes, Controls, ExtCtrls, Forms;

// declare the record types to translate mouse messages...
type
  TCMMouseEnter = record
                    Msg : Cardinal;
                    Unused : Integer;
                    Sender : TControl;
                    Result : LongInt;
                  end;

type
  TCMMouseLeave = TCMMouseEnter;


  TSizePan = class(TPanel)
  private
    // variable to hold the value passed to WM_SYSCOMMAND...
    fSysCmd:integer;
    // variable to hold the "default" cursor, just in case it isn't "crDefault"
    fSavedCursor:TCursor;
    FEnableMoving: Boolean;
    FEnableSizing: Boolean;

    // -> Bug fix (explained below)
    fClientControl:TWinControl;
    fClientMouseMove:TMouseMoveEvent;
    procedure ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
    // <-

    // Custom events to trap the MouseEnter and mouse leave messages...
    // note the  CM_  prefix - these are custom Windows messages
    // similar to standard  WM_ messages, but used internally by Delphi applications...
    procedure CMMouseEnter(var Msg : TCMMouseEnter); message CM_MouseEnter;
    procedure CMMouseLeave(var Msg : TCMMouseLeave); message CM_MouseLeave;

  public
    CONSTRUCTOR Create(AOwner:TComponent); override;
  protected
    // override these default mouse events
    procedure MouseMove(Shift: TShiftState; X, Y: Integer);  override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  published
    property OnClientMouseMove:TMouseMoveEvent read fClientMouseMove write fClientMouseMove;
    property EnableMoving: Boolean read FEnableMoving write FEnableMoving;
    property EnableSizing: Boolean read FEnableSizing write FEnableSizing;
  end;

procedure Register;

implementation

// Added this procedure to install the component on the pallette...
procedure Register;
begin
  RegisterComponents('Samples', [TSizePan]);
end;


// constants passed to WM_SYSCOMMAND
// For some reason, these are not listed in the help file,
// I had to play around a bit to find them...
const
  SizeE  = $F002; // east
  SizeW  = $F001; // west
  SizeN  = $F003; // north
  SizeS  = $F006; // south
  SizeNW = $F004; // northwest
  SizeNE = $F005; // northeast
  SizeSW = $F007; // southwest
  SizeSE = $F008; // southeast

// Drags the entire panel ...
  MoveIt = $F012;


(*
  begin bug fix -
  For some reason, the CMouseLeave event isn't always called.
  Windows seems to drop the ball if the mouse leaves the control too quickly.
  So we need to jump through some hoops here to be sure the cursor gets restored
*)

// Declare a "dummy" class
// this "trick" just exposes the protected methods of TWinControl...
type
  DummyClass=class(TWinControl);

// the constructor is only needed here for the bug fix,
// but you might need it later if you decide to enhance the control...
CONSTRUCTOR TSizePan.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FEnableMoving := true;
  FEnableSizing := true;
  // I assume that the Parent control will be the same as AOwner...
  fClientControl:=TWinControl(AOwner);
  // Save the defined Client MouseMove event (if there is one)...
  fClientMouseMove:=DummyClass(fClientControl).OnMouseMove;
  // and assign the new one...
  DummyClass(fClientControl).OnMouseMove:=ClientMouseMove;
  // save the default screen cursor...
  fSavedCursor:=Screen.Cursor;
end;

procedure TSizePan.ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  // restore the cursor...
  Screen.Cursor:=crDefault;
  // call any other code that is attached to this event...
  if assigned(fClientMouseMove) then fClientMouseMove(Sender,Shift,X,Y);
end;

(* end bug fix *)

// save the value of the screen cursor when we enter the panel...
procedure TSizePan.CMMouseEnter(var Msg : TCMMouseEnter);
begin
  inherited;
  fSavedCursor:=Screen.Cursor;
end;

// and restore it when we leave...
procedure TSizePan.CMMouseLeave(var Msg : TCMMouseLeave);
begin
  inherited;
  Screen.Cursor:=fSavedCursor;
end;


// Note that nothing is really "happening" here as far as sizing the panel-
// we are just setting things up in case MouseDown gets called...
procedure TSizePan.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  Edge=10; // how close to the edge do we get before saying we're "on" it? (in  pixels)
  Corner=20; // the corners are a bit harder to detect, so we add some tolerance
var
  P:TPoint;
begin
  // Create a TPoint from from the mouse coordinates passed to the function...
  P:=point(X,Y);

  // All this if-then-else stuff decides which constant will be passed to WM_SYSCOMMAND
  // Here we just use some math to create a small square at each corner,
  // then check to see if the mouse is within any them...
  if FEnableSizing then
  begin
    if ptInRect(Rect(0,0,Corner,Corner),P) then fSysCmd:=SizeNW
    else if ptInRect(Rect(0,Height-Corner,Corner,Height),P) then fSysCmd:=SizeSW
    else if ptInRect(Rect(Width-Corner,Height-Corner,Width,Height),P) then fSysCmd:=SizeSE
    else if ptInRect(Rect(Width-Corner,0,Width,Corner),P) then fSysCmd:=SizeNE

    // if it's not in a corner, then is it near an edge?
    else if (X < Edge) then fSysCmd:=SizeW
    else if ( X > (Width-Edge) ) then fSysCmd:=SizeE
    else if (Y < Edge) then fSysCmd:=SizeN
    else if ( Y > (Height-3) ) then fSysCmd:=SizeS

    // if it's none of the above, then MouseDown should drag the whole panel...
    else
      if FEnableMoving then fSysCmd:=MoveIt
      else fSysCmd := 0;
  end
    else
      if FEnableMoving then fSysCmd:=MoveIt
      else fSysCmd := 0;

  // Now that we have the correct system command, we can use its
  // value to determine which screen cursor to display...
  with Screen do case fSysCmd of
    SizeE,SizeW:Cursor:=crSizeWE;
    SizeN,SizeS:Cursor:=crSizeNS;
    SizeNE,SizeSW:Cursor:=crSizeNESW;
    SizeNW,SizeSE:Cursor:=crSizeNWSE;
    else Cursor:=crDefault;
  end;
end;

procedure TSizePan.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// Give the new cursor a unique integer constant...
const crMove=-5;

// I declared a variable to hold the value of the "Align" property
// this is more-or-less "reserved for future enhancements" ...
var realign:TAlign;

begin
  // the four-sided arrow (move) cursor is not available in Delphi 2,
  // so I borrow this one from Windows...
  Screen.Cursors[crMove]:=LoadCursor(0,IDC_SIZEALL);
  // make sure the default MouseMove stuff gets executed...
  inherited MouseDown(Button,Shift,X,Y);
  // We don't drag with the right button, so bail out if it's down...
  if Button=mbRight then EXIT;
  // if the Left button is down, and we're not on an edge, then we must be moving...
  if (ssLeft in Shift) and (Screen.Cursor=crDefault) then Screen.Cursor:=crMove;
  // save the setting of the Align property...
  // this really isn't needed here, but I had hoped to adapt this code
  // to create something like a "dockable" panel...
  realign:=Align;
  Align:=alNone;
  // Let go of the mouse capture...
  // not sure about this, but I read somewhere that it's a good idea...
  ReleaseCapture;
  // "Perform" tells the component to execute an API call on itself...
  Perform(WM_SysCommand,fSysCmd,0); //<- And here's the heart of the whole component!
  // Restore the settings, and we're done!
  Screen.Cursor:=crDefault;
  Align:=realign;
end;

END.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone 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

Suggested Solutions

Title # Comments Views Activity
Using idhttp to login to instagram 2 106
Firemonkey android show image from resource ? 1 46
Multi-layered image in FireMonkey 9 48
firemonkey keyboard covers the controls 1 37
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

809 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