Argh! IconTray og XP?
Hej igen igen..Jeg får denne Debugger Exception Notification :
Project PopCheck.exe raised exception class EAccessViolation with message 'Access violation at address 004087C9 in module 'PopCheck.exe'. Read of address 00000000'. Process stopped. Use Step or Run to continue.
.. når jeg prøver at køre mit ganske glimrende program :
"PopCheck.dpr"
--------------
program PopCheck;
uses
Windows,
Forms,
Dialogs,
Unit1 in 'Unit1.pas' {FormPopCheck};
{$R *.res}
type
TGlobalData = record
H : hWnd;
end; // record
pGlobalData = ^TGlobalData;
const
Name : PChar='PopCheck';
var
MapHandle : THandle;
GlobalData : pGlobalData;
begin
MapHandle:=CreateFileMapping(HWND($FFFFFFFF),nil,PAGE_READWRITE,0,1024,Name);
GlobalData:=MapViewOfFile(MapHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TGlobalData));
if GetLastError<>ERROR_ALREADY_EXISTS then begin
Application.Initialize;
Application.Title:='PopCheck';
Application.CreateForm(TFormPopCheck,FormPopCheck);
GlobalData^.H:=Application.MainForm.Handle;
Application.ShowMainForm:=false;
Application.Run;
UnMapViewOfFile(GlobalData);
CloseHandle(MapHandle);
end
else begin
SetForegroundWindow(GlobalData^.H); // <- unødvendig?
PostMessage(GlobalData^.H,WM_PopChk,0,0);
end; // if
end.
_______________________________________________________________
"Unit1.pas"
-----------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ImgList, Menus, ShellAPI;
const
WM_PopChk = WM_USER+$0001;
WM_IconMessage = WM_USER;
type
TFormPopCheck = class(TForm)
ImageForm: TImage;
LabelCaption: TLabel;
LabelStatus: TLabel;
ImageListIcons: TImageList;
ShapeBar: TShape;
ImageClose: TImage;
PopupMenu: TPopupMenu;
Options1: TMenuItem;
N1: TMenuItem;
Checkfornewmailnow1: TMenuItem;
N2: TMenuItem;
Exit1: TMenuItem;
procedure WMPopChk(var Message: TMessage); message WM_PopChk;
procedure CloseForm;
procedure HideForm;
procedure FormCreate(Sender: TObject);
procedure ShapeBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Options1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
nid: TNotifyIconData;
procedure InitializeNID;
procedure IconTray(var Msg: TMessage); message WM_IconMessage;
end;
var
FormPopCheck: TFormPopCheck;
AppHint: PChar;
implementation
{$R *.dfm}
procedure TFormPopCheck.InitializeNID;
begin
ShowWindow(Application.Handle,SW_HIDE);
Icon.Handle:=LoadIcon(HInstance,'MAINICON');
nid.cbSize:=sizeof(nid);
nid.wnd:=Handle;
nid.uID:=1; // icon ID
nid.uCallBAckMessage:=WM_IconMessage;
nid.hIcon:=Icon.Handle;
nid.uFlags:=nif_Message or nif_Icon or nif_Tip;
strcopy(nid.szTip,AppHint);
Shell_NotifyIcon(NIM_ADD,@nid);
end;
procedure TFormPopCheck.IconTray(var msg: TMessage);
var
Pt : TPoint;
begin
if Msg.lParam=WM_RButtonDown then begin
GetCursorPos(Pt);
PopupMenu.Popup(Pt.x,Pt.y);
end;
if Msg.lParam=WM_LButtonDblClk then Options1Click(self);
end;
procedure TFormPopCheck.WMPopChk(var Message: TMessage);
begin
ShowWindow(Handle,SW_SHOWNORMAL);
Show;
SetForegroundWindow(Handle);
end;
procedure TFormPopCheck.CloseForm;
begin
InitializeNID;
ShowWindow(Handle,SW_HIDE);
end;
procedure TFormPopCheck.HideForm;
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
FullRgn, ClientRgn, CtlRgn : HRGN;
begin
Margin:=(Width-ClientWidth) div 2;
FullRgn:=CreateRectRgn(0,0,Width,Height);
X:=Margin;
Y:=Height-ClientHeight-Margin;
ClientRgn:=CreateRectRgn(X,Y,X+ClientWidth,Y+ClientHeight);
CombineRgn(FullRgn,FullRgn,ClientRgn,RGN_DIFF);
for A:=0 to ControlCount-1 do begin
AControl:=Controls[A];
if (AControl is TWinControl) or (AControl is TGraphicControl) then with AControl do begin
if Visible then begin
CtlX:=X+Left;
CtlY:=Y+Top;
CtlRgn:=CreateRectRgn(CtlX,CtlY,CtlX+Width,CtlY+Height);
CombineRgn(FullRgn,FullRgn,CtlRgn,RGN_OR);
end; // if
end; // with
end; // for
SetWindowRgn(Handle,FullRgn,TRUE);
end;
procedure TFormPopCheck.FormCreate(Sender: TObject);
begin
InitializeNID;
AppHint:='PopCheck';
ImageListIcons.GetIcon(1,Application.Icon);
LabelStatus.Caption:='';
HideForm;
end;
procedure TFormPopCheck.ShapeBarMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(FormPopCheck.Handle,wm_SysCommand,$f012,0);
end;
procedure TFormPopCheck.ImageCloseMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
CloseForm;
end;
procedure TFormPopCheck.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caNone;
CloseForm;
end;
procedure TFormPopCheck.Options1Click(Sender: TObject);
begin
nid.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE,@nid);
ShowWindow(Handle,sw_ShowNormal);
SetForegroundWindow(Handle);
Show;
end;
procedure TFormPopCheck.Exit1Click(Sender: TObject);
begin
nid.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE,@nid);
Application.Terminate;
end;
procedure TFormPopCheck.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then FormPopCheck.Close;
end;
procedure TFormPopCheck.FormShow(Sender: TObject);
begin
InitializeNID;
ShowWindow(Application.Handle,SW_HIDE);
end;
end.
_______________________________________________________________
Programmet breaker ved denne linje :
GlobalData^.H:=Application.MainForm.Handle;
Jeg mener jo nok selv at det bare skulle virke, men jeg har slemt på fornemmelsen, at Windows XP har en finger med i spillet. HAR jeg lavet en fejl, eller ER det XP?
Hvad er fejlen, og hvis det er Windows XP der er skyld i det, hvad kan jeg så gøre for at få det til at køre?
Håber I kan hjælpe.
Mvh.
/Mnc
