Текущий архив: 2004.12.26;
Скачать: CL | DM;

Вниз

Блокировка щелчка мышью в заголовке окна (формы)   Найти похожие ветки 

← →
Delph ©   (2004-11-11 08:42) [0]

Как сделать так, чтобы при двойном щелчке мышью в области заголовка окна ничего не происходило? По умолчанию окно изменяет размеры.

---

← →
Семен Сорокин ©   (2004-11-11 08:47) [1]

BorderStyle = bsDialog
:)

---

← →
Delph ©   (2004-11-11 10:16) [2]

----------------------
Семен Сорокин

BorderStyle = bsDialog мне не подходиттак как при установке этого свойства окно не разворачивается на весь  экран (не закрывает панель задач), а мне надо чтобы окно было на весь экран и блокировались щелчки мыши.

Во всяком случае спасибо за ответ. )

---

← →
Семен Сорокин ©   (2004-11-11 10:19) [3]

{
 Модуль: FullScreenUnit

 Описание: Поддержка разворота клиентской части окна во весь экран.
           Источник: статья Пола Дилация в MSDN Magazine № 6(12) 2002 г.

 Особенности использования: Окно, клиентская часть которого должна быть
                            развернута во весь экран, должно обрабатывать
                            сообщение WM_GETMINMAXINFO и устанавливать
                            свой максимальный размер больше, чем размер
                            экрана.

 Авторы: Пол Дилация (С++, MFC), Игорь Шевченко (Delphi)

 Дата создания: 09.01.2003

 История изменений:
}
unit FullScreenUnit;

interface
uses
Windows, Controls;

type
TFullScreenHandler = class
private
  FRestoreRect : TRect;
  function GetInFullScreenMode : Boolean;
  function GetMaxSize : SIZE;
public
  { Развернуть клиентскую область окна во весь экран }
  procedure Maximize (AWinControl : TWinControl);
  { Восстановить клиентскую область окна }
  procedure Restore (AWinControl : TWinControl);
  { Развернута ли клиентская область окна во весь экран }
  property InFullScreenMode : Boolean read GetInFullScreenMode;
  { Максимально возможный размер о! кна, такой, чтобы клиентская область
    уместилась во весь экран. }
  property MaxSize : SIZE read GetMaxSize;
end;

var
FullScreenHandler : TFullScreenHandler;

implementation
uses
Forms; { Для Screen }

function TFullScreenHandler.GetInFullScreenMode : Boolean;
begin
Result := not IsRectEmpty(FRestoreRect);
end;

function TFullScreenHandler.GetMaxSize : SIZE;
var
ARect : TRect;
begin
{
При большом желании обращение к свойствам переменной Screen можно заменить
на вызовы функции GetSystemMetrics(SM_CXSCREEN) и
GetSystemMetrics(SM_CYSCREEN).
}
SetRect(ARect, 0, 0, Screen.Width, Screen.Height);
InflateRect(ARect, 10, 50); //Любые числа, лишь бы превышали размер
                            //неклиентской области окон
Result.cx := ARect.Right - ARect.Left;
Result.cy := ARect.Bottom - ARect.Top;
end;

procedure TFullScreenHandler.Maximize (AWinControl : TWinControl);
var
RcClient, RcNewWindow : TRect;
begin
RcClient := AWinControl.ClientRect;
{ Перевод координат клиентской области окна в экранные }
MapWindowPoints(AWinControl.Handle, HWND_DESKTOP, RcClient, 2);
{ Сохраним размеры окна для восстановления }
GetWindowRect(AWinControl.Handle, FRestoreRect);
{
При большом желании обращение к свойствам переменной Screen можно заменить
на вызовы функции GetSystemMetrics(SM_CXSCREEN) и
GetSystemMetrics(SM_CYSCREEN).
}
SetRect(RcNewWindow, 0, 0, Screen.Width, Screen.Height);
with RcNewWindow do begin
  Inc(Left, FRestoreRect.Left - RcClient.Left);
  Inc(Top, FRestoreRect.Top - RcClient.Top);
  Inc(Right, FRestoreRect.Right! - RcClient.Right);
  Inc(Bottom, FRestoreRect.Bottom - RcClient.Bottom);
  SetWindowPos (AWinControl.Handle, 0, Left, Top, Right - Left, Bottom - Top,
                SWP_NOZORDER);
end;
end;

procedure TFullScreenHandler.Restore (AWinControl : TWinControl);
begin
with FRestoreRect do
  SetWindowPos (AWinControl.Handle, 0, Left, Top, Right - Left, Bottom - Top,
                SWP_NOZORDER);
SetRectEmpty(FRestoreRect);
end;

initialization
FullScreenHandler := TFullScreenHandler.Create();
finalization
FullScreenHandler.Free();
end.

Пример использования:

TfMain = class(TForm)
  MainMenu: TMainMenu;
  View1: TMenuItem;
  miFullScreen: TMenuItem;
  Image: TImage;
  miHelp: TMenuItem;
  About: TMenuItem;
  procedure miFullScreenClick(Sender: TObject);
  procedure ImageDblClick(Sender: TObject);
  procedure AboutClick(Sender: TObject);
private
  procedure WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
                                                   message WM_GETMINMAXINFO;
end;
.....
procedure TfMain.miFullScreenClick(Sender: TObject);
begin
if NOT FullScreenHandler.InFullScreenMode then
  FullScreenHandler.Maximize(Self)
else
  FullScreenHandler.Restore(Self);
miFullScreen.Checked := FullScreenHandler.InFullScreenMode;
end;

procedure TfMain.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
var
Sz : SIZE;
begin
Sz := FullScreenHandler.MaxSize;
with Message.MinMaxInfo^ do begin
  ptMaxSize := TPoint(Sz);
  ptMaxTrackSize := TPoint(Sz);
end;
end;

---

← →
easy ©   (2004-11-11 10:19) [4]

WM_NCLBUTTONDBLCLK

---

← →
grom   (2004-11-11 21:54) [5]

public { Public declarations }
   procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

 procedure TForm1.Sys(var M:TMessage);
 begin
  if M.wParam=61490 then exit;
 inherited;
 end;
может так

---

← →
grom   (2004-11-11 22:20) [6]

public { Public declarations }
  procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

procedure TForm1.Sys(var M:TMessage);
begin
 if M.wParam=61490 then exit;
 if M.wParam=61730 then exit;
inherited;
end;
может так

---

← →
Игорь Шевченко ©   (2004-11-11 23:18) [7]

WM_SYSCOMMAND

---

← →
Игорь Шевченко ©   (2004-11-11 23:21) [8]

В дополнение к [7] смотреть 4 младшие бита wParam, сравнивать с HTCAPTION

easy ©   (11.11.04 10:19) [4]

NC - это не только заголовок, но еще и иконка в левом углу, например

---

← →
Delph ©   (2004-11-12 04:30) [9]

Спасибо всем!
----------------------------------------------
grom

public { Public declarations }
 procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

procedure TForm1.Sys(var M:TMessage);
begin
if M.wParam=61490 then exit;
if M.wParam=61730 then exit;
inherited;
end;
может так
---------------------------------------------

После двойного щелчка пользователь может перетаскивать форму за заголовок

Сделал так:

public { Public declarations }
 procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

procedure TForm1.Sys(var M:TMessage);
begin
if M.wParam=61490 then exit;
if M.wParam=61730 then exit;
inherited;
end;

procedure TForm1.FormCreate(Sender: TObject); //При создании формы
var
 hmenuhandle:hmenu; //дескриптор меню
begin
hmenuhandle := getsystemmenu(handle, false);
if (hmenuhandle <> 0) then deletemenu(hmenuhandle,SC_MOVE, mf_bycommand); //запрет переместить
end;

---

← →
Delph ©   (2004-11-12 06:10) [10]

Модифицировал:

public { Public declarations }
procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

procedure TForm1.Sys(var M:TMessage);
begin
if M.wParam=sc_close then Close;
end;

procedure TForm1.FormCreate(Sender: TObject); //При создании формы
var
hmenuhandle:hmenu; //дескриптор меню
begin
hmenuhandle := getsystemmenu(handle, false);
if (hmenuhandle <> 0) then deletemenu(hmenuhandle,SC_MOVE, mf_bycommand); //запрет переместить
end;

Если чего не учёл, то дайте знать.

Спасибо!

---

← →
Delph ©   (2004-11-12 08:14) [11]

> grom   (11.11.04 22:20) [6]
> public { Public declarations }
>   procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
> .....
>
> procedure TForm1.Sys(var M:TMessage);
> begin
>  if M.wParam=61490 then exit;
>  if M.wParam=61730 then exit;
> inherited;
> end;
> может так


Просто ради интереса.
Как узнал\получил числа:

M.wParam=61490
M.wParam=61730

Заранее благодарен.

---

← →
grom   (2004-11-12 19:33) [12]

public { Public declarations }
 procedure Sys(var M:TMessage);message WM_SYSCOMMAND;
.....

procedure TForm1.Sys(var M:TMessage);
begin
Caption := IntToStr(M.wParam);
inherited;
end;
получение числа

---

← →
grom   (2004-11-12 19:37) [13]

запрет переместить
Align:=alCustom

---

Страницы: 1 вся ветка

Текущий архив: 2004.12.26;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.023 c