Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.12.18;
Скачать: CL | DM;

Вниз

Создать property sheet page   Найти похожие ветки 

 
Чапаев ©   (2005-10-14 10:13) [0]

Нужно сабж.

Определяю класс:

type
 TPropertyPage=class(TComObject,IShellExtInit,IShellPropSheetExt)
//реализация IShellExtInit целиком берётся из примера %DELPHIDIR%\Demos\ActiveX\ShellExt\Contextm.pas
 {ShellPropSheetExt}
   function AddPages(lpfnAddPage:TFNAddPropSheetPage;lParam:LPARAM):HResult;stdcall;
   function ReplacePage(uPageID:UINT;lpfnReplaceWith:TFNAddPropSheetPage;lParam:LPARAM):HResult;stdcall;
 end;


Метод AddPages() реализую так:


function TPropertyPage.AddPages(lpfnAddPage: TFNAddPropSheetPage;
 lParam: LPARAM): HResult;
var
 PSP:TPropSheetPage;
 Page:HPropSheetPage;
begin
 MessageBox(0,"AddPages called","",MB_OK or MB_APPLMODAL);
 FillChar(PSP,SizeOf(PSP),0);
 PSP.dwSize:=SizeOf(PSP);
 PSP.dwFlags:=PSP_USETITLE;
 PSP.pszTitle:=PChar(PageTitle);
 Page:=CreatePropertySheetPage(PSP);
 if Page<>nil
 then MessageBox(0,"Page created","",MB_OK or MB_APPLMODAL)
 else MessageBox(0,"Failed to create page","",MB_OK or MB_APPLMODAL);
 lpfnAddPage(Page,lParam);
 MessageBox(0,"AddPages finished","",MB_OK or MB_APPLMODAL);
 Result:=S_OK;
end;

Все MassageBox"ы появляются, все говорят "Окей". Однако новой страницы свойств я так и не вижу.


 
X_Tra ©   (2005-10-17 22:36) [1]

Объявление правильное, а вот дальше не так:
function TX_Shell.AddPages(lpfnAddPage: TFNAddPropSheetPage;
                      lParam: LPARAM): HResult; stdcall;
var PropSheet:PROPSHEETPAGE;
   HandPropSheet:HPropSheetPage;
Begin
    PropSheet.dwSize:=sizeof(PropSheet);
    PropSheet.dwFlags:=PSP_USETITLE;
    PropSheet.hInstance:=hInstance;
    PropSheet.pszTemplate:="X_DLG"; //имя ресурса типа RT_DIALOG (см. ниже)
    PropSheet.pfnDlgProc:=@AddPropSheetPage; //CALLBACK-функция (см. ниже)
    PropSheet.pszTitle:="X_Shell";
    HandPropSheet:=CreatePropertySheetPage(PropSheet);
    If HandPropSheet<>nil
       Then If lpfnAddPage(HandPropSheet,lparam)
               Then Result:=S_OK
               Else Begin
                    DestroyPropertySheetPage(HandPropSheet);
                    Result:=E_OUTOFMEMORY;
               End
       Else Result:=E_OUTOFMEMORY;
End;


В *.dpr включить {$R "X_DLG.res" "X_DLG.rc"}, а в X_DLG.rc включить примерно следующее:
X_DLG DIALOG 0, 0, 219, 201
STYLE WS_CHILD | WS_VISIBLE
CAPTION ""
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL
FONT 8, "MS SHELL DLG"
{
  CONTROL "", 1, LISTBOX, WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP, 15, 5, 191, 161
  CONTROL "Тест", 2, BUTTON, BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 167, 171, 40, 14
}


Следующее нужно добавить, иначе вылезает ошибка (мне не удалось от неё избавиться):
function TX_Shell.ReplacePage(uPageID: UINT; lpfnReplaceWith: TFNAddPropSheetPage; lParam: LPARAM): HResult; stdcall;
Begin
    Result:=E_OUTOFMEMORY;
End;


//Эта функция обрабатывает сообщения, посылаемые вкладке свойств
function AddPropSheetPage(hwndDlg:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):Boolean;stdcall;
var I,Count,Index:Integer;
Begin
    Index:=-1;
    Case uMsg of
         WM_INITDIALOG:InitShellDlg(hwndDlg); //см. ниже
         WM_COMMAND:If (HWND(lParam)=HBtn)and(Hi(wParam)=BN_CLICKED)
                       Then Begin
                            Count:=SendMessage(HLBox,LB_GETCOUNT,0,0);
                            For I:=1 to Count Do
                                If SendMessage(HLBox,LB_GETSEL,I-1,0)<>0
                                   Then Begin Index:=I;Break; End
                                   Else Index:=-1;
                            If Index=-1
                               Then MessageBox(hwndDlg,
                                    PChar("Строки не выбраны!"),
                                    PChar("X_Shell: информация"),
                                    MB_ICONINFORMATION)
                               Else Begin
                                    MessageBox(hwndDlg,
                                    PChar("Выбрана строка: "+
                                          IntToStr(Index)),
                                    PChar("X_Shell: информация"),
                                    MB_ICONINFORMATION)
                               End;
                       End;
    end;
    Result:=False;
End;
//В этой процедуре инициализируется добавляемая вкладка свойств.
//Инициализация происходит при получении сообщения WM_INITDIALOG
Procedure InitShellDlg(hwndDlg:HWND);
var I:Integer;
   FName:PChar;
Begin
    HLBox:=GetDlgItem(hwndDlg,1);
    HBtn:=GetDlgItem(hwndDlg,2);
    For I:=0 to FolderOffset-1 Do
    Begin
         New(FName);
         FName:=FolderList[I];
         SendMessage(HLBox,LB_ADDSTRING,0,Integer(FName));
         FName:=nil;
    End;
    For I:=0 to FileOffset-1 Do
    Begin
         New(FName);
         FName:=FileNameList[I];
         SendMessage(HLBox,LB_ADDSTRING,0,Integer(FName));
         FName:=nil;
    End;
    SendMessage(HLBox,LB_SETHORIZONTALEXTENT,500,0);
End;


 
X_Tra ©   (2005-10-17 22:43) [2]

Обрати внимание на stdcall - нужно практически везде, в том числе и в CALLBACK-функции


 
Чапаев ©   (2005-10-18 11:11) [3]

Спасибо за код, дома попробую.


> Следующее нужно добавить, иначе вылезает ошибка (мне не
> удалось от неё избавиться):

Странно. А у меня в обработчик ReplacePage() не входит вообще.


> Обрати внимание на stdcall - нужно практически везде, в
> том числе и в CALLBACK-функции

Ну так я в описании класса написал, что функции stdcall. Повторять в реализации методов необходимости нету.



Страницы: 1 вся ветка

Текущий архив: 2005.12.18;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.047 c
2-1133789599
veres
2005-12-05 16:33
2005.12.18
Упаковка dbf


14-1133105555
DeMoN[777]
2005-11-27 18:32
2005.12.18
Помогите с выбором КПК


2-1133438246
Vis74
2005-12-01 14:57
2005.12.18
Создание резервной копии приложения - ( *.exe.bak)


6-1125821792
mm0
2005-09-04 12:16
2005.12.18
Как отправить e-mail без smpt


6-1125765758
Nekt0
2005-09-03 20:42
2005.12.18
SMTP Авторизация на mail.ru