Главная страница
    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.014 c
1-1132519311
x.pro
2005-11-20 23:41
2005.12.18
Проявите человечность!


2-1133790627
adamov_a
2005-12-05 16:50
2005.12.18
StringGrid - как получить содержимое выделенных ячеек


14-1132834302
Sergey13
2005-11-24 15:11
2005.12.18
А чего интересного есть на WAP?


14-1132841824
stone
2005-11-24 17:17
2005.12.18
Супердевайс :))


9-1121769913
MegaMoniak
2005-07-19 14:45
2005.12.18
Помогите, новичку в Opengl.





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский