Текущий архив: 2005.03.20;
Скачать: CL | DM;
Вниз
Реализация ShowModal Найти похожие ветки
← →
a.denisov (2005-03-08 16:15) [0]Добрый день, мастера!
Собственно, не вопрос, а крик души, так сказать. Все время, пока программирую на дельфи, мне абсолютно не нравится стандартное поведение форм приложения при вызове ShowModal - почему-то не заложена такая обыкновенная реакция, как мерцание окна при попытке выполнить действия с любой другой формой кроме модальной. Дело вкуса, так сказать.
Пока не вижу подводных камней, но сделать поведение форм "нормальным", с моей точки зрения, оказалось не так уж трудно (при том что моя реализация - почти полная копия ShowModal, где ради простоты эксперимента, выполняются не все действия)
Вопрос: где подводные камни, которые помешали Borland сделать, ну, как минимум, также как в нижеприведенном коде?
type
PPTaskWindow = ^PTaskWindow;
PTaskWindow = ^TTaskWindow;
TTaskWindow = record
Next: PTaskWindow;
Window: HWnd;
end;
TFormAccess = class(TForm)
end;
const
WndProcProp = "WndProc";
RefCountProp = "UpdateCount";
RefCountNull = 1;
procedure FlashModalWindow(Window: HWND);
var
pfwi : FLASHWINFO;
begin
pfwi.cbSize := SizeOf(pfwi);
pfwi.hwnd := Window;
pfwi.dwFlags := FLASHW_CAPTION;
pfwi.uCount := 4;
pfwi.dwTimeout := 75;
FlashWindowEx(pfwi);
MessageBeep(MB_OK);
end;
function ModalStateWindowProc(Window: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
WndProc : Cardinal;
procedure Default;
begin
Result := CallWindowProc(Pointer(WndProc), Window, Msg, wParam, lParam);
end;
begin
WndProc := GetProp(Window, WndProcProp);
if WndProc = 0 then
Result := CallWindowProc(@DefWindowProc, Window, Msg, wParam, lParam)
else
case Msg of
WM_MOUSEACTIVATE:
if Assigned(Screen.ActiveForm) then begin
Result := MA_NOACTIVATEANDEAT;
FlashModalWindow(Screen.ActiveForm.Handle);
end
else
Default;
WM_NCHITTEST: begin
Default;
Result := HTCLIENT;
end;
else
Default
end;
end;
function HookWindow(Window: HWnd; Data: Longint): Bool; stdcall;
var
P : PTaskWindow;
PP : PPTaskWindow;
WndProc, RefCount : Cardinal;
begin
if IsWindowVisible(Window) then begin
New(P);
PP := PPTaskWindow(Data);
P^.Next := PTaskWindow(PP^);
P^.Window := Window;
WndProc := GetWindowLong(P^.Window, GWL_WNDPROC);
if (WndProc <> Cardinal(@ModalStateWindowProc)) then begin
SetProp(P.Window, WndProcProp, WndProc);
SetProp(P.Window, RefCountProp, RefCountNull);
SetWindowLong(P^.Window, GWL_WNDPROC, Cardinal(@ModalStateWindowProc));
end
else begin
RefCount := GetProp(P.Window, RefCountProp);
SetProp(P.Window, RefCountProp, RefCount + 1);
end;
PP^ := P;
end;
Result := True;
end;
procedure UnhookTaskWindows(WindowList: Pointer);
var
P : PTaskWindow;
WndProc, RefCount : Cardinal;
begin
while WindowList <> nil do begin
P := WindowList;
if IsWindow(P.Window) then begin
WndProc := GetProp(P^.Window, WndProcProp);
if (WndProc <> 0) then begin
RefCount := GetProp(P.Window, RefCountProp);
if RefCount <> RefCountNull then
SetProp(P.Window, RefCountProp, RefCount - 1)
else begin
SetWindowLong(P.Window, GWL_WNDPROC, WndProc);
RemoveProp(P.Window, RefCountProp);
RemoveProp(P.Window, WndProcProp);
end;
end;
end;
WindowList := P.Next;
Dispose(P);
end;
end;
function HookTaskWindows: Pointer;
begin
try
Result := nil;
EnumThreadWindows(GetCurrentThreadID, @HookWindow, Integer(@Result));
except
UnhookTaskWindows(Result);
Result := nil;
raise;
end
end;
function ShowModalForm(FormClass: TFormClass): TModalResult;
var
Form : TForm;
WindowList : Pointer;
begin
WindowList := HookTaskWindows;
Form := FormClass.Create(Application);
with Form do try
Include(TFormAccess(Form).FFormState, fsModal);
Application.ModalStarted;
try
Show;
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
repeat
Application.HandleMessage;
if Application.Terminated then
ModalResult := mrCancel;
until ModalResult <> 0;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
finally
Hide;
end;
finally
UnhookTaskWindows(WindowList);
Application.ModalFinished;
end;
finally
Free;
end;
end;
← →
Fenik (2005-03-08 16:39) [1]А что? Это стандарт Windows шоб мигало.
← →
a.denisov (2005-03-08 16:47) [2]Вот именно что стандарт. А мигает ли при стандартном вызове ShowModal? Просто выдается звуковой сигнал MB_OK. О чем и речь, что Борланд не мигать не хочет)
← →
Fenik (2005-03-08 16:50) [3]А! Я почему-то наоборот понял :)
Действительно, почему не мигает?
← →
a.denisov (2005-03-08 17:10) [4]Не мигает потому что вызывается EnableWindow(Handle,False) - для всех форм кроме модальной. Самый простой вариант, не подразумевающий никакой другой обработки.
← →
GanibalLector © (2005-03-08 17:11) [5]> что Борланд не мигать не хочет
А он то тут при чем? ИМХО,это принципы ОС. Покажите мне,кто(какая программа) мигает!
← →
a.denisov (2005-03-08 17:12) [6]Или вот интересная (возможность?непонятка):
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Enabled := False;
Form2.ShowModal;
Form1.Enabled := True;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
Form1.Enabled := True;
end;
← →
a.denisov (2005-03-08 17:24) [7]А раз сигнал подает - тогда почему не должна мигать?)
Естественное обращение внимания пользователя на открытую модальную форму. Не знаю, по-моему в оффисе (у меня дома не установлен, не проверю) все на принципе одна модальная форма открыта - при попытке переключения на любую другую форму - модальная мигает. Я согласен, что даже MessageBox мерцает, только если задели его родительское окно - но на то он и MessageBox)
В общем, мне симпатичнее так. Вроде и проблем не должно быть. Если есть замечания по коду, плиз)
← →
Плохиш © (2005-03-08 17:56) [8]У меня в офисе ничего не мигает.
← →
a.denisov (2005-03-08 18:11) [9]Офис какой? Хотя я могу ошибиться. А вообще неважно. Элементарное поведение MessageBox - мерцание при переключении на родительское окно - и то не реализовано в ShowModal. Если видишь разницу между тем, что и как делает ShowModal и тем, какую реализацию предлагаю я...) Я бы остановился на моей) Ладно, кому как нравится.
Страницы: 1 вся ветка
Текущий архив: 2005.03.20;
Скачать: CL | DM;
Память: 0.49 MB
Время: 0.055 c
