mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
697 lines
19 KiB
ObjectPascal
697 lines
19 KiB
ObjectPascal
unit PCFormRoll;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
|
|
|
|
type
|
|
EError = class(Exception);
|
|
|
|
TRollerMode = ( mdRollDown, mdRollUp );
|
|
TRollerNotifyEvent = procedure ( Sender: TObject; mode: TRollerMode ) of object;
|
|
|
|
TPCRoller = class(TComponent)
|
|
private
|
|
{ Private declarations }
|
|
DefWinProc: TFarProc;
|
|
DefWinProcInstance: Pointer;
|
|
FEnabled: Boolean;
|
|
FOnRoller: TRollerNotifyEvent;
|
|
// FOnFormDestroy: TNotifyEvent;
|
|
FRoller: Boolean;
|
|
FVisible: Boolean;
|
|
FRemainHeight: Integer;
|
|
|
|
ButtonRect: TRect;
|
|
DrawPushed: Boolean;
|
|
Pushed: Boolean;
|
|
RestoreWndProc: Boolean;
|
|
rgn: HRGN;
|
|
OwnerHandle: THandle;
|
|
|
|
procedure CalcArea;
|
|
function GetShortHeight: Integer;
|
|
function HookMainWndProc( var Msg: TMessage ): Boolean;
|
|
procedure HookWndProc;
|
|
procedure UnHookWndProc;
|
|
// procedure OnRollerDestroy( Sender: TObject );
|
|
procedure PaintRollerButton;
|
|
procedure Rollup;
|
|
procedure SetEnabled( Val: Boolean );
|
|
procedure SetRoller( Val: Boolean );
|
|
procedure SetVisible( Val: Boolean );
|
|
procedure WinProc(var Msg: TMessage);
|
|
procedure SetRemainHeight( Val: Integer );
|
|
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(Owner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
{ Published declarations }
|
|
property Enabled: Boolean read FEnabled write SetEnabled;
|
|
property RemainHeight: Integer read FRemainHeight write SetRemainHeight;
|
|
property Roller: Boolean read FRoller write SetRoller default False;
|
|
property Visible: Boolean read FVisible write SetVisible default True;
|
|
property OnRoller: TRollerNotifyEvent read FOnRoller write FOnRoller;
|
|
end;
|
|
|
|
var
|
|
si: UINT;
|
|
|
|
implementation
|
|
|
|
const
|
|
WM_ROLLREDRAW = WM_USER + 2000;
|
|
WM_PAINTEDGE = WM_USER + 2001;
|
|
WM_RECREATE = WM_USER + 2002;
|
|
WM_ROLLER_BUTTON_DOWN = WM_USER + 2003;
|
|
|
|
|
|
constructor TPCRoller.Create(Owner: TComponent);
|
|
begin
|
|
inherited;
|
|
FRoller := False;
|
|
FVisible := True;
|
|
DrawPushed := False;
|
|
Pushed := False;
|
|
FRemainHeight := 0;
|
|
// if not (csDesigning in ComponentState) then
|
|
// begin
|
|
Application.HookMainWindow( HookMainWndProc );
|
|
// FOnFormDestroy := TForm(Owner).OnDestroy;
|
|
// TForm(Owner).OnDestroy := OnRollerDestroy;
|
|
// end;
|
|
HookWndProc;
|
|
end;
|
|
|
|
destructor TPCRoller.Destroy;
|
|
//var
|
|
// proc: TNotifyEvent;
|
|
begin
|
|
// if not (csDesigning in ComponentState) then
|
|
Application.UnhookMainWindow( HookMainWndProc );
|
|
// proc := OnRollerDestroy;
|
|
// if Assigned(Owner) and (@proc = @TForm(Owner).OnDestroy) then
|
|
// TForm(Owner).OnDestroy := FOnFormDestroy;
|
|
UnHookWndProc;
|
|
inherited;
|
|
if csDesigning in ComponentState then
|
|
SetWindowPos( OwnerHandle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_DRAWFRAME or
|
|
SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE );
|
|
// ReDrawWindow( OwnerHandle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW );
|
|
end;
|
|
|
|
procedure TPCRoller.HookWndProc;
|
|
begin
|
|
OwnerHandle := TForm(Owner).Handle;
|
|
rgn := 0;
|
|
if not (Owner is TForm) then
|
|
raise EError.Create('Class of the owner is not a TForm!');
|
|
with TForm(Owner) do
|
|
// if not (csDesigning in ComponentState) then
|
|
begin
|
|
DefWinProcInstance := MakeObjectInstance(WinProc);
|
|
DefWinProc := Pointer(SetWindowLong(OwnerHandle, GWL_WNDPROC, Longint(DefWinProcInstance)));
|
|
RestoreWndProc := False;
|
|
CalcArea;
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.UnHookWndProc;
|
|
begin
|
|
if RestoreWndProc then Exit;
|
|
RestoreWndProc := True;
|
|
// if not (csDesigning in ComponentState) then
|
|
// begin
|
|
SetWindowLong( OwnerHandle, GWL_WNDPROC, Longint(DefWinProc) );
|
|
FreeObjectInstance( DefWinProcInstance );
|
|
// end;
|
|
if rgn <> 0 then
|
|
DeleteObject( rgn );
|
|
rgn := 0;
|
|
end;
|
|
|
|
function TPCRoller.HookMainWndProc( var Msg: TMessage ): Boolean;
|
|
begin
|
|
Result := False;
|
|
if Msg.Msg = WM_RECREATE then
|
|
begin
|
|
if Msg.lParam <> longint(Self) then exit;
|
|
HookWndProc;
|
|
// UpdateCaption;
|
|
end;
|
|
end;
|
|
(* If the TPCRoller is created dynamically, it's destructor don't *)
|
|
(* be called automatically when the owner form is free. So must be *)
|
|
(* triggered the UnHookWndProc by this event . *)
|
|
(*
|
|
procedure TPCRoller.OnRollerDestroy( Sender: TObject );
|
|
begin
|
|
SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, Longint(DefWinProc));
|
|
FreeObjectInstance(DefWinProcInstance);
|
|
RestoreWndProc := True;
|
|
if Assigned( FOnFormDestroy ) then
|
|
FOnFormDestroy( Sender );
|
|
end;
|
|
*)
|
|
procedure TPCRoller.CalcArea;
|
|
var
|
|
x1, y1, x2, y2: Integer;
|
|
Icons: TBorderIcons;
|
|
Style: TFormBorderStyle;
|
|
AWidth: Integer;
|
|
wr: TRect;
|
|
// Style, ExStyle: UINT;
|
|
begin
|
|
// Style := GetWindowLong( TForm(Owner).Handle, GWL_STYLE );
|
|
// ExStyle := GetWindowLong( TForm(Owner).Handle, GWL_EXSTYLE );
|
|
with TForm(Owner) do
|
|
begin
|
|
GetWindowRect( OwnerHandle, wr );
|
|
AWidth := wr.Right - wr.Left;
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
Icons := [biSystemMenu, biMinimize, biMaximize];
|
|
Style := bsSizeable;
|
|
end
|
|
else
|
|
begin
|
|
Icons := BorderIcons;
|
|
Style := BorderStyle;
|
|
end;
|
|
end;
|
|
if Style in [bsSizeToolWin, bsToolWindow] then
|
|
begin
|
|
if Style = bsToolWindow then
|
|
x2 := GetSystemMetrics(SM_CXFIXEDFRAME) + 2
|
|
else
|
|
x2 := GetSystemMetrics(SM_CXSIZEFRAME) + 2;
|
|
if biSystemMenu in Icons then
|
|
Inc(x2, GetSystemMetrics(SM_CXSMSIZE) + 2);
|
|
if Style = bsToolWindow then
|
|
y1 := GetSystemMetrics(SM_CYFIXEDFRAME) + 2
|
|
else
|
|
y1 := GetSystemMetrics(SM_CYSIZEFRAME) + 2;
|
|
y2 := y1 + GetSystemMetrics(SM_CYSMSIZE) - 4;
|
|
x2 := AWidth - x2;
|
|
x1 := x2 - GetSystemMetrics(SM_CXSMSIZE) + 2;
|
|
end
|
|
else
|
|
begin
|
|
if Style in [bsSingle, bsSizeable, bsDialog] then
|
|
begin
|
|
if Style = bsSingle then
|
|
x2 := GetSystemMetrics(SM_CYFIXEDFRAME) + 2
|
|
else
|
|
x2 := GetSystemMetrics(SM_CXSIZEFRAME) + 2;
|
|
if biSystemMenu in Icons then
|
|
begin
|
|
Inc(x2, GetSystemMetrics(SM_CXSIZE) + 2);
|
|
if (Style <> bsDialog) and (Icons * [biMinimize, biMaximize] <> []) then
|
|
Inc(x2, GetSystemMetrics(SM_CXSIZE) * 2 - 6)
|
|
else if biHelp in Icons then
|
|
Inc(x2, GetSystemMetrics(SM_CXSIZE) - 4);
|
|
end;
|
|
if Style in [bsSingle, bsDialog] then
|
|
y1 := GetSystemMetrics(SM_CYFIXEDFRAME) + 2
|
|
else
|
|
y1 := GetSystemMetrics(SM_CYSIZEFRAME) + 2;
|
|
y2 := y1 + GetSystemMetrics(SM_CYSIZE) - 4;
|
|
x2 := AWidth - x2;
|
|
x1 := x2 - GetSystemMetrics(SM_CXSIZE) + 2;
|
|
end;
|
|
end;
|
|
SetRect( ButtonRect, x1 - AWidth, y1, x2 - AWidth, y2 );
|
|
end;
|
|
|
|
procedure TPCRoller.PaintRollerButton;
|
|
var
|
|
h, dc: HDC;
|
|
st: UINT;
|
|
p: array[0..2] of TPoint;
|
|
b: HBRUSH;
|
|
r: HRGN;
|
|
rect, OldRect: TRect;
|
|
w: Integer;
|
|
OldBmp, Bmp: HBitmap;
|
|
|
|
procedure DrawTriangle( Up: Boolean; dd: Integer; co: Integer );
|
|
var
|
|
pen: HPEN;
|
|
d, x1, x2, y1, y2: Integer;
|
|
begin
|
|
if DrawPushed then
|
|
d := 1 + dd
|
|
else
|
|
d := 0 + dd;
|
|
with rect do
|
|
begin
|
|
x1 := Left + 1 + d;
|
|
x2 := Right - 3 + d;
|
|
y1 := Top + d;
|
|
y2 := Bottom + d;
|
|
end;
|
|
p[0].x := x1 + 3;
|
|
p[1].x := ((x1 + x2) shr 1);
|
|
p[2].x := p[1].x + p[1].x - p[0].x;
|
|
// p[2].x := x2 - 3;
|
|
if Up then
|
|
begin
|
|
p[0].y := ((y1 + y2) shr 1) - 2;
|
|
p[1].y := y1 + 2;
|
|
p[2].y := p[0].y;
|
|
end
|
|
else
|
|
begin
|
|
p[0].y := ((y1 + y2) shr 1);
|
|
p[1].y := p[0].y + p[1].x - p[0].x;
|
|
// p[1].y := y2 - 4;
|
|
p[2].y := p[0].y;
|
|
end;
|
|
case co of
|
|
0:
|
|
begin
|
|
pen := SelectObject( dc, GetStockObject( BLACK_PEN ) );
|
|
b := SelectObject( dc, GetStockObject( BLACK_BRUSH ) );
|
|
end;
|
|
1:
|
|
begin
|
|
pen := SelectObject( dc, GetStockObject( WHITE_PEN ) );
|
|
b := SelectObject( dc, GetStockObject( WHITE_BRUSH ) );
|
|
end;
|
|
else
|
|
begin
|
|
pen := SelectObject( dc, CreatePen( PS_SOLID, 0, GetSysColor( COLOR_BTNSHADOW ) ) );
|
|
b := SelectObject( dc, GetStockObject( DKGRAY_BRUSH ) );
|
|
end;
|
|
end;
|
|
if (Up and not FRoller) or (not Up and FRoller) then
|
|
PolyGon( dc, p, 3 )
|
|
else
|
|
begin
|
|
Inc( p[2].x );
|
|
if Up then
|
|
Inc( p[2].y )
|
|
else
|
|
Dec( p[2].y );
|
|
PolyLine( dc, p, 3 );
|
|
Inc( p[0].x );
|
|
Dec( p[2].x );
|
|
if Up then
|
|
Inc( p[1].y )
|
|
else
|
|
Dec( p[1].y );
|
|
PolyLine( dc, p, 3 );
|
|
end;
|
|
SelectObject( dc, b );
|
|
if co = 2 then
|
|
DeleteObject( SelectObject( dc, pen ) )
|
|
else
|
|
SelectObject( dc, pen );
|
|
end;
|
|
|
|
begin
|
|
// if not (csDesigning in ComponentState) then
|
|
with TForm(Owner) do
|
|
if not (BorderStyle = bsNone) then
|
|
begin
|
|
GetWindowRect( OwnerHandle, rect );
|
|
w := rect.Right - rect.Left;
|
|
rect.Left := ButtonRect.Left + w;
|
|
rect.Right := ButtonRect.Right + w;
|
|
rect.Top := ButtonRect.Top;
|
|
rect.Bottom := ButtonRect.Bottom;
|
|
if FVisible then
|
|
begin
|
|
h := GetWindowDC( OwnerHandle );
|
|
try
|
|
if h = 0 then Exit;
|
|
dc := CreateCompatibleDC( h );
|
|
try
|
|
if dc = 0 then
|
|
Exit;
|
|
Bmp := CreateCompatibleBitmap( h, rect.Right - rect.Left, rect.Bottom - rect.Top );
|
|
If Bmp = 0 then
|
|
Exit;
|
|
OldRect := rect;
|
|
OffsetRect( rect, -rect.Left, -rect.Top );
|
|
OldBmp := SelectObject( dc, Bmp );
|
|
try
|
|
if DrawPushed then
|
|
st := DFCS_PUSHED
|
|
else
|
|
st := 0;
|
|
DrawFrameControl( dc, rect, DFC_BUTTON, DFCS_BUTTONPUSH or st );
|
|
if FEnabled then
|
|
begin
|
|
DrawTriangle( True, 0, 0 );
|
|
DrawTriangle( False, 0, 0 );
|
|
end
|
|
else
|
|
begin
|
|
DrawTriangle( True, 1, 1 );
|
|
DrawTriangle( False, 1, 1 );
|
|
DrawTriangle( True, 0, 2 );
|
|
DrawTriangle( False, 0, 2 );
|
|
end;
|
|
BitBlt( h, OldRect.Left, OldRect.Top, OldRect.Right - OldRect.Left,
|
|
OldRect.Bottom - OldRect.Top, dc, 0, 0, SRCCOPY);
|
|
finally
|
|
SelectObject( dc, OldBmp );
|
|
end;
|
|
finally
|
|
DeleteDC( dc );
|
|
end;
|
|
finally
|
|
ReleaseDC( OwnerHandle, h );
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
r := CreateRectRgn(
|
|
(* Get the most width of the border *)
|
|
rect.Left - GetSystemMetrics(SM_CXSIZEFRAME),
|
|
0,
|
|
rect.Right,
|
|
rect.Bottom );
|
|
SendMessage( OwnerHandle, WM_NCPAINT, r, 0 );
|
|
DeleteObject( r );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.SetEnabled( Val: Boolean );
|
|
begin
|
|
if Val <> FEnabled then
|
|
begin
|
|
FEnabled := Val;
|
|
PaintRollerButton;
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.SetRemainHeight( Val: Integer );
|
|
begin
|
|
if FRemainHeight <> Val then
|
|
begin
|
|
FRemainHeight := Val;
|
|
if FRoller then
|
|
RollUp;
|
|
end;
|
|
end;
|
|
|
|
function TPCRoller.GetShortHeight: Integer;
|
|
begin
|
|
with TForm(Owner) do
|
|
begin
|
|
if BorderStyle in [bsSingle, bsDialog, bsToolWindow] then
|
|
Result := GetSystemMetrics( SM_CYCAPTION ) +
|
|
GetSystemMetrics(SM_CYFIXEDFRAME) + 3
|
|
else
|
|
Result := GetSystemMetrics( SM_CYCAPTION ) +
|
|
GetSystemMetrics(SM_CYSIZEFRAME) + 3;
|
|
end;
|
|
Inc( Result, FRemainHeight );
|
|
end;
|
|
|
|
|
|
procedure TPCRoller.Rollup;
|
|
var
|
|
r: TRect;
|
|
g: HRGN;
|
|
begin
|
|
begin
|
|
g := rgn;
|
|
GetWindowRect( OwnerHandle, r );
|
|
rgn := CreateRectRgn( 0, 0, r.Right - r.Left, GetShortHeight );
|
|
SetWindowRgn( OwnerHandle, rgn, True );
|
|
if g <> 0 then
|
|
DeleteObject( g );
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.SetRoller( Val: Boolean );
|
|
var
|
|
r: TRect;
|
|
g: HRGN;
|
|
begin
|
|
if FEnabled and (Val <> FRoller) then
|
|
begin
|
|
FRoller := Val;
|
|
if Val then
|
|
begin
|
|
Rollup;
|
|
if Assigned( FOnRoller ) then FOnRoller( Self, mdRollUp );
|
|
end
|
|
else
|
|
begin
|
|
GetWindowRect( OwnerHandle, r );
|
|
g := CreateRectRgn( 0, 0, r.Right - r.Left, GetShortHeight - 3 );
|
|
SetWindowRgn( OwnerHandle, g, True );
|
|
|
|
SetWindowRgn( OwnerHandle, 0, True );
|
|
DeleteObject( g );
|
|
if rgn <> 0 then
|
|
begin
|
|
DeleteObject( rgn );
|
|
rgn := 0;
|
|
end;
|
|
if Assigned( FOnRoller ) then FOnRoller( Self, mdRollDown );
|
|
end;
|
|
PaintRollerButton;
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.SetVisible( Val: Boolean );
|
|
begin
|
|
if Val <> FVisible then
|
|
begin
|
|
FVisible := Val;
|
|
CalcArea;
|
|
if Val then
|
|
PaintRollerButton;
|
|
end;
|
|
end;
|
|
|
|
procedure TPCRoller.WinProc(var Msg: TMessage);
|
|
var
|
|
h: HRGN;
|
|
br, wr: TRect;
|
|
dc: HDC;
|
|
pen: HPEN;
|
|
w: Integer;
|
|
|
|
procedure Default;
|
|
begin
|
|
with Msg do
|
|
Result := CallWindowProc(DefWinProc, OwnerHandle, Msg, wParam, lParam);
|
|
end;
|
|
|
|
function InArea( wr: TRect; InClient: Boolean ): Boolean;
|
|
var
|
|
p, pp: TPoint;
|
|
begin
|
|
p.x := Msg.lParamLo;
|
|
p.y := Smallint(Msg.lParamHi);
|
|
with TForm(Owner) do
|
|
begin
|
|
if InClient then
|
|
p := ClientToScreen( p );
|
|
Dec( p.x, Left );
|
|
Dec( p.y, Top );
|
|
if FormStyle = fsMDIChild then
|
|
begin
|
|
pp.x := 0;
|
|
pp.y := 0;
|
|
Windows.ClientToScreen( Application.MainForm.ClientHandle, pp );
|
|
Dec( p.x, pp.x );
|
|
Dec( p.y, pp.y );
|
|
end;
|
|
end;
|
|
w := wr.Right - wr.Left;
|
|
SetRect( br, ButtonRect.Left + w, ButtonRect.Top, ButtonRect.Right + w, ButtonRect.Bottom );
|
|
Result := PtInRect( br, p );
|
|
end;
|
|
|
|
begin
|
|
if not FVisible then
|
|
Default
|
|
else
|
|
case Msg.Msg of
|
|
WM_SIZE://, WM_WINDOWPOSCHANGED:
|
|
begin
|
|
Default;
|
|
CalcArea;
|
|
if FRoller then
|
|
RollUp;
|
|
end;
|
|
WM_MOUSEMOVE:
|
|
begin
|
|
if Pushed then
|
|
begin
|
|
GetWindowRect( OwnerHandle, wr );
|
|
if not InArea( wr, True ) then
|
|
begin
|
|
if DrawPushed then
|
|
begin
|
|
DrawPushed := False;
|
|
if FEnabled then
|
|
PaintRollerButton;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if not DrawPushed then
|
|
begin
|
|
DrawPushed := True;
|
|
if FEnabled then
|
|
PaintRollerButton;
|
|
end;
|
|
end;
|
|
Msg.Result := 1;
|
|
end
|
|
else
|
|
Default;
|
|
end;
|
|
WM_LBUTTONUP, WM_LBUTTONDBLCLK:
|
|
begin
|
|
DrawPushed := False;
|
|
if Pushed then
|
|
begin
|
|
GetWindowRect( OwnerHandle, wr );
|
|
if InArea( wr, True ) then
|
|
Roller := not FRoller
|
|
else if FEnabled then
|
|
PaintRollerButton;
|
|
Msg.Result := 1;
|
|
end
|
|
else
|
|
Default;
|
|
Pushed := False;
|
|
ReleaseCapture;
|
|
end;
|
|
WM_ROLLER_BUTTON_DOWN:
|
|
begin
|
|
SetCapture( OwnerHandle );
|
|
DrawPushed := True;
|
|
Pushed := True;
|
|
if FEnabled then
|
|
PaintRollerButton;
|
|
Msg.Result := 1;
|
|
end;
|
|
WM_NCLBUTTONDOWN, WM_NCLBUTTONDBLCLK:
|
|
begin
|
|
GetWindowRect( OwnerHandle, wr );
|
|
if InArea( wr, False ) then
|
|
begin
|
|
SendMessage( OwnerHandle, WM_ROLLER_BUTTON_DOWN, 0, 0 );
|
|
if Msg.Msg <> WM_NCLBUTTONDBLCLK then
|
|
Default
|
|
else
|
|
Msg.Result := 1;
|
|
end
|
|
else
|
|
begin
|
|
Default;
|
|
PaintRollerButton;
|
|
end;
|
|
end;
|
|
WM_SETTINGCHANGE, WM_DISPLAYCHANGE(*, WM_WININICHANGE*):
|
|
begin
|
|
Default;
|
|
CalcArea;
|
|
if FRoller then
|
|
Rollup;
|
|
end;
|
|
WM_NCACTIVATE:
|
|
begin
|
|
Default;
|
|
if not TWMNCActivate(Msg).Active then
|
|
PaintRollerButton;
|
|
end;
|
|
WM_NCPAINT:
|
|
begin
|
|
PaintRollerButton;
|
|
dc := GetWindowDC( OwnerHandle );
|
|
(* Don't get the width of window from the TForm's *)
|
|
(* property 'Width', because it is not being updated *)
|
|
GetWindowRect( OwnerHandle, wr );
|
|
w := wr.Right - wr.Left;
|
|
SetRect(
|
|
br,
|
|
w + ButtonRect.Left,
|
|
ButtonRect.Top,
|
|
w + ButtonRect.Right,
|
|
ButtonRect.Bottom );
|
|
GetWindowRect( OwnerHandle, wr );
|
|
h := CreateRectRgnIndirect( wr );
|
|
try
|
|
if SelectClipRgn( dc, Msg.wParam ) = ERROR then
|
|
SelectClipRgn( dc, h );
|
|
OffsetClipRgn( dc, -wr.Left, -wr.Top );
|
|
ExcludeClipRect( dc, br.Left, br.Top, br.Right, br.Bottom );
|
|
OffsetClipRgn( dc, wr.Left, wr.Top );
|
|
GetClipRgn( dc, h );
|
|
Msg.Result := CallWindowProc( DefWinProc, OwnerHandle, Msg.Msg, h, Msg.lParam )
|
|
finally
|
|
DeleteObject( h );
|
|
ReleaseDC( OwnerHandle, dc );
|
|
end;
|
|
if TForm(Owner).FormStyle = fsMDIChild then
|
|
PostMessage( OwnerHandle, WM_ROLLREDRAW, 0, 0 );
|
|
if FRoller then
|
|
PostMessage( OwnerHandle, WM_PAINTEDGE, 0, 0 );
|
|
end;
|
|
WM_ROLLREDRAW:
|
|
begin
|
|
Msg.Result := 1;
|
|
PaintRollerButton;
|
|
end;
|
|
WM_SETCURSOR:
|
|
begin
|
|
Msg.Result := 1;
|
|
case TWMSetCursor(Msg).HitTest of
|
|
HTTOP,
|
|
HTBOTTOM: SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENS)));
|
|
HTLEFT,
|
|
HTRIGHT: SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZEWE)));
|
|
HTTOPRIGHT,
|
|
HTBOTTOMLEFT: SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENESW)));
|
|
HTTOPLEFT,
|
|
HTBOTTOMRIGHT: SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENWSE)));
|
|
else
|
|
Default;
|
|
end;
|
|
end;
|
|
WM_PAINTEDGE: (* Suggestion by Trav *)
|
|
begin
|
|
dc := GetWindowDC( OwnerHandle );
|
|
GetWindowRect( OwnerHandle, wr );
|
|
wr.Right := wr.Right - wr.Left;
|
|
wr.Left := 0;
|
|
wr.Top := 0;
|
|
wr.Bottom := GetShortHeight;
|
|
pen := SelectObject( dc, CreatePen( PS_SOLID, 0, GetSysColor( COLOR_BTNFACE ) ) );
|
|
MoveToEx( dc, 1, wr.Bottom - 3, nil );
|
|
LineTo( dc, wr.Right - 1, wr.Bottom - 3 );
|
|
DeleteObject( SelectObject( dc, pen ) );
|
|
DrawEdge( dc, wr, EDGE_RAISED, BF_LEFT or BF_BOTTOM or BF_RIGHT );
|
|
ReleaseDC( OwnerHandle, dc );
|
|
end;
|
|
WM_DESTROY:
|
|
begin
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
UnHookWndProc;
|
|
PostMessage( Application.Handle, WM_RECREATE, 0, Longint(Self) );
|
|
end;
|
|
Default;
|
|
end;
|
|
else
|
|
Default;
|
|
end;
|
|
end;
|
|
|
|
end.
|