请教各位大侠,能不能用Delphi添加菜单条到桌面右键菜单中,望回复,急用谢谢! [email protected]
解决方案 »
- 改变图片的大小
- 想重载KEYDOWN实现用方向键移动焦点,为什么不好用,求大虾指点
- 各位,请问有关EXE中嵌浏览器的问题?
- 如何控制在DBGrid中选中某行后,再不能移动,直到解开它?
- 一个3D GIS 客户端控件,欢迎试用
- 谁帮我看下代玛 谢谢了先 100分
- 还有比DevExpress的DxTreeList更好的第三方网格(Grid)界面控件吗?ㄑㄑㄑ
- 能否用windows2000作为COM+客户端访问另外一台COM+服务器?分数不够可以再加~~
- fastreport中如何用程序打开报表结果文件(*.frp)文件?
- TFileStream.read(str,length)后读str:access violation!
- 使用Ehlib中PreviewBox1问题
- 外挂问题,请高手帮忙,1230分全部家当献上
SysUtils,
Windows,
Classes, Messages;{$R *.res}
var
hNextHook: HWND;procedure ShowMsg(Msg: string);
begin
MessageBox(GetActiveWindow, Pchar(Msg), 'Info', MB_OK + MB_ICONINFORMATION);
end;function CallWndProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
var
Msg: PCWPStruct;
begin
Msg := pointer(lParam);
case Msg.message of
WM_INITMENUPOPUP:
begin
InsertMenu(Msg.wParam, 0, MF_BYCOMMAND or MF_STRING, 100, 'Test');
end;
WM_MENUCOMMAND,WM_SYSCOMMAND:
begin
if Lo(Msg.wParam) = 100 then Beep(500,100);
end;
end;
Result := CallNextHookEx(hNextHook, nCode, wParam, lParam);
end;procedure Hook; stdcall;
begin
hNextHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, 0);
end;procedure UnHook; stdcall;
begin
if hNextHook <> 0 then
UnhookWindowsHookEx(hNextHook);
end;exports
Hook, UnHook;begin
hNextHook := 0;
end.//////////////
调用代码:
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}procedure Hook; stdcall;external 'project2.dll';
procedure UnHook; stdcall;external 'project2.dll';procedure TForm1.FormCreate(Sender: TObject);
begin
Hook;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHook;
end;end.
效果圖片:http://www.eping.net/fourm/UploadFile/200362316553182637.jpg
第一个:conextmenu_TLB.pas
unit contextmenu_TLB;// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //// PASTLWTR : $Revision: 1.130 $
// File generated on 2003-5-10 0:29:30 from Type Library described below.// ************************************************************************ //
// Type Lib: F:\TELECOM\ContextMenu\contextmenu.tlb (1)
// LIBID: {5F6B1CC4-1752-491B-A689-5C19331A3364}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}interfaceuses ActiveX, Classes, Graphics, StdVCL, Variants, Windows;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
contextmenuMajorVersion = 1;
contextmenuMinorVersion = 0; LIBID_contextmenu: TGUID = '{5F6B1CC4-1752-491B-A689-5C19331A3364}';
implementationuses ComObj;end.
unit contextmenuhandle;interfaceuses Windows,ActiveX,ComObj,ShlObj,Classes;type
TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
protected
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function IsValidFileType(FileName: String):Boolean;
end;const
Class_ContextMenu: TGUID = '{19770906-C300-11D1-8233-0020AF3E97A0}';
{全局唯一标识符(GUID)是一个16字节(128为)的值,它唯一地标识一个接口(interface)}var
FileName: String;
FileNumber: Integer;implementationuses ComServ, SysUtils, ShellApi, Registry, opwindow;function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
begin
//如果lpdobj等于Nil,则本调用失败
if (lpdobj = nil) then begin
Result := E_INVALIDARG;
Exit;
end;
//首先初始化并清空FileList以添加文件 (duduwolf修改,取消FileList)
//FileList:=TStringList.Create;
//FileList.Clear;
FileName:= '';
//初始化剪贴版格式文件
with FormatEtc do begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(FormatEtc, StgMedium);
if Failed(Result) then Exit;
//首先查询用户选中的文件的个数
FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
//循环读取,将所有用户选中的文件保存到FileList中 (duduwolf修改)
//如果文件个数大于1就返回
{for i:=0 to FileNumber-1 do begin
DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
FileList.Add(FFileName);
Result := NOERROR;
end;}
if FileNumber = 1 then
begin
DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
FileName:= FFileName;
Result:= NOERROR;
end;
ReleaseStgMedium(StgMedium);
end;function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
var
bmp1: HBITMAP;
begin
Result := 0;
if ((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) then begin
if (FileNumber = 1) and (IsValidFileType(FileName) = true) then begin
InsertMenu(Menu,indexMenu+1, MF_SEPARATOR or MF_BYPOSITION,idCmdLast,nil);
InsertMenu(Menu, indexMenu+2, MF_STRING or MF_BYPOSITION,
idCmdFirst,PChar('Telecom - 发送报表'));
InsertMenu(Menu,indexMenu+3, MF_SEPARATOR or MF_BYPOSITION,idCmdLast,nil);
// 往Context Menu中加入一个菜单项 ,菜单项的标题为察看位图文件
bmp1:= LoadBitmap(hInstance,'B1');
SetMenuItemBitmaps(Menu,indexMenu+2,MF_BYPOSITION,bmp1,0);
// 返回增加菜单项的个数
Result := 3;
end;
end;
end;function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
frmOP:TFrmContextMenu;
begin
// 首先确定该过程是被系统而不是被一个程序所调用
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
begin
Result := E_FAIL;
Exit;
end;
// 确定传递的参数的有效性
if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end;
//建立文件操作窗口
frmOP:=TFrmContextMenu.Create(nil);
//将所有的文件列表添加到文件操作窗口的列表中
frmOP.Edit1.Text := FileName;
frmOP.Show;
Result := NOERROR;
end;function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if (idCmd = 0) then begin
if (uType = GCS_HELPTEXT) then
{返回该菜单项的帮助信息,此帮助信息将在用户把鼠标
移动到该菜单项时出现在状态条上。}
StrCopy(pszName, PChar('Telecom商品管理软件报表发送'));
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;
type
TContextMenuFactory =class(TComObjectFactory)publicprocedure UpdateRegistry(Register: Boolean); override;end;procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
//当注册扩展库文件时,添加库到注册表中
CreateRegKey('*\shellex', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers\FileOpreation', '', ClassID);
//如果操作系统为Windows NT的话
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'Telecom Send Reports ContextMenu');
finally
Free;
end;
end
else begin
DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
inherited UpdateRegistry(Register);
end;
end;function TContextMenu.IsValidFileType(FileName: String): Boolean;
begin Result:= false;
if FileExists(FileName) then
begin
if UpperCase(ExtractFileExt(FileName)) = '.XLS' then Result:= true
else if UpperCase(ExtractFileExt(Filename)) = '.DOC' then Result:= true
else Result:= false;
end;
end;initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,'', 'Telecom Send Reports ContextMenu', ciMultiInstance,tmApartment);
end.
unit opwindow;interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls,ActiveX, ComCtrls, IniFiles, Registry, DB, ADODB, StrUtils;
type
TFrmContextMenu = class(TForm)
Button1: TButton;
Button2: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label5: TLabel;
RichEdit1: TRichEdit;
Aqy: TADOQuery;
Label3: TLabel;
Edit1: TEdit;
Label6: TLabel;
Label7: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Label4: TLabel;
Edit2: TEdit;
CheckBox1: TCheckBox;
Label1: TLabel;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);private
{ Private declarations }
function GetListUser(SourceStr: String):String;
function GetFileType(FileName: String):Integer;
public
FileList:TStringList;
{ Public declarations }
end;var
FrmContextMenu: TFrmContextMenu;
sUserName, sConnectString: String;implementation
{$R *.DFM}procedure TFrmContextMenu.FormCreate(Sender: TObject);
var
Reg: TRegistry;
IpAddress, sLastUser: String;
begin
//从注册表中取出数据库的计算机局域网IP地址 Reg:= TRegistry.Create(HKEY_LOCAL_MACHINE);
Reg.RootKey:= HKEY_LOCAL_MACHINE;
if (Reg.OpenKey('SOFTWARE\Telecom', False)) then begin
sLastUser:= Reg.ReadString('LastUser');
IpAddress:= Reg.ReadString('ServerIpAddress');
Edit3.Text:= sLastUser;
end
else begin
MessageBox(Self.Handle,'Telecom没有安装或者软件安装有错误,请联系系统管理员!','错误',MB_ICONERROR);
Reg.Free;
Exit;
end;
Reg.Free;
//初始化数据库连接字符串
if Trim(IpAddress) <> '' then
begin
sConnectString:= 'Provider=SQLOLEDB.1;Password=I am DuDuWolf@I Love JYX Forever;Persist Security Info=True;User ID=sa;Initial Catalog=TELECOM;';
sConnectString:= sConnectString + 'Data Source='+Trim(IpAddress);
Aqy.ConnectionString:= sConnectString;
end else begin
MessageBox(Self.Handle,'Telecom软件安装有错误,请联系系统管理员!','错误',MB_ICONERROR);
Exit;
end;
Self.Show;
end;procedure TFrmContextMenu.Button1Click(Sender: TObject);
var
FileNo, i: Integer;
tb: TADOTable;
pField: TBlobField;
UserList: TStringList;
SendMan: String;
begin
//发送报表
if Trim(Edit3.Text) = '' then begin
MessageBox(Self.Handle,'用户名不能为空!','错误',MB_ICONERROR);
ExIT;
end;
Aqy.Close;
Aqy.SQL.Clear;
Aqy.SQL.Add('select * from oper where 操作员工号='''+Edit3.Text+'''');
Aqy.SQL.Add(' and 密码='''+Edit4.Text+'''');
Aqy.Open;
if Aqy.Eof then begin
MessageBox(Self.Handle,'用户名或者密码输入错误!','错误',MB_ICONERROR);
Exit;
end else begin
sUserName:= Edit3.Text;
end;
if Trim(Edit2.Text) = '' then
begin
MessageBox(Self.Handle,'没有输入发送标题,无法发送!','错误',MB_ICONERROR);
Exit;
end;
if not FileExists(Edit1.Text) then
begin
MessageBox(Self.Handle,PChar('选择的文件名'''+Edit2.Text+'''不存在,请重新选择!'),'错误',MB_ICONERROR);
Exit;
end;
//得到发送人的报表发送权限和接受人列表
Aqy.Close;
Aqy.SQL.Clear;
Aqy.SQL.Add('select SendMan from oa_power where oper='''+sUserName+''' ');
Aqy.Open;
if(Aqy.Eof) then begin
MessageBox(Self.Handle,PChar('操作员'''+sUserName+'''没有发送报表的权限'),'错误',MB_ICONERROR);
Exit;
end else begin
UserList:= TStringList.Create;
SendMan:= Aqy.Fields.Fields[0].AsString;
while Length(SendMan)>0 do
begin
UserList.Add(Copy(SendMan,2,3));
Delete(SendMan,1,5);
end;
end; //得到全文列表中的新的ID标示号
FileNo:= 0;
Aqy.Close;
Aqy.SQL.Clear;
Aqy.SQL.Add('SELECT MAX(FileID) FROM oa_file');
Aqy.Open;
if not Aqy.Eof then
FileNo:= Aqy.Fields.Fields[0].AsInteger + 1; //首先插入OA_FILE表
tb:= TADOTable.Create(nil);
tb.ConnectionString := sConnectString;
tb.TableName := 'OA_FILE';
tb.Open;
tb.Insert;
tb.FieldByName('FileID').AsInteger := FileNo;
tb.FieldByName('FileType').AsInteger := GetFileType(Edit1.Text);
tb.FieldByName('FileName').AsString := ExtractFileName(Edit1.Text);
pField:= tb.FieldByName('FileBuffer') as TBlobField;
//((TBlobField )tb.FieldByName('FileBuffer')).LoadFromFile(Edit1.Text);
pField.LoadFromFile(Edit1.Text);
tb.Post;
tb.Free;
//插入OA_MAIN表
Aqy.Close;
Aqy.SQL.Clear;
for i:=0 to UserList.Count - 1 do
if Edit3.Text <> GetListUser(UserList.Strings[i]) then
begin
Aqy.SQL.Add('INSERT INTO OA_MAIN(SendMan,RecvMan,FileID,Title,');
Aqy.SQL.Add('Message,ReadWriteTag,SendTime,Comment) ');
Aqy.SQL.Add('VALUES('''+sUserName+''',');
Aqy.SQL.Add(''''+GetListUser(UserList.Strings[i])+''','+IntToStr(FileNo)+',');
Aqy.SQL.Add(''''+Edit2.Text+''',');
Aqy.SQL.Add(''''+AnsiReplaceStr(RichEdit1.Text,'''','''')+''',');
if CheckBox1.Checked then
Aqy.SQL.Add('0,')
else Aqy.SQL.Add('1,');
Aqy.SQL.Add(''''+FormatDateTime('yyyy-MM-dd hh:mm:ss',Now())+''','''') ');
end;
if Trim(Aqy.SQL.Text) <> '' then
Aqy.ExecSQL;
MessageBox(Self.Handle,'发送成功!','成功',MB_ICONINFORMATION);
Self.Close;
end;procedure TFrmContextMenu.Button2Click(Sender: TObject);
begin
Self.Close;
end;function TFrmContextMenu.GetListUser(SourceStr: String): String;
begin
Result:= Copy(SourceStr, Length(SourceStr)-3, 3);
end;function TFrmContextMenu.GetFileType(FileName: String): Integer;
var
FileType: Integer;
begin
FileType:= 0;
if FileExists(FileName) then
begin
if UpperCase(ExtractFileExt(FileName)) = '.XLS' then FileType := 1
else if UpperCase(ExtractFileExt(Filename)) = '.DOC' then FileType := 2
else if UpperCase(ExtractFileExt(Filename)) = '.TXT' then FileType := 3
else FileType := 4;
end;
Result:= FileType
end;end.
duduwolf(嘟嘟狼) 老兄的好象太复杂了!
我的想法是找到桌面的那个窗口
用FindWindow('progman', 'Program Manager'),
然后再用GetSystemMenu来取得这个窗口的系统菜单,但是为什么不行啊。
我可以把这个窗口给隐藏或显示(就是把桌面的图标显示或隐藏),但是取得的系统菜单为什么不是这个啊。