| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Создать property sheet page [WinXP]

Чапаев ©   (2005-10-14 10:13:00) 

Нужно сабж.

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

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'ы появляются, все говорят "Окей". Однако новой страницы свойств я так и не вижу.

---

Чапаев   (2005-10-18 11:11:00) [1]

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


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

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


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

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

---

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

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

---

X_Tra   (2005-10-17 22:36:00) [3]

Объявление правильное, а вот дальше не так:
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;


---

Наверх