Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.12.18;
Скачать: [xml.tar.bz2];

Вниз

Создать 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 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.12.18;
Скачать: [xml.tar.bz2];

Наверх




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


14-1133154091
Antonn
2005-11-28 08:01
2005.12.18
Поздравьте меня, у меня сестренка родилась!


14-1132075768
bogdan
2005-11-15 20:29
2005.12.18
запуск из коммандной строки


9-1110828695
Micke
2005-03-14 22:31
2005.12.18
Новая версия God Mode 0.0.2a


5-1116590495
tosha
2005-05-20 16:01
2005.12.18
Куда пропадают контролы : (





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский