Solved

Change code - to fix it

Posted on 2001-07-07
3
319 Views
Last Modified: 2010-04-06
Change code - to fix it

As you can see here are two codes.
First is comonent. It is OK. It is used for resizing and moving panel.
Socond is project (example). Here I tried to add source code of component to it.
But I didn't succeed. When I run project, and test it on Panel1, all corners and edges are not working.
Moving is OK. Resizing in project is problem. Can you fix that. Thanks.




--------->      1st code :

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.






--------->      2nd code :


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SizePan1: TSizePan;
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  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;
  public

 end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// 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;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
 Edge=15; // 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);
 Form1.Caption:=IntToStr(x)+' '+inttostr(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 TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
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...
 Panel1.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;

procedure TForm1.FormShow(Sender: TObject);
begin
fsyscmd:=0;
fenablesizing:=True;
fenablemoving:=True;
end;

end.
0
Comment
Question by:cvbmn
  • 2
3 Comments
 
LVL 2

Expert Comment

by:bugroger
ID: 6261661
Hi cvbmw,

It is quit easy.
The problem is that the owner in the
TSizePan.MouseMove - event is SizePan
and in the other it is Form1.

//Component
procedure TSizePan.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
{...}
 Height -> SizePan.Height
 Width  -> SizePan.Width
{...}
end;

//project
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
{...}
 Height -> Form1.Height
 Width  -> Form1.Height

 Panel1.Height -> Panel1.Height;
 Panel1.Width  -> Panel1.Width;
{...}
end;



Here is the fixed TForm1.Panel1MouseMove function:
-> Just add one line: "With Panel1 do"

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
const
Edge=15; // 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);
Form1.Caption:=IntToStr(x)+' '+inttostr(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

{ !!!!!!!!!!!!!!!!!!!!!!!!!!!! }
With Panel1 do
{ !!!!!!!!!!!!!!!!!!!!!!!!!!!! }

  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;

GL
 Bug
0
 
LVL 13

Accepted Solution

by:
Epsylon earned 200 total points
ID: 6261747
Bugroger, there's still a problem with the cursor...

I felt free to rewrite the code. The Resize-bug has been fixed (like Bugroger did), some MouseDown event code has been moved to MouseMove event and the cusror-changes have been fixed.



unit Unit1;

interface

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

type
 TForm1 = class(TForm)
    Panel1: TPanel;
   procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure FormShow(Sender: TObject);
 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;
 public

end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

// 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;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
Edge=15; // 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;
re_align:TAlign;
begin
with Sender as TPanel do
begin
re_align := Align;
Align := alNone;
// Create a TPoint from from the mouse coordinates passed to the function...
P:=point(X,Y);
Form1.Caption:=IntToStr(x)+' '+inttostr(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...
case fSysCmd of
  SizeE,SizeW:Cursor:=crSizeWE;
  SizeN,SizeS:Cursor:=crSizeNS;
  SizeNE,SizeSW:Cursor:=crSizeNESW;
  SizeNW,SizeSE:Cursor:=crSizeNWSE;
  MoveIt:if (ssLeft in Shift) then Screen.Cursor := crSizeAll
         else begin
           Screen.Cursor := crDefault;
           Cursor := crDefault;
         end;
  else Cursor:=crDefault;
end;
Repaint;
if (ssLeft in Shift) then
begin
  ReleaseCapture;
  Panel1.Perform(WM_SysCommand,fSysCmd,0); //<- And here's the heart of the whole component!
end;
Align := Re_align;
end
end;

procedure TForm1.FormShow(Sender: TObject);
begin
fsyscmd:=0;
fenablesizing:=True;
fenablemoving:=True;
end;

end.
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 6261751
Oops, I left a 'Repaint' in there. You can remove it.

And to be consistent,

Panel1.Perform(....

should be

(Sender as TPanel).Perform(....
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

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…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

705 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

18 Experts available now in Live!

Get 1:1 Help Now