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

Вниз

Почему у меня программа завершает свою работу не всегда...   Найти похожие ветки 

← →
WebErr ©   (2004-03-24 13:49) [0]

... а только тогда, когда я нажимаю пункт меню с идентификатором 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.


---

← →
WebErr ©   (2004-03-24 14:31) [1]

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

---

← →
Игорь Шевченко ©   (2004-03-24 14:42) [2]

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

---

← →
WebErr ©   (2004-03-24 14:47) [3]

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

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

---

← →
WebErr ©   (2004-03-24 14:59) [4]

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

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;

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

---

← →
Adder ©   (2004-03-24 15:07) [5]

Попробуй
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 15:29) [6]

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

---

← →
ssaqwe   (2004-03-24 16:30) [7]

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.

---

← →
Игорь Шевченко ©   (2004-03-24 16:33) [8]

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 отличий :)

---

← →
WebErr ©   (2004-03-24 16:47) [9]

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

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

---

← →
Игорь Шевченко ©   (2004-03-24 17:01) [10]

WebErr ©   (24.03.04 16:47)

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

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

---

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

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

Наверх

Память: 0.5 MB
Время: 0.06 c