Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

PopupMenu в пограмме без формы. [D6, WinXP]

Начинающий2 © (2004-11-30 16:18:00)
Как добавить PopupMenu в программу без формы. Программа должна висеть в трее, а из меню должно вызываться моё меню настроек из Dll.

Начинающий2 (2004-12-01 20:22:00) [1]
Спасибо за код abc. Буду разбираться что к чему.

Ega23 (2004-11-30 18:51:00) [2]
2 abc (30.11.04 18:49) [3]

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

abc (2004-11-30 18:49:00) [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.

DVM (2004-11-30 18:11:00) [4]

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

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

Jedi (2004-11-30 17:53:00) [5]
Используй CoolTrayIcon

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »