www.pudn.com > MapLegend.rar > MapLegend_PanelEx.pas
//Resizeable , Moveable panel at runtime.
unit MapLegend_PanelEx;
interface
uses
Windows, SysUtils, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
Type
TShow = Set of (AtMovingTime,ResizeButton, TrasparentButtons);//,JumpButton,MenuButton,TrasparentButtons);
TAllow = set of (Down,MoveX,MoveY,ResizeX,ResizeY);
TButtonStyle=(bsOffice97,bsStandard);
TWhoToMove=(wmSelf,wmParent);
TJumpPosition=(jpTopLeft,jpTopRight,jpBottomLeft,jpBottomRight,jpUser);
TJumpParent=(jtBorder,jtClientArea);
TPanelEx=class(TPanel)
Private
FAllow:TAllow;
FShow:TShow;
B97:TButtonStyle;
FloatStatus,Moving:Boolean;
fResizing:boolean;
OldX,OldY,OldLeft,OldTop:Integer;
ScreenDC:HDC;
MoveRect:TRect;
FMoveWho:TWhoToMove;
TTT:TJUMPParent;
clNull,JB_C,FCornerColor,jp_c,//Color of the Corner
FHiColor,FLoColor:TColor;//Color of the Border
BAlign:TAlign;
FBorderHeight:integer;// Border size
VertXs:array[1..4] of integer; // VERT X
VertYs:array[1..4] of integer; // VERT Y
FCornerDim:integer; // DIMENSION of CORNER
Mouse_M:TMouseButton; //THE Button THAT ALLOW YOU MOVING IT
FMaxWidth,FMaxHeight,FMinWidth,FMinHeight:integer; // MAX, MIN Width AND Height
FPOPC,FOnJump,FOnReturn,FOnfail,FMoving:TNotifyEvent;
BW,MPS:integer;
function CanStartMove(X,Y:integer):boolean;
function CanStartCorner(X,Y:integer):boolean;
procedure DrawTopButton(HI,LO:TColor);
procedure DrawLeftButton(HI,LO:TColor);
procedure DrawBottomButton(HI,LO:TColor);
procedure DrawRightButton(HI,LO:TColor);
procedure DrawAllButtons(H,L:TColor);
procedure DrawCorner(H,L:TColor);
procedure StartMoving(X,Y:integer);
procedure Move_PanelLO(X,Y:integer);
procedure EndMoving(X,Y:integer);
procedure StartResizing(X,Y:integer);
procedure ResizingCorner(X,Y:integer);
procedure EndResizing(X,Y:integer);
Procedure DrawBorders(H,L:TColor);
procedure CMMouseEnter(var Message: TMessage); message CM_MouseENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MouseLEAVE;
Protected
procedure Paint; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Property Allow:TAllow read FAllow write FAllow;
Property WhatToShow:TShow read FShow write FShow;
property WhatToMove:TWhoToMove read FMoveWho write FMoveWho;
Public
constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); override;
Function IsFloating:Boolean;
Published
property MouseButtonMove:TMouseButton read Mouse_M write Mouse_M;
property ColorHI:TColor read FHiColor write FHiColor;
property ColorLO:TColor read FLoColor write FLoColor;
property ButtonAlign:TAlign read BAlign write BAlign;
property CornerDimension:integer read FCornerDim write FCornerDim;
property CornerColor:TColor read FCornerColor write FCornerColor;
Property MaxWidth:integer read FMaxWidth write FMaxWidth;
Property MaxHeight:integer read FMaxHeight write FMaxHeight;
Property MinWidth:integer read FMinWidth write FMinWidth;
Property MinHeight:integer read FMinHeight write FMinHeight;
Property BorderHeight:integer read FBorderHeight write FBorderHeight;
property OnMoving: TNotifyEvent read FMoving write FMoving;
property OnReturn:TNotifyEvent read FOnReturn write FOnReturn;
end;
implementation
procedure TPanelEx.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opRemove) then
begin
FPOPC := NIL;
FOnJump := NIL;
FOnReturn := NIL;
FOnfail := NIL;
FMoving := NIL;
end;
end;
procedure TPanelEx.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Enabled And (B97 = bsOffice97) then
begin
DrawBorders(FHiColor,FLoColor);
if (ResizeButton IN fshow) then
DrawCorner(FHiColor,FLoColor);
end;
end;
procedure TPanelEx.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Enabled And (B97 = bsOffice97) then
begin
DrawBorders(FHiColor, FLoColor);//(clNull,clNull);
if (ResizeButton IN fshow) then
DrawCorner(FHiColor, FLoColor);//(clNull,clNull);
end;
end;
procedure TPanelEx.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (NOT LOCKED) AND (Button=Mouse_M) then
begin
if CanStartCorner(X,Y) then
StartResizing(X,Y)
else if CanStartMove(X,Y) then
StartMoving(X,Y);
end
else
inherited MouseDown(Button,Shift,X,Y);
end;
procedure TPanelEx.MouseMove(Shift: TShiftState; X,Y: Integer);
begin
inherited MouseMove(Shift,X,Y);
if NOT LOCKED then
begin
if fResizing then
ResizingCorner(X,Y)
else
if Moving then
begin
Move_PanelLO(X,Y);
If Assigned(ONMOVING) then
FMoving(Self);
end;
end;
end;
procedure TPanelEx.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=Mouse_M then
begin
if MOVING then
EndMoving(X,Y)
else if fResizing then
EndResizing(X,Y)
end
else
inherited MouseUp(Button,Shift,X,Y);
end;
Function TPanelEx.IsFloating:Boolean;
Begin
Result:=FloatStatus;
End;
Constructor TPanelEx.Create(AOwner: TComponent);
Begin
Inherited Create(Aowner);
Randomize;
fResizing:=False;
if (csDesigning in ComponentState) then
begin
//inherited; //This is a serious line error from original code.
BorderWidth:=5;
BorderHeight:=5;
Color:=clBtnFace;
FHiColor:=clBtnHighLight;
FloatStatus:=FALSE;
FLoColor:=clBtnShadow;
BAlign:=alClient;
FCornerDim:=10;
BW:=12;
FCornerColor:=clAppWorkspace;
jb_c:=clAppWorkspace;
jp_c:=clAppWorkspace;
clNull:=clGrayText;
MPS:=10;
ControlStyle := ControlStyle + [csOpaque];
end;
WhatToShow:=[AtMovingTime,ResizeButton];
Allow:=[Down,MoveX,MoveY,ResizeX,ResizeY];
End;
DESTRUCTOR TPanelEx.Destroy;
begin
Inherited Destroy;
end;
procedure TPanelEx.Paint;
var
H,L:TColor;
R:TRECT;
Begin
VertXs[1]:=0;
VertYs[1]:=0;
VertXs[2]:=BorderWidth;
VertYs[2]:=FBorderHeight;
VertXs[3]:=Width-1*BorderWidth;
VertYs[3]:=Height-1*FBorderHeight;
VertXs[4]:=Width-1;
VertYs[4]:=Height-1;
H:=FHiColor;
L:=FLoColor;
LockWindowUpdate(Canvas.Handle);
With Canvas Do
Begin
Brush.Color:=Color;
Pen.Color:=Color;
r := Rect(0,0,Width,Height);
Canvas.FillRect(r);
if (not fResizing) then// and Assigned(USBIT[4]) then
Begin
if TTT=jtBorder then
begin
R.Top:=VertYs[2]+1;
R.Left:=VertXs[2]+1;
R.Right:=VertXs[3]-1;
R.Bottom:=VertYs[3]-1;
End
Else
begin
R.Top:=0;
R.Left:=0;
R.Right:=width;
R.Bottom:=height;
End;
End;
DrawBorders(H,L);
if (ResizeButton IN fshow) then
DrawCorner(FHiColor,FLoColor);
end;
LockWindowUpdate(0);
end;
Procedure TPanelEx.DrawBorders(H,L:TColor);
Begin
CASE ButtonALIGN of
alTop:begin
if MOVING AND (Down in FAllow) then
DrawTopButton(L,H)
else
DrawTopButton(H,L);
DrawBottomButton(H,L);
DrawRightButton(H,L);
DrawLeftButton(H,L);
end;
alBottom:begin
DrawTopButton(H,L);
if MOVING AND (Down in FAllow) then
DrawBottomButton(L,H)
else
DrawBottomButton(H,L);
DrawRightButton(H,L);
DrawLeftButton(H,L);
end;
alLeft:begin
DrawTopButton(H,L);
DrawBottomButton(H,L);
DrawRightButton(H,L);
if MOVING AND (Down in FAllow) then
DrawLeftButton(L,H)
else
DrawLeftButton(H,L);
end;
alRight:begin
DrawTopButton(H,L);
DrawBottomButton(H,L);
if MOVING AND (Down in FAllow) then
DrawRightButton(L,H)
else
DrawRightButton(H,L);
DrawLeftButton(H,L);
end;
alNone,alClient:
if (B97=bsStandard) or Moving then
DrawAllButtons(L,H)
Else
DrawAllButtons(H,L);
end;
End;
procedure TPanelEx.DrawCorner(H,L:TColor);
begin
WITH CANVAS DO
begin
//Draw CORNER AREA
Pen.Color:=FCornerColor;
Brush.Color:=FCornerColor;
if Not (TrasparentButtons in FShow) then
Begin
RECTANGLE(VertXs[3],VertYs[4]-FCornerDim,VertXs[4],VertYs[4]);
RECTANGLE(VertXs[4]-FCornerDim,VertYs[3],VertXs[4],VertYs[4]);
End;
//Draw Border
if fResizing AND (Down in FAllow) then
Pen.Color:=L
else
Pen.Color:=H;
Moveto(VertXs[4],VertYs[4]-FCornerDim);
Lineto(VertXs[3]-1,VertYs[4]-FCornerDim);
LineTo(VertXs[3]-1,VertYs[3]-1);
LineTo(VertXs[3]-1+BorderWidth-FCornerDim,VertYs[3]-1);
LineTo(VertXs[3]-1+BorderWidth-FCornerDim,VertYs[4]);
if fResizing AND (Down in FAllow) then
Pen.Color:=H
else
Pen.Color:=L;
Moveto(VertXs[4],VertYs[4]-FCornerDim);
Lineto(VertXs[4],VertYs[4]);
LineTo(VertXs[4]-FCornerDim,VertYs[4]);
end;
end;
procedure TPanelEx.DrawTopButton(HI,LO:TColor);
begin
WITH CANVAS DO
begin
//2 HORIZONTAL LINES
Pen.Color:=HI;
Moveto(VertXs[1],VertYs[1]);
Lineto(VertXs[4],VertYs[1]);
Pen.Color:=LO;
Moveto(VertXs[2],VertYs[2]);
Lineto(VertXs[3],VertYs[2]);
//CHECK if IT IS A Button
if ButtonALIGN=alTop then
begin
Pen.Color:=HI;
Moveto(VertXs[1]+1,VertYs[1]);
Lineto(VertXs[2]+1,VertYs[2]);
Pen.Color:=LO;
Moveto(VertXs[4]-1,VertYs[1]);
Lineto(VertXs[3]-1,VertYs[2]);
end;
end;
end;
procedure TPanelEx.DrawBottomButton(HI,LO:TColor);
begin
WITH CANVAS DO
begin
//2 HORIZONTAL LINES
Pen.Color:=HI;
Moveto(VertXs[2],VertYs[3]);
Lineto(VertXs[3],VertYs[3]);
Pen.Color:=LO;
Moveto(VertXs[1],VertYs[4]);
Lineto(VertXs[4],VertYs[4]);
//CHECK if IT IS A Button
if ButtonALIGN=alBottom then
begin
Pen.Color:=HI;
Moveto(VertXs[1]+1,VertYs[4]);
Lineto(VertXs[2]+1,VertYs[3]);
Pen.Color:=LO;
Moveto(VertXs[4]-1,VertYs[4]);
Lineto(VertXs[3]-1,VertYs[3]);
end;
end;
end;
procedure TPanelEx.DrawLeftButton(HI,LO:TColor);
begin
WITH CANVAS DO
begin
//2 VERTICAL LINES
Pen.Color:=HI;
Moveto(VertXs[1],VertYs[1]);
Lineto(VertXs[1],VertYs[4]);
Pen.Color:=LO;
Moveto(VertXs[2],VertYs[2]);
Lineto(VertXs[2],VertYs[3]);
//CHECK if IT IS A Button
if ButtonALIGN=alLeft then
begin
Pen.Color:=HI;
Moveto(VertXs[1],VertYs[1]+1);
Lineto(VertXs[2],VertYs[2]+1);
Pen.Color:=LO;
Moveto(VertXs[1],VertYs[4]-1);
Lineto(VertXs[2],VertYs[3]-1);
end;
end;
end;
procedure TPanelEx.DrawRightButton(HI,LO:TColor);
begin
WITH CANVAS DO
begin
//2 VERTICAL LINES
Pen.Color:=HI;
Moveto(VertXs[3],VertYs[2]);
Lineto(VertXs[3],VertYs[3]);
Pen.Color:=LO;
Moveto(VertXs[4],VertYs[1]);
Lineto(VertXs[4],VertYs[4]);
//CHECK if IT IS A Button
if ButtonALIGN=alRight then
begin
Pen.Color:=HI;
Moveto(VertXs[3],VertYs[2]+1);
Lineto(VertXs[4],VertYs[1]+1);
Pen.Color:=LO;
Moveto(VertXs[3],VertYs[3]-1);
Lineto(VertXs[4],VertYs[4]-1);
end;
end;
end;
procedure TPanelEx.DrawAllButtons(H,L:TColor);
//var
// r : TRect;
begin
With Canvas Do
Begin
//Draw HI ColorS
if MOVING AND (Down in FAllow) then
Pen.Color:=L
else
Pen.Color:=H;
Moveto(VertXs[1],VertYs[4]);
Lineto(VertXs[1],VertYs[1]);
Lineto(VertXs[4],VertYs[1]);
Moveto(VertXs[2],VertYs[3]);
Lineto(VertXs[3],VertYs[3]);
Lineto(VertXs[3],VertYs[2]);
//Draw LO ColorS
if MOVING AND (Down in FAllow) then
Pen.Color:=H
else
Pen.Color:=L;
Moveto(VertXs[2],VertYs[3]);
Lineto(VertXs[2],VertYs[2]);
Lineto(VertXs[3],VertYs[2]);
Moveto(VertXs[1],VertYs[4]);
Lineto(VertXs[4],VertYs[4]);
Lineto(VertXs[4],VertYs[1]);
end;
end;
//SOME NECESSARY functionS AND procedureS...
function TPanelEx.CanStartMove(X,Y:integer):boolean;
begin
CASE BAlign of
alBottom:CanStartMove:=Y>=Height-BorderWidth;
alClient:CanStartMove:=(X<=FBorderHeight) OR (Y>=Height-BorderWidth) OR
(X>=Width-BorderWidth) OR (Y<=FBorderHeight);
alLeft:CanStartMove:=X<=BorderWidth;
alRight:CanStartMove:=X>=Width-BorderWidth;
alTop:CanStartMove:=Y<=FBorderHeight;
else
CanStartMove:=TRUE; //alNone
end;
end;
function TPanelEx.CanStartCorner(X,Y:integer):boolean;
begin
CanStartCorner:=(ResizeButton IN fshow) AND (( (X>=VertXs[3]) AND (Y>=VertYs[4]-FCornerDim) AND (X<=VertXs[4]) AND (Y<=VertYs[4]) ) OR
( (X>=VertXs[4]-FCornerDim) AND (Y>=VertYs[3]) AND (X<=VertXs[4]) AND (Y<=VertYs[4]) ));
end;
procedure TPanelEx.StartMoving(X,Y:integer);
begin
if LOCKED then
EXIT;
//YOU ARE NOW ALLOWED TO MOVE THE CONTROL
OldX := X;
OldY := Y;
OldLeft := X;
OldTop := Y;
MOVING:=TRUE;
if (AtMovingTime IN fshow) then
DrawBorders(FHiColor,FLoColor)//Paint
else
begin
SetCapture(Self.Handle);
if WhatToMove=wmParent then
begin
if Parent=Screen.ActiveForm then
ScreenDC:=GetDC(0)
else
ScreenDC:=GetDC(Parent.Parent.Handle);
end
else
ScreenDC:=GetDC(Parent.Handle);
if WhatToMove=wmParent then
MoveRect:=Rect(Parent.Left,Parent.Top,Parent.Left+Parent.Width,Parent.Top+Parent.Height)
else
MoveRect:=Rect(Self.Left,Self.Top,Self.Left+Self.Width,Self.Top+Self.Height);
DrawFocusRect(ScreenDC,MoveRect);
end;
end;
procedure TPanelEx.Move_PanelLO(X,Y:integer);
var
DIFFX,DIFFY:integer;
begin
if (AtMovingTime IN fshow) then
begin
DIFFX:=X-OLDX;
DIFFY:=Y-OLDY;
if WhatToMove=wmParent then
begin
if (MoveX in FAllow) then
Parent.Left:=Parent.Left+DIFFX;
if (MoveY in FAllow) then
Parent.Top:=Parent.Top+DIFFY;
end
else
begin
if (MoveX in FAllow) then
Left:=Left+DIFFX;
if (MoveY in FAllow) then
Top:=Top+DIFFY;
end;
end
else
begin
DrawFocusRect(ScreenDC,MoveRect);
if (MoveX in FAllow) then
OldX:=X;
if (MoveY in FAllow) then
OldY:=Y;
if WhatToMove=wmParent then
MoveRect:=Rect(Parent.Left+OldX-OldLeft,Parent.Top+OldY-OldTop,
Parent.Left+Parent.Width+OldX-OldLeft,Parent.Top+Parent.Height+OldY-OldTop)
else
MoveRect := Rect(Self.Left+OldX-OldLeft,Self.Top+OldY-OldTop,
Self.Left+Self.Width+OldX-OldLeft,Self.Top+Self.Height+OldY-OldTop);
DrawFocusRect(ScreenDC,MoveRect);
end;
end;
procedure TPanelEx.EndMoving(X,Y:integer);
begin
Moving := False;
if (AtMovingTime IN fshow) then
DrawBorders(FHiColor,FLoColor)//
//PAINT
else
begin
ReleaseCapture;
DrawFocusRect(ScreenDC,MoveRect);
if WhatToMove = wmParent then
begin
if (Parent.Left <> Parent.Left+X+OldLeft) or (Parent.Top <> Parent.Top+Y-OldTop) then
begin
Parent.Visible := False;
if (MoveX in FAllow) then
Parent.Left := Parent.Left+X-OldLeft;
if (MoveY in FAllow) then
Parent.Top := Parent.Top+Y-OldTop;
Parent.Visible := True;
end;
end
else
begin
if (Self.Left <> Self.Left+X+OldLeft) or (Self.Top <> Self.Top+Y-OldTop) then
begin
Self.Visible := False;
if (MoveX in FAllow) then
Self.Left := Self.Left+X-OldLeft;
if (MoveY in FAllow) then
Self.Top := Self.Top+Y-OldTop;
Self.Visible := True;
end;
end;
ReleaseDC(0,ScreenDC);
end;
end;
procedure TPanelEx.StartResizing(X,Y:integer);
begin
fResizing:=TRUE;
OLDX:=X;
OLDY:=Y;
DrawCorner(FHiColor,FLoColor);
end;
procedure TPanelEx.ResizingCorner(X,Y:integer);
var
R,DIFFX,DIFFY:integer;
begin
DIFFX:=X-OLDX;
DIFFY:=Y-OLDY;
if (ResizeX in FAllow) then
begin
R:=Width+DIFFX;
if (FMaxWidth>0) AND (FMinWidth>0) then
begin
if RFMaxWidth then
R:=FMaxWidth;
end;
//CONTROLLA QUESTE SEMPRE
if R0) AND (FMinHeight>0) then
begin
if RFMaxHeight then
R:=FMaxHeight;
end;
//CONTROLLA QUESTE SEMPRE
if R