2011. március 13., vasárnap

Disable form movement when the screen resolution exceeds 800x600 pixel


Problem/Question/Abstract:

How to disable form movement when the screen resolution exceeds 800x600 pixel

Answer:

Handle the WM_NCHittest and change the HTCaption to HTNowhere. An example, which doesn't allow a form to be moved if the screen resolution is larger than 800x600 pixel:

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    procedure Exit1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DontMove(var Msg: TMessage); message WM_NCHITTEST;
    procedure DeleteItemsFromSysMenu;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DeleteItemsFromSysMenu;
var
  SysMenuHwnd: THandle;
  i: integer;
begin
  SysMenuHwnd := GetSystemMenu(Form1.Handle, False);
  {Have to be done in reverse order because if not the numbering would be
        different each time the function is called}
  for i := 6 downto 0 do
    DeleteMenu(SysMenuHwnd, i, MF_BYPOSITION);
end;

procedure TForm1.DontMove(var Msg: TMessage);
var
  bAllowMove: Boolean;
begin
  bAllowMove := (Screen.Width >= 800);
  inherited;
  if (Msg.Result <> htReduce) and (Msg.Result <> htClose) and (Msg.Result <> htSysMenu)
    then
    if (Msg.Result = htCaption) and (not bAllowMove) then
      Msg.Result := htNowhere;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  DeleteItemsFromSysMenu;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése