2004. július 24., szombat
Disable the functionality of a TForm to move
Problem/Question/Abstract:
How to disable the functionality of a TForm to move
Answer:
Solve 1:
unit FreezeForm;
interface
uses
Windows, Messages, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls;
type
TFrmFreeze = class(TForm)
BtnValidate: TBitBtn;
BtnSave: TBitBtn;
BtnPreview: TBitBtn;
BtnPrint: TBitBtn;
BtnExit: TBitBtn;
BtnHelp: TBitBtn;
procedure BtnExitClick(Sender: TObject);
private
FOldWindowProc: TWndMethod; {Old WindowProc}
{Window subclassing methods}
procedure HookForm;
procedure UnhookForm;
procedure WndProcForm(var AMsg: TMessage);
protected
procedure CreateWnd; override;
public
destructor Destroy; override;
end;
var
FrmFreeze: TFrmFreeze;
implementation
{$R *.DFM}
procedure TFrmFreeze.CreateWnd;
begin
inherited;
if csDesigning in ComponentState then
Exit; {Don't need to hook when designing}
if Enabled then
begin
HookForm; {Hook the main form's Window}
end;
end;
procedure TFrmFreeze.HookForm;
begin
if csDesigning in ComponentState then
Exit;
FOldWindowProc := WindowProc;
WindowProc := WndProcForm;
end;
procedure TFrmFreeze.UnhookForm;
begin
if csDesigning in ComponentState then
Exit;
{If we are "hooked" then undo what Hookform did}
if Assigned(FOldWindowProc) then
begin
if HandleAllocated then
begin
WindowProc := FOldWindowProc;
end;
FOldWindowProc := nil;
end;
end;
{WndProcForm is our replacement for our WindowProc. We grab any Windows messages
that we need here}
procedure TFrmFreeze.WndProcForm(var AMsg: TMessage);
var
cmdType: Word;
begin
if Enabled then
begin
case AMsg.Msg of
WM_SYSCOMMAND:
begin
cmdType := AMsg.WParam and $FFF0;
case cmdType of
SC_MINIMIZE, SC_MAXIMIZE, SC_MOVE, SC_SIZE:
Exit;
end;
end;
WM_GETMINMAXINFO:
Exit;
end;
end;
{Call the default windows procedure}
FOldWindowProc(AMsg);
end;
destructor TFrmFreeze.Destroy;
begin
if not (csDesigning in ComponentState) then
UnhookForm; {Stop interfering ...}
inherited Destroy;
end;
procedure TFrmFreeze.BtnExitClick(Sender: TObject);
begin
Close;
end;
end.
Solve 2:
procedure TCoolHint2KForm.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
if Message.Result = htCaption then
Message.Result := htNowhere;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése