Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.036 c
14-1082839973
Yegorchic
2004-04-25 00:52
2004.05.16
Отпревка SMS


1-1083241514
V-Isa
2004-04-29 16:25
2004.05.16
Scroll в Delphi 3


1-1083082162
solo
2004-04-27 20:09
2004.05.16
Таблицы в .rtf


3-1082388213
volser
2004-04-19 19:23
2004.05.16
Как програмно узнать, установлен ли InterBase


1-1083150293
xm-ad
2004-04-28 15:04
2004.05.16
ГА+коммивояжер





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский