PopupMenu в пограмме без формы.

← →
Начинающий2 (2004-11-30 16:18) [0]

Как добавить PopupMenu в программу без формы. Программа должна висеть в трее, а из меню должно вызываться моё меню настроек из Dll.

← →
Jedi © (2004-11-30 17:53) [1]

Используй CoolTrayIcon

← →
DVM © (2004-11-30 18:11) [2]

> Как добавить PopupMenu в программу без формы.

Никак. Сообщения кто будет обрабатывать и выбор пункта меню отслеживать?
Сделай скрытое окно если очень надо.

← →
abc (2004-11-30 18:49) [3]

program cdOpenER;
uses Windows, Messages, ShellApi, MMSystem;
{$R winxp.res}
{$R ico.res}
type tip= array[0..5]of char;
var wc : TWndClassEx;
MainWnd, mmenu, pmenuo ,pmenuc ,pmenus : HWND;
Mesg : TMsg;
Buf, curdir : array[0..500]of char;
i, j ,x ,y : Integer;
poin : tpoint;
str1: tip;
icone : TNOTIFYICONDATA;
function OpenCD(Drive : Char) : Boolean;
Var Err : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Result:=false;
S:=Drive+":";
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := "CDAudio";
lpstrElementName := PChar(S);
end;
Err := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Err<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Err:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
IF Err=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;
function CloseCD(Drive : Char) : Boolean;
Var Err : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Result:=false;
S:=Drive+":";
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := "CDAudio";
lpstrElementName := PChar(S);
end;
Err := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Err<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Err:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
IF Err=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm));
end;
end;
procedure drives(var stri:tip);
var p : integer;
begin
j:=0;
GetLogicalDriveStrings(sizeof(buf),buf);
for p:= 0 to length(buf) do
if GetDriveType(pchar(buf[p]+":\"))=DRIVE_CDROM then begin
stri[j]:=buf[p];
inc(j);
end;
end;
function creatmen : boolean;
begin
mmenu:=createpopupmenu;
pmenuo:=createmenu;
pmenuc:=createmenu;
pmenus:=createmenu;
for i:= 0 to j-1 do begin
insertmenu(pmenuo,word(-1),mf_ByPosition,Wm_user+1+i,pchar(str1[i]+":\"));
insertmenu(pmenuc,word(-1),mf_ByPosition,Wm_user+7+i,pchar(str1[i]+":\"));
end;
appendmenu(mmenu,mf_Popup,pmenuo,"open");
appendmenu(mmenu,mf_Popup,pmenuc,"close");
insertmenu(pmenus,word(-1),mf_ByPosition,Wm_user+21,"about");
insertmenu(pmenus,word(-1),mf_ByPosition,Wm_user+24,"help");
insertmenu(pmenus,word(-1),mf_ByPosition,Wm_user+23,"refresh");
insertmenu(pmenus,word(-1),mf_ByPosition,Wm_user+22,"exit");
appendmenu(mmenu,mf_Popup,pmenus,"options");
end;
function WindowProc(wnd:HWND; Msg : Cardinal; Wparam:Wparam; Lparam:Lparam):Lresult;
stdcall;
Begin
case msg of
wm_user+31 :
case lparam of
WM_RBUTTONDOWN :
begin
getcursorpos(poin);
x:=poin.x;
y:=poin.y;
SetForegroundWindow(Wnd);
TrackPopupMenuEx(mMenu,0,x, y,Wnd, Nil);
end;
end;
wm_destroy :
Begin
Shell_NotifyIcon(nim_delete,@icone);
postquitmessage(0);
exit;
Result:=0;
End;
wm_Command :
case wparam of
//......opencd........
wm_user+ 1 : opencd(str1[0]);
wm_user+ 2 : opencd(str1[1]);
wm_user+ 3 : opencd(str1[2]);
wm_user+ 4 : opencd(str1[3]);
wm_user+ 5 : opencd(str1[4]);
//......closecd.......
wm_user+ 7 : closecd(str1[0]);
wm_user+ 8 : closecd(str1[1]);
wm_user+ 9 : closecd(str1[2]);
wm_user+10 : closecd(str1[3]);
wm_user+11 : closecd(str1[4]);
//...other..command...
wm_user+21 : messagebox(wnd,"(c) mNtek 2004","about",mb_ok);
wm_user+22 :
begin
Shell_NotifyIcon(nim_delete,@icone);
postquitmessage(0);
end;
wm_user+23 :
begin
drives(str1);
creatmen;
end;
wm_user+24 : if
shellexecute(wnd,"open","help.txt",nil,curdir,SW_SHOW)=ERROR_FILE_NOT_FOUND
then messagebox(wnd,"couldn""t find help.txt","error",mb_ok);
end;
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;
End;
var xPos,yPos,nWidth,nHeight : Integer;
begin
if findwindow("CdOpenER","CdOpenER")<>0 then exit;
drives(str1);
getcurrentdirectory(sizeof(curdir),curdir);
with wc do begin
cbSize:=sizeof(wc);
style:=cs_hredraw or cs_vredraw;
lpfnWndProc:=@WindowProc;
cbClsExtra:=0;
cbWndExtra:=0;
hInstance:=HInstance;
hIcon:=ExtractIcon(hinstance,"cdOpenER.exe",0);
hCursor:=LoadCursor(0,idc_arrow);
hbrBackground:=COLOR_BTNFACE+1;
lpszMenuName:=nil;
lpszClassName:="CdOpenER";
end;
creatmen;
RegisterClassEx(wc);
xPos:=0;
yPos:=0;
nWidth:=200;
nHeight:=50;
MainWnd:=CreateWindowEx(0,"CdOpenER","CdOpenER",
WS_OVERLAPPED or WS_SYSMENU,xPos,yPos,nWidth,nHeight,0,0,
Hinstance,nil);
with Icone do begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := mainwnd;
uID := wm_user+72;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon := ExtractIcon(hinstance,"cdOpenER.exe",0);
uCallbackMessage := WM_User+31;
sztip:="CdOpenER";
end;
Shell_NotifyIcon(nim_add,@icone);
ShowWindow(MainWnd,sw_hide);
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
end.

2 abc (30.11.04 18:49) [3]

Делов-то.... :о)

← →
Начинающий2 (2004-12-01 20:22) [5]

Спасибо за код abc. Буду разбираться что к чему.

PopupMenu в пограмме без формы. Найти похожие ветки