Модальные окна

← →
Strech (2005-06-02 09:09) [0]

Приветствую!
помогите отобразить окно созданное функцией CreateWindow() модально.

← →
Digitman © (2005-06-02 09:24) [1]

посмотри как это делает сам Борланд в методе TCustomForm.ShowModal (модуль Forms)

← →
Strech (2005-06-02 09:32) [2]

а я ничего там не понял

← →
Digitman © (2005-06-02 09:38) [3]

> Strech (02.06.05 09:32) [2]

как это "не понял" ?

так не бывает - тут понял, а тут не понял)

что не понял-то ? конкретно ?

← →
3-PO (2005-06-02 18:29) [4]

> Strech (02.06.05 09:32) [2]

А ты уверен что поймешь если тебе тут кто-то объяснит?

Отличий от не модального вывода нет, просто обработка сообщений окна идет локально в функции ShowModal, и управление из функции возвращается, когда окно пользователь закрывает.

← →
Abessalom (2005-06-02 20:52) [6]

Во-первых, совсем необязательно создавать окна именно при помощи CreateWindow - также подойдет и DialogBox*** - создать шаблон в памяти, создать элементы управления и показать + дополнительно есть возможность визуального редактирования окна диалога на стадии разработки, например в программе ResourceWorkShop или BC++5, и проч. Рекомендую.
Во вторых - можно опереться на свои реализации, привожу примитивный но дорабатываемый пример. Мне разумеется неизвестно, ни как хранятся дескрипторы в вашем приложении, ни как создаются окна, поэтому я сделал все по наитию. Разумеется есть варианты. Тот же метод TCustomForm.ShowModal - построение списка отключаемых окон, и далее по тексту...

unit wasmWindow;

interface uses Windows, SysUtils, Classes, Messages;

type

TWindow = class
private
FHandle: THandle;
FIsModal: Boolean;
FIsUnderModal: Boolean;
public
procedure WndProc(var Message: TMessage); virtual;
constructor Create(Parent: THandle); virtual;
function Show: Boolean; virtual;
function ShowModal: Boolean; virtual;
destructor Destroy; override;
end;

var
QueueMessage: TMsg;
MainWindow: THandle = 0;
WindowList: TList;

procedure ProcessMessages;
function CreateWindow(Parent: THandle): TWindow;

implementation

function CreateWindow(Parent: THandle): TWindow;
begin
Result := TWindow.Create(Parent);
Result.Show;
end;

procedure ProcessMessages;
begin
while GetMessage(QueueMessage, 0, 0, 0) do begin
TranslateMessage(QueueMessage);
DispatchMessage(QueueMessage);
end;
end;

{ TWindow }

constructor TWindow.Create(Parent: THandle);
var
WCE, WCE_: TWndClassEx;
begin
FillChar(WCE, SizeOf(WCE), 0);
with WCE do begin
cbSize := SizeOf(WCE);
style := CS_VREDRAW or CS_HREDRAW or CS_DBLCLKS;
lpfnWndProc := @DefWindowProc;
lpszClassName := PChar(string(ClassName));
hbrBackground := GetStockObject(WHITE_BRUSH);
hIcon := LoadIcon(SysInit.HInstance, IDI_APPLICATION);
hCursor := LoadCursor(SysInit.HInstance, IDC_ARROW);
end;
if not GetClassInfoEx(HInstance, WCE.lpszClassName, WCE_) then begin
if (RegisterClassEx(WCE) = 0) then
RaiseLastOSError;
end;
FHandle := CreateWindowEx(0, WCE.lpszClassName, WCE.lpszClassName,
WS_POPUPWINDOW or WS_CAPTION or WS_THICKFRAME,
CW_USEDEFAULT, CW_USEDEFAULT, 600, 400, Parent, 0, 0, nil);
if FHandle = 0 then
RaiseLastOSError;
SetWindowLong(FHandle, GWL_WNDPROC, Integer(MakeObjectInstance(WndProc)));
if MainWindow = 0 then MainWindow := FHandle;
WindowList.Add(Self);
end;

destructor TWindow.Destroy;
var
I: Integer;
begin
if FIsModal then begin
FIsModal := False;
// не поддерживает наложение модальных окон, если
// закрываем одно, то прочие бывшие модальными
// становятся немодальными как все
for I := 0 to WindowList.Count - 1 do
TWindow(WindowList[I]).FIsUnderModal := False;
end;
SetWindowLong(FHandle, GWL_WNDPROC, Integer(@DefWindowProc));
WindowList.Remove(Self);
DestroyWindow(FHandle);
if MainWindow = FHandle then PostQuitMessage(0);
inherited;
end;

function TWindow.Show: Boolean;
begin
Result := ShowWindow(FHandle, SW_SHOWNORMAL);
end;

function TWindow.ShowModal: Boolean;
var
I: Integer;
W: TWindow;
begin
Result := ShowWindow(FHandle, SW_SHOWNORMAL);
FIsModal := True;
for I := 0 to WindowList.Count - 1 do begin
W := TWindow(WindowList[I]);
if W <> Self then
W.FIsUnderModal := True;
end;
end;

procedure TWindow.WndProc(var Message: TMessage);

procedure Flash;
var
pfwi: FLASHWINFO;
I: Integer;
begin
pfwi.cbSize := SizeOf(pfwi);

for I := WindowList.Count - 1 downto 0 do
with TWindow(WindowList[I]) do
if FIsModal then begin
pfwi.hwnd := FHandle;
Break;
end;

pfwi.dwFlags := FLASHW_CAPTION or FLASHW_TIMER;
pfwi.dwTimeout := 100;
pfwi.uCount := 3;
FlashWindowEx(pfwi);
MessageBeep(0)
end;

procedure Default;
begin
with Message do
Result := DefWindowProc(FHandle, Msg, wParam, lParam)
end;

begin
with Message do
case Msg of
WM_CLOSE, WM_DESTROY, WM_QUIT: Free;
WM_LBUTTONDBLCLK: CreateWindow(MainWindow).ShowModal;
WM_MOUSEACTIVATE:
if FIsUnderModal then begin
Result := MA_NOACTIVATEANDEAT;
Flash;
end
else
Default;
else
Default
end;
end;

initialization

WindowList := TList.Create;

finalization

WindowList.Free;

end.

Модальные окна Найти похожие ветки