Виста и ХР
Переписываю свою программу на WinAPI, пока создал только главное окно, но если запустить в ХР, то вылазит ошибка.
Вроде бы ничего и нет кроме окна, кнопок и ListView.
Не подскажите в чем ошибка?
Код:
program POP3MailCheck;
{$R *.res}
{$R WindowsXP.res}
uses
Windows,
Messages,
ShellAPI,
CommCtrl;
const
ProgrammName: PChar = 'POP3 Mail Check 5.0';
type
TUser = record
Name, Server, User, Password, Port: String;
MessageCount: Integer;
end;
var
UsersWindow, WindowCaptionStatic, UsersListView, AddUser, ChangeUser, DeleteUser, OK: HWND;
Font: HFONT;
UsersWindowClass: TWndClassEx;
TheMessage: TMsg;
TmpRect: TRect;
UserListViewColumn1, UserListViewColumn2, UserListViewColumn3: tagLVCOLUMNA;
OldOKWindowProc, OldUsersListViewWindowProc: Pointer;
Users: Array of TUser;
Tray: TNotifyIconData;
function OKWindowProc(Handle: THandle;
Msg, wParam, lParam: LongInt): LongInt; stdcall;
begin
if Msg = WM_LBUTTONUP then
SendMessage(UsersWindow, WM_DESTROY, 0, 0);
Result:=CallWindowProc(OldOKWindowProc, Handle, Msg, wParam, lParam);
end;
function UsersListViewWindowProc(Handle: THandle;
Msg, wParam, lParam: LongInt): LongInt; stdcall;
begin
{
}
Result:=CallWindowProc(OldUsersListViewWindowProc, Handle, Msg, wParam, lParam);
end;
function UsersWindowProc(Wnd: HWND; Msg: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
WndRect: TRect;
begin
Result:=0;
GetWindowRect(Wnd, WndRect);
case Msg of
WM_CREATE:
begin
with Tray do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Wnd;
uID:=13;
uFlags:=NIF_MESSAGE + NIF_ICON + NIF_TIP;
uCallBackMessage:=WM_USER + 13;
end;
Tray.Wnd:=Wnd;
Shell_NotifyIcon(NIM_ADD, @Tray);
end;
WM_CLOSE: ShowWindow(Wnd, SW_HIDE);
WM_DESTROY:
begin
Shell_NotifyIcon(NIM_DELETE, @Tray);
PostQuitMessage(0);
Exit;
end;
WM_NCHITTEST: Result:=HTCAPTION;
else
Result:=DefWindowProc(Wnd, Msg, wParam, lParam);
end;
end;
begin
GetWindowRect(GetDesktopWindow, TmpRect);
with UsersWindowClass do
begin
cbSize:=SizeOf(UsersWindowClass);
lpfnWndProc:=@UsersWindowProc;
cbClsExtra:=0;
cbWndExtra:=0;
hCursor:=LoadCursor(0, IDC_ARROW);
hbrBackground:=COLOR_BTNFACE + 1;
lpszMenuName:=nil;
lpszClassName:='UsersWindow';
end;
UsersWindowClass.hInstance:=HInstance;
RegisterClassEx(UsersWindowClass);
Font:=CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
UsersWindow:=CreateWindowEx(WS_EX_TOOLWINDOW, 'UsersWindow', 'POP3 Mail Check', WS_VISIBLE or WS_POPUP, (TmpRect.Right - 315) div 2, (TmpRect.Bottom - 330) div 2, 315, 330, 0, 0, HInstance, nil);
SetWindowRgn(UsersWindow, CreateRoundRectRgn(0, 0, 315, 330, 15, 15), True);
WindowCaptionStatic:=CreateWindowEx(0, 'Static', ProgrammName, WS_CHILD or SS_LEFT or WS_VISIBLE, 8, 8, 100, 15, UsersWindow, 0, HInstance, nil);
SendMessage(WindowCaptionStatic, WM_SETFONT, WPARAM(Font), 0);
UsersListView:=CreateWindowEx(0, 'SysListView32', 'UsersList', WS_CHILD or LVS_REPORT or WS_BORDER or SS_LEFT or WS_VISIBLE, 8, 32, 297, 225, UsersWindow, 0, HInstance, nil);
AddUser:=CreateWindowEx(0, 'Button', 'Добавить', WS_CHILD or WS_VISIBLE, 8, 264, 89, 25, UsersWindow, 0, HInstance, nil);
SendMessage(AddUser, WM_SETFONT, WPARAM(Font), 0);
ChangeUser:=CreateWindowEx(0, 'Button', 'Изменить', WS_CHILD or WS_DISABLED or WS_VISIBLE, 104, 264, 89, 25, UsersWindow, 0, HInstance, nil);
SendMessage(ChangeUser, WM_SETFONT, WPARAM(Font), 0);
DeleteUser:=CreateWindowEx(0, 'Button', 'Удалить', WS_CHILD or WS_VISIBLE or WS_DISABLED, 208, 264, 89, 25, UsersWindow, 0, HInstance, nil);
SendMessage(DeleteUser, WM_SETFONT, WPARAM(Font), 0);
OK:=CreateWindowEx(0, 'Button', 'ОК', WS_CHILD or WS_VISIBLE, 208, 296, 89, 25, UsersWindow, 0, HInstance, nil);
SendMessage(OK, WM_SETFONT, WPARAM(Font), 0);
OldOKWindowProc:=Pointer(SetWindowLong(OK, GWL_WNDPROC, LongInt(@OKWindowProc)));
OldUsersListViewWindowProc:=Pointer(SetWindowLong(UsersListView, GWL_WNDPROC, LongInt(@UsersListViewWindowProc)));
with UserListViewColumn1 do
begin
pszText:='Учетная запись';
cx:=130;
mask:=6;
end;
with UserListViewColumn2 do
begin
pszText:='Сервер';
cx:=70;
mask:=6;
end;
with UserListViewColumn3 do
begin
pszText:='Пользователь';
cx:=90;
mask:=6;
end;
ListView_InsertColumn(UsersListView, 0, UserListViewColumn1);
ListView_InsertColumn(UsersListView, 1, UserListViewColumn2);
ListView_InsertColumn(UsersListView, 2, UserListViewColumn3);
while GetMessage(TheMessage, 0, 0, 0) do
begin
TranslateMessage(TheMessage);
DispatchMessage(TheMessage);
end;
end.
Ошибка
Цитата:
Runtime error 2 at 00404a84
|
__________________
Что делать, когда сломался комп:
1. Если вы юзер - делать ноги.
2. Если ремонтник - делать деньги.
3. Если вы программист - делать вид, что так было задумано.
|