![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
|
|
#1
|
|||
|
|||
|
Здравствуйте!
Когда я создаю модальные окна с помощью имя_Формы.ShowModal я хочу, что бы окно не двигалось по экрану, а оставалось на заранее определенном месте, и что бы при попытке подвигать его или попытаться скрыть при помощи щелчка мышью за его пределами окно издавало характерный звук, примерно такой какой издают виндоузовские диалоговые окошки. Заранее спасибо за ответ! |
|
#2
|
|||
|
|||
|
Вроде как простой вариант :
1. Присвоить значение свойству FormStyle главной формы приложения fsStayOnTop; 2. В диалоговом окне создать обработчик события WM_NCHITTEST: Код:
uses
Messages,
type
TOKRightDlg = class(TForm)
OKBtn: TButton;
CancelBtn: TButton;
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
public
function Execute : boolean;
end;
implementation
procedure TOKRightDlg.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
with Message do
if Result = HTCAPTION then begin
Result := HTNOWHERE;
end;
end;3. В методе Execute (диалога) указать : Код:
function TOKRightDlg.Execute : boolean;
begin
Result:=false;
Application.NormalizeTopMosts; // ЭТО
if ShowModal = mrOk then begin
Result:=true;
end;
end;4. Вызывать из главной формы так : Код:
procedure TForm1.Button1Click(Sender: TObject); begin Application.BringToFront; OKRightDlg.Execute; end; Вроде бы работает ... |
|
#3
|
|||
|
|||
|
roamer, одного не предусмотрели: Alt+Space -> Переместить
И — хоть заперемещайте окно стрелками. =) А вообще — вот... Код:
...
type
TForm2 = class(TForm) // это ваше модальное окно
private
{ Private declarations }
procedure WMWINDOWPOSCHANGING(var Msg: TMessage); message WM_WINDOWPOSCHANGING;
public
{ Public declarations }
end;
...
procedure TForm2.WMWINDOWPOSCHANGING(var Msg: TMessage);
begin
PWindowPos(Pointer(Msg.LParam))^.flags := PWindowPos(Pointer(Msg.LParam))^.flags or SWP_NOMOVE;
inherited;
end; |
|
#4
|
|||
|
|||
|
Спасибо!!!!!
|