| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Почему у меня программа завершает свою работу не всегда... [WinXP]

WebErr ©   (2004-03-24 13:49:00) 

... а только тогда, когда я нажимаю пункт меню с идентификатором 101 ("&Exit"), а в случае закрытия окна Alt+F4 или нажатием на соответствующий значок в углу окна, виснет! И не хочет завершаться иначе, кроме как Ctrl+F2. Почему?
Вот исходник:

{$R 'My.res' 'My.rc'}

uses
Windows, Messages;

const
 MyClassName = 'MyClassName';
 MyBgColor = $884422;

var
wc: WNDCLASS;
 hbr: HBRUSH;
 hwn: HWND;
 ms: MSG;

function WndProc(hw: HWND; um: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
begin
case um of
  WM_COMMAND:
    case wp and $FFFF of
      101: PostQuitMessage(0);
     end;
   else
   begin
  Result := DefWindowProc(hw, um, wp, lp);
     Exit;
   end;
 end;
Result := 0;
end;

begin
wc.style := CS_HREDRAW or CS_VREDRAW;
 wc.lpfnWndProc := @WndProc;
 wc.cbClsExtra := 0;
 wc.cbWndExtra := 0;
 wc.hInstance := hInstance;
 wc.hIcon := 0;
 wc.hCursor := LoadCursor(0, IDC_ARROW);
 hbr := CreateSolidBrush(MyBgColor);
 wc.hbrBackground := hbr;
 wc.lpszMenuName := 'MyMenu';
 wc.lpszClassName := MyClassName;
 if RegisterClass(wc) = 0 then
 begin
 MessageBox(0, 'Bad', 'Caption', 0);
   Exit;
 end;
 hwn := CreateWindow(MyClassName, 'Something',
           WS_OVERLAPPEDWINDOW, 240, 120, 600, 400,
                     0, 0, hInstance, nil);
 if hwn = 0 then
 begin
 MessageBox(0, 'Bad', 'Caption', 0);
   Exit;
 end;
 ShowWindow(hwn, SW_SHOWNORMAL);
 UpdateWindow(hwn);
 while GetMessage(ms, hwn, 0, 0) do
 begin
 TranslateMessage(ms);
   DispatchMessage(ms);
 end;
 wc.hbrBackground := 0;
 DeleteObject(hbr);
end.


---

Игорь Шевченко   (2004-03-24 17:01:00) [1]

WebErr ©   (24.03.04 16:47)

Давно Петцольд на Delphi начал писать ?

И потом, какая разница-то ?

---

WebErr   (2004-03-24 16:47:00) [2]

> Игорь Шевченко ©   (24.03.04 16:33) [8]

Целиком и полностью идеи взяты из Петзольда, глава 1, программа 1.1! Так что насчёт MyCoolWndProc... :))))

---

Игорь Шевченко   (2004-03-24 16:33:00) [3]

program WinApi;

uses
 Windows, Messages, SysUtils;

{$R *.RES}

function MyCoolWndProc (Window: HWND; Message, WParam: Cardinal;
 LParam: Cardinal): Longint; stdcall;
var
 ps : PAINTSTRUCT;
 DC : HDC;
 r  : TRect;
begin
 case Message of
 WM_DESTROY:
   begin
     PostQuitMessage (0);
     Result := 0;
     Exit;
   end;
 WM_PAINT:
   begin
     dc := BeginPaint (Window, ps);
     try
       TextOut(DC, 0, 0, 'Hello, Windows!', 15);
       SetRect (R, 100, 100, 100, 100);
       DrawText (DC, 'Hello, world!', Length('Hello, world!'), R, DT_CALCRECT);
       SetBkColor (DC, GetSysColor(COLOR_BTNFACE));
       DrawText (DC, 'Hello, world!', Length('Hello, world!'), R,
                 DT_LEFT OR DT_NOPREFIX);
       OffsetRect (R, -1, -1);
       Inc( R.Right, 3);
       Inc( R.Bottom, 2);
       DrawEdge (DC, R, EDGE_ETCHED, BF_RECT);
     finally
       EndPaint (Window, ps);
     end;
   end;
 end;
 Result := DefWindowProc (Window, Message, WParam, LParam);
end;

var WClass : WNDCLASS;
   MyHWND : HWND;
   MyMsg : MSG;

begin
 WClass.hInstance := HInstance;
 WClass.hIcon := 0;
 WClass.hCursor := LoadCursor (0, IDC_ARROW);
 WClass.hbrBackground := HBRUSH(GetStockObject(WHITE_BRUSH));
 WClass.lpfnWndProc := @MyCoolWndProc;
 WClass.lpszClassName := 'MyCoolClass';
 if RegisterClass (WClass) = 0 then begin
   RaiseLastWin32Error;
   Exit;
 end;
 //Окно со стилем WS_EX_TOOLWINDOW на таксбаре не появляется...
 //Окно со стилем WS_EX_APPWINDOW на таксбаре появляется...
 MyHWND := CreateWindowEx (0, 'MyCoolClass', 'MyCoolWindow',
                 WS_OVERLAPPEDWINDOW,
                 Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                 Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                 0, 0, HInstance, nil);
 if MyHWND = 0 then begin
   RaiseLastWin32Error;
   Exit;
 end;
 ShowWindow (MyHWND, SW_SHOWNORMAL);
{
 UpdateWindow (MyHWND); // Это обращение к функции вызывает немедленную посылку
                        // сообщения WM_PAINT
                        // Если вызов этой функции закомментировать, то окно
                        // все равно прорисуется, так как оно большую часть
                        // находится в режиме ожидания.
}
 while GetMessage(MyMsg, 0, 0, 0) do begin
   TranslateMessage (MyMsg);
   DispatchMessage(MyMsg);
 end;
end.


Найди 10 отличий :)

---

ssaqwe   (2004-03-24 16:30:00) [4]

program Project1;

uses
Windows, Messages;

const
MyClassName = 'MyClassName';
MyBgColor = $884422;

var
wc: WNDCLASS;
hbr: HBRUSH;
hwn: HWND;
ms: MSG;

function WndProc(hWin:Cardinal;msg,wpar,lpar:Integer):Integer; stdcall;
begin
case msg of
WM_DESTROY:if hWin=hwn then halt;
end;
Result := DefWindowProc(hWin,msg,wpar,lpar);
end;

begin
wc.style := CS_HREDRAW or CS_VREDRAW;
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := hInstance;
wc.hIcon := 0;
wc.hCursor := LoadCursor(0, IDC_ARROW);
hbr := CreateSolidBrush(MyBgColor);
wc.hbrBackground := hbr;
wc.lpszMenuName := 'MyMenu';
wc.lpszClassName := MyClassName;
if RegisterClass(wc) = 0 then
begin
MessageBox(0, 'Bad', 'Caption', 0);
Exit;
end;
hwn := CreateWindow(MyClassName, 'Something',
WS_OVERLAPPEDWINDOW, 240, 120, 600, 400,
0, 0, hInstance, nil);
if hwn = 0 then
begin
MessageBox(0, 'Bad', 'Caption', 0);
Exit;
end;
ShowWindow(hwn, SW_SHOWNORMAL);
UpdateWindow(hwn);
while GetMessage(ms, hwn, 0, 0) do
begin
TranslateMessage(ms);
DispatchMessage(ms);
end;
wc.hbrBackground := 0;
DeleteObject(hbr);
end.

---

WebErr   (2004-03-24 15:29:00) [5]

А так-то вообще всё логично? В смысле должно ли это работать? :)

---

Adder   (2004-03-24 15:07:00) [6]

Попробуй
while GetMessage(ms, hwn, 0, 0) do
заменить на
while GetMessage(ms, 0, 0, 0) do

If there is an error, the return value is -1. For example, the function fails if hWnd is an invalid window handle.
Note that the function return value can be TRUE, FALSE, or -1. Thus, you should avoid code like this:

while (GetMessage( lpMsg, hWnd, 0, 0)) ...  


The possibility of a -1 return value means that such code can lead to fatal application errors.

---

WebErr   (2004-03-24 14:59:00) [7]

Пытался даже так:

function WndProc(hw: HWND; um: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
begin
case um of
 WM_COMMAND:
   case wp and $FFFF of
     101: PostQuitMessage(0);
    end;
 WM_DESTROY:
   PostQuitMessage(0);
  else
  begin
 Result := DefWindowProc(hw, um, wp, lp);
    Exit;
  end;
end;
Result := 0;
end;

Он просто не выходит из цикла сообщений! :)

---

WebErr   (2004-03-24 14:47:00) [8]

> Игорь Шевченко ©   (24.03.04 14:42) [2]
> Есть вариант обрабатывать WM_DESTROY и вызывать PostQuitMessage
> :)

Тоже виснет, и это, пожалуй, самое печальное!!!

---

Игорь Шевченко   (2004-03-24 14:42:00) [9]

Есть вариант обрабатывать WM_DESTROY и вызывать PostQuitMessage :)

---

WebErr   (2004-03-24 14:31:00) [10]

Есть ещё варианты? :)

---

Наверх