谁能告诉我这段代码有什么毛病，为什么不能执行(200分)

quark · 2004-01-02

谁能告诉我这段代码有什么毛病，为什么不能执行 unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, CommCtrl, StdCtrls; type   TForm1 = class(TForm)     Button1: TButton;     procedure Button1Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var pSheetHeader: TPropSheetHeader;     Pages: array[0..2] of TPropSheetPage;     hPage: array[0..2] of HPropSheetPage; begin   Pages[0].dwSize       := SizeOf(PROPSHEETPAGE);   Pages[0].hInstance    := hInstance;   Pages[0].pszIcon      := MakeIntResource(105);   Pages[0].dwFlags      := PSP_USETITLE or PSP_USEICONID;   Pages[0].pszTemplate  := MakeIntResource(121);   Pages[0].pszTitle     := 'Set Effects';   Pages[0].lParam       := 0;   Pages[1].dwSize       := SizeOf(PROPSHEETPAGE);   Pages[1].hInstance    := hInstance;   Pages[1].pszIcon      := MakeIntResource(106);   Pages[1].dwFlags      := PSP_USETITLE or PSP_USEICONID;   Pages[1].pszTemplate  := MakeIntResource(122);   Pages[1].pszTitle     := 'Using Tabs';   Pages[1].lParam       := 0;   Pages[2].dwSize       := SizeOf(PROPSHEETPAGE);   Pages[2].hInstance    := hInstance;   Pages[2].pszIcon      := MakeIntResource(107);   Pages[2].dwFlags      := PSP_USETITLE or PSP_USEICONID;   Pages[2].pszTemplate  := MakeIntResource(123);   Pages[2].pszTitle     := 'Keyword';   Pages[2].lParam       := 0;   pSheetHeader.dwSize     := SizeOf(TPropSheetHeader);   pSheetHeader.hInstance  := hInstance;   pSheetHeader.pszIcon    := MakeIntResource(104);   pSheetHeader.dwFlags    := PSH_USEICONID;   pSheetHeader.hwndParent := HWND(Self);   pSheetHeader.pszCaption := 'Property Sheet Sample';   pSheetHeader.nPages     := 3;   pSheetHeader.phpage     := Pointer(hPage[0]);   hPage[0] := CreatePropertySheetPage(Pages[0]);   hPage[1] := CreatePropertySheetPage(Pages[1]);   hPage[2] := CreatePropertySheetPage(Pages[2]); end; end.

陈健松 · 2004-01-03

var pSheetHeader: TPropSheetHeader;    Pages: array[0..2] of TPropSheetPage;    hPage: array[0..2] of HPropSheetPage; begin  Pages[0].dwSize       := SizeOf(TPropSheetPage);  Pages[0].hInstance    := hInstance;  Pages[0].pszIcon      := MakeIntResource(105);  Pages[0].dwFlags      := PSP_USETITLE or PSP_USEICONID;  Pages[0].pszTemplate  := MakeIntResource(121);  Pages[0].pszTitle     := 'Set Effects';  Pages[0].lParam       := 0;  Pages[0].pfnCallback := nil;  Pages[0].pfnDlgProc := nil;  Pages[1].dwSize       := SizeOf(TPropSheetPage);  Pages[1].hInstance    := hInstance;  Pages[1].pszIcon      := MakeIntResource(106);  Pages[1].dwFlags      := PSP_USETITLE or PSP_USEICONID;  Pages[1].pszTemplate  := MakeIntResource(122);  Pages[1].pszTitle     := 'Using Tabs';  Pages[1].lParam       := 0;  Pages[1].pfnCallback := nil;  Pages[1].pfnDlgProc := nil;  Pages[2].dwSize       := SizeOf(TPropSheetPage);  Pages[2].hInstance    := hInstance;  Pages[2].pszIcon      := MakeIntResource(107);  Pages[2].dwFlags      := PSP_USETITLE or PSP_USEICONID;  Pages[2].pszTemplate  := MakeIntResource(123);  Pages[2].pszTitle     := 'Keyword';  Pages[2].lParam       := 0;  Pages[2].pfnCallback := nil;  Pages[2].pfnDlgProc := nil;  //hPage[0] := CreatePropertySheetPage(Pages[0]);  //hPage[1] := CreatePropertySheetPage(Pages[1]);  //hPage[2] := CreatePropertySheetPage(Pages[2]);  pSheetHeader.dwSize     := SizeOf(TPropSheetHeader);  pSheetHeader.hInstance  := hInstance;  pSheetHeader.pszIcon    := MakeIntResource(104);  pSheetHeader.dwFlags    := PSH_USEICONID or PSH_PROPSHEETPAGE or PSH_MODELESS;  pSheetHeader.hwndParent := Application.Handle;  pSheetHeader.pszCaption := 'Property Sheet Sample';  pSheetHeader.nPages     := 3;  pSheetHeader.phpage     := @hPage;  pSheetHeader.pfnCallback := nil;  pSheetHeader.ppsp := nil;  pSheetHeader.ppsp := @Pages;  // pSheetHeader.  PropertySheet(pSheetHeader);

quark · 2004-01-03

陈大侠，你的方法可以运行，但是Sheet没有出来，能告知原因吗？

watsonyin · 2004-01-11

个人看法： 这个代码写在button事件中是不行的。要想添加sheet进去，就要重新实现IShellPropSheetExt.AddPages方法。所以要先建立一个Com Object实现IShellPropSheetExt接口,然后实现addpages方法。 下面我把前人文章粘贴一篇过来，希望对你有益。

watsonyin · 2004-01-11

转贴一篇： 利用COM技术实现外壳扩展的属性页 当用户在资源管理器中调用右键菜单时，会显示一个"属性"菜单 项，点击属性菜单项会显示一个属性页，用户可以获得甚至修改文 件信息。我们可以定制属性页通过实现属性页扩展。如下图所示， 本文实现了一个显示wave（波形）文件的信息如声道数等信息的属 性页扩展。 属性页扩展通常是同某类文件相关联的来实现同之相关的操作和信 息显示，另外可以同驱动器相关联，我们还可以用属性页扩展来替 换控制面板程序的属性页。象其他外壳扩展程序一样，属性页扩展 也是以动态连接库形式实现的进程内COM对象。它除了IUnknown接口 外还要实现IShellExtInit和IShellPropSheetExt接口。 建立同文件关联的属性页扩展 首先，我们用命令File|New...，创建一个ActiveX Library，然后 新建一个COM Object，实现的接口为IShellExtInit和 IShellPropSheetExt。 同文件建立关联需要注册属性页，要在注册表中同相应文件对应的 表项下添加Shellex/PropertySheetHandlers子键，每增加一个页 面就需要注册一个表项，最大可以添加的页面数是24，我们可以用 一个扩展实现多个页面。这里我们通过从TComObjectFactory继承类 实现的UpdateRegistry实现了注册。 type TCXPropSheetFactory=class(TComObjectFactory) public procedure UpdateRegistry(Register: Boolean); override; end; procedure TCXPropSheetFactory.UpdateRegistry(Register: Boolean); var ClassID: string; Str,KeyName : string; begin inherited UpdateRegistry(Register); if Register then begin ClassID:=GUIDToString(Class_CXPropSheet); with TRegistry.Create do try RootKey:=HKEY_CLASSES_ROOT; OpenKey('/.wav',TRUE); KeyName := ReadString(''); if Keyname = '' then begin WriteString('','WaveFile'); OpenKey('/.wav',TRUE); KeyName := ReadString(''); end; OpenKey('/'+KeyName+'/shellex/PropertySheetHandlers/Wav',TR UE); WriteString('',Classid); finally Free; end; if(Win32Platform=VER_PLATFORM_WIN32_NT)then begin with TRegistry.Create do try RootKey:=HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions', True); OpenKey('Approved', True); WriteString(ClassID, 'Wave File Property Sheet'); finally Free; end; end; end else 删除注册表项....................... end; 初始化扩展是通过IShellExtInit实现的，当外壳调用 IShellExtInit.Initialize时，它传递一个数据对象包含来文件对 应的目录的PIDL标识符。Initialize方法需要从数据对象中提取文 件名，并把文件名和PIDL标识符保存起来为了以后使用。 function TCXPropSheet.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; var StgMedium: TStgMedium; FormatEtc: TFormatEtc; szFile: array[0..MAX_PATH+1]of Char; filecount: integer; begin Result:=E_FAIL; if(lpdobj=nil)then begin Result:=E_INVALIDARG; messagebox(0, '1', '错误', mb_ok); Exit; end; 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; // 如果只有一个文件被选中，获得文件名并保存。 filecount:=DragQueryFile(stgmedium.hGlobal, $FFFFFFFF, nil, 0); if filecount=1 then begin Result:=NOERROR; DragQueryFile(stgmedium.hGlobal, 0, szFile, SizeOf(szFile)); FFilename:=strpas(szFile); end; ReleaseStgMedium(StgMedium); end; 添加页面的操作是通过IShellPropSheetExt接口来实现的。如果属 性页是和文件相关联，外壳会调用 IShellPropSheetExt.AddPages 给属性页添加一个页面。如果属性页同控制面板程序相关联，外壳 调用 IShellPropSheetExt.ReplacePage来替换页面。 IShellPropSheetExt.AddPages方法有两个参数，lpfnAddPage是一 个指向AddPropSheetPageProc 回调函数的指针，回调函数用来提供 要添加的页面信息给外壳。lParam是一个用户自定义的值，这里我 们用它来返回给回调函数对象。 一般的IShellPropSheetExt.AddPages方法实现步骤是： 给PROPSHEETPAGE结构设定正确的值，特别是： 把扩展的对象引用记数变量付值给pcRefParent成员，这可以防止页 面还在显示时，扩展对象被卸载。 实现 PropSheetPageProc 回调函数来处理页面创建和销毁的情况。 调用CreatePropertySheetPage函数来创建页面。 调用lpfnAddPage指向的函数来来添加创建好的页面。 function TCXPropSheet.AddPages(lpfnAddPage: TFNADDPROPSHEETPAGE; lParam: LPARAM): HResult; var PSP: TPropSheetPage; HPSP: HPropSheetPage; begin result:=E_FAIL; try psp.dwSize:=SizeOf(psp); psp.dwFlags:=PSP_USEREFPARENT or PSP_USETITLE or PSP_USECALLBACK; psp.hInstance:=hInstance; //这里我们使用了事先储存在wave.res中的对话框模板,模板是用 delphi5自带的 //resource workshop编辑的，使用delphi5/bin/brcc32.exe编译 的。 psp.pszTemplate:=MakeIntResource(100); //标题名 psp.pszTitle:='波文件信息'; //设定回调函数 psp.pfnDlgProc:=@DialogProc; psp.pfnCallBack:=@PropCallback; //设定对象引用记数变量 psp.pcRefParent:=@comserver.objectcount; //用lParam向回调函数传递对象 psp.lParam:=integer(self); HPSP:=CreatePropertySheetPage(psp); if HPSP＜＞nil then begin if not lpfnAddPage(HPSP, lParam)then begin DestroyPropertySheetPage(HPSP); end else begin _addref;//增加引用记数，否则一脱离这个方法的作用域，delphi 自动释放对象。 result:=S_OK; end end except on e: exception do begin e.message:='添加页面 '+e.message; messagebox(0, pchar(e.message), '错误', mb_ok); end; end; end; function TCXPropSheet.ReplacePage(uPageID: UINT; lpfnReplaceWith: TFNADDPROPSHEETPAGE; lParam: LPARAM): HResult; begin Result:=E_NOTIMPL;//同文件关联时，外壳不调用ReplacePage,所 以不用实现 end; 回调函数处理属性页的消息，主要要响应WM_INITDIALOG消息来初始 化页面显示信息，响应WM_COMMAND消息来处理用户交互，响应 WM_NOTIFY消息来处理页面切换或关闭后处理操作结果。 function DialogProc(hwndDlg: HWnd; Msg: UINT; wParam: wParam; lParam: LPARAM): Bool; stdcall; var PageObj: TCXPropSheet; filename: string; displayName : string; buffer: array[0..255]of char; SheetHWnd: HWnd; begin result:=false; try if Msg=WM_INITDIALOG then begin//初始化界面 //获得lparam传递过来的对象 pageObj:=TCXPropSheet(PPropSheetPage(lParam)^.lParam); //保存对象信息 SetWindowLong(hwndDlg, DWL_USER, integer(pageObj)); //设置界面显示波文件信息 SetDlgItemText(hwndDlg, 100, PChar(ExtractFileName(PageObj. FFileName))); OpenMedia(PageObj.FFileName); SetDlgItemText(hwndDlg, 101, PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_AVGBYTESPERSEC) ))); SetDlgItemText(hwndDlg, 102, PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_BITSPERSAMPLE)) )); SetDlgItemText(hwndDlg, 103, PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_CHANNELS)))); CloseMedia; SetWindowLong(hwndDlg, DWL_MSGRESULT, 0); Result:=TRUE; end else if(Msg=WM_COMMAND)then begin if Lo(wParam)=110 then//用户点击了关于按钮(id=110) MessageBox(0,'作者:hubdog'+#13#10+'email:hubdog@263.net',' 关于...',MB_OK); end else if(msg=WM_NOTIFY)then begin sheetHwnd:=getparent(hwndDlg);//获得属性页的窗口句柄 case PNMHdr(lparam)^.code of //页面失去焦点 PSN_KILLACTIVE:begin SetWindowLong(hwndDlg, DWL_MSGRESULT, 0); Result:=TRUE; end; end; end; except on e: exception do begin e.message:='回调处理'+e.message; messagebox(0, pchar(e.message), '错误', mb_ok); end; end; end;

quark · 2004-01-15

感谢watsonyin，这篇文章我看过多次，我想做的不太一样。 就到这里吧，问题已经不成为问题了，我改变主意，改用其他办法了。

谁能告诉我这段代码有什么毛病，为什么不能执行(200分)

quark

Unregistered / Unconfirmed

陈健松

Unregistered / Unconfirmed

quark

Unregistered / Unconfirmed

watsonyin

Unregistered / Unconfirmed

watsonyin

Unregistered / Unconfirmed

quark

Unregistered / Unconfirmed

Similar threads