Property sheets, more API
Posted: Thu Sep 30, 2004 2:45 pm
Code updated For 5.20+
This is a class to create property sheets using the dialog class i posted earlier.
A lot of code but you only need to look at the example part, again not for beginners. It makes the property sheet creation using memory dialogs easy.
This is a class to create property sheets using the dialog class i posted earlier.
A lot of code but you only need to look at the example part, again not for beginners. It makes the property sheet creation using memory dialogs easy.
Code: Select all
;Property Sheets using memory dialogs
;Justin 09/2004
; IncludeFile "dialogs.pb" ;dialog class
;Dialogs using memory templates
;Justin 09/2004
;dialogs.pbi
;dialogs.pbi
Interface IDialog
CreateTmpl(Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, font$, pointSize.w)
OpenModal(hwnd.l, dlgProc.l, param)
AddControl(class$, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, id.w)
DestroyTmpl()
OpenModeless(hwnd.l, dlgProc.l, param)
get_Tmpl()
EndInterface
Structure DialogFunctionsVT
DLG_CreateTmpl.l
DLG_OpenModal.l
DLG_AddControl.l
DLG_DestroyTmpl.l
DLG_OpenModeless.l
DLG_get_Tmpl.l
EndStructure
Structure DialogOBJ
*VirtualTable.DialogFunctionsVT
;properties
tmpl.l ;memory template
tmplSize.l
cdit.w ;nr. dlg items
EndStructure
;- DECLARATION
Declare DLG_CreateTmpl(*THIS.DialogOBJ, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, font$, pointSize.w)
Declare DLG_OpenModal(*THIS.DialogOBJ, hwnd.l, dlgProc.l, param)
Declare DLG_AddControl(*THIS.DialogOBJ, class$, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, id.w)
Declare DLG_DestroyTmpl(*THIS.DialogOBJ)
Declare DLG_OpenModeless(*THIS.DialogOBJ, hwnd.l, dlgProc.l, param)
Declare DLG_get_Tmpl(*THIS.DialogOBJ)
Declare CDialog(*THIS.DialogOBJ, *Idlg.LONG)
;- CONSTRUCTOR
Global g_DialogFunctionsVT.DialogFunctionsVT
g_DialogFunctionsVT\DLG_CreateTmpl = @DLG_CreateTmpl()
g_DialogFunctionsVT\DLG_OpenModal = @DLG_OpenModal()
g_DialogFunctionsVT\DLG_AddControl = @DLG_AddControl()
g_DialogFunctionsVT\DLG_OpenModeless = @DLG_OpenModeless()
g_DialogFunctionsVT\DLG_DestroyTmpl = @DLG_DestroyTmpl()
g_DialogFunctionsVT\DLG_get_Tmpl = @DLG_get_Tmpl()
;dialogs.pb
Procedure CDialog(*THIS.DialogOBJ, *Idlg.LONG)
*THIS\VirtualTable = g_DialogFunctionsVT
If *Idlg : *Idlg\l = *THIS : EndIf
EndProcedure
Procedure DLG_get_Tmpl(*THIS.DialogOBJ) : ProcedureReturn *THIS\tmpl : EndProcedure
Procedure DLG_DestroyTmpl(*THIS.DialogOBJ)
If *THIS\tmpl : FreeMemory(*THIS\tmpl) : EndIf
EndProcedure
Procedure DLG_CreateTmpl(*THIS.DialogOBJ, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, font$, pointSize.w)
*pwTemp.WORD
*THIS\tmplSize = SizeOf(DLGTEMPLATE) + (SizeOf(WORD)*2) ;menu, class arrays
*THIS\tmpl = AllocateMemory(*THIS\tmplSize)
*dtmp.DLGTEMPLATE = *THIS\tmpl
*dtmp\style = Style
*dtmp\dwExtendedStyle = dwExtendedStyle
*dtmp\cdit = 0
*dtmp\x = x
*dtmp\y = y
*dtmp\cx = w
*dtmp\cy = h
;title array
arrLen = 0
If title$=""
arrLen = SizeOf(WORD)
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
Else
wLen = MultiByteToWideChar_(#CP_ACP, 0, title$, -1, 0, 0)*2
arrLen + wLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
;set title
MultiByteToWideChar_(#CP_ACP, 0, title$, -1, *dtmp + *THIS\tmplSize - arrLen, wLen)
EndIf
;font array
If font$
arrLen = SizeOf(WORD) ;point size
wLen = MultiByteToWideChar_(#CP_ACP, 0, font$, -1, 0, 0)*2
arrLen + wLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
;set pointsize
*pwTemp = *dtmp + *THIS\tmplSize - arrLen : *pwTemp\w = pointSize
;set font name
MultiByteToWideChar_(#CP_ACP, 0, font$, -1, *pwTemp + SizeOf(WORD), wLen)
EndIf
*THIS\tmplSize + (*THIS\tmplSize % 4)
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
EndProcedure
Procedure DLG_OpenModal(*THIS.DialogOBJ, hwnd.l, dlgProc.l, param)
ProcedureReturn DialogBoxIndirectParam_(GetModuleHandle_(0), *THIS\tmpl, hwnd, dlgProc, param)
EndProcedure
Procedure DLG_OpenModeless(*THIS.DialogOBJ, hwnd.l, dlgProc.l, param)
ProcedureReturn CreateDialogIndirectParam_(GetModuleHandle_(0), *THIS\tmpl, hwnd, dlgProc, param)
EndProcedure
Procedure DLG_AddControl(*THIS.DialogOBJ, class$, Style.l, ExStyle.l, x.w, y.w, w.w, h.w, title$, id.w)
If class$="" Or *THIS\tmpl=0 : ProcedureReturn 0 : EndIf ;error
*THIS\tmplSize + SizeOf(DLGITEMTEMPLATE)
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
*dit.DLGITEMTEMPLATE = *THIS\tmpl + *THIS\tmplSize - SizeOf(DLGITEMTEMPLATE)
*dit\style = Style
*dit\dwExtendedStyle = ExStyle
*dit\x = x
*dit\y = y
*dit\cx = w
*dit\cy = h
*dit\id = id
itemLen = SizeOf(DLGITEMTEMPLATE)
;class array
arrLen = 0
wLen = MultiByteToWideChar_(#CP_ACP, 0, class$, -1, 0, 0)*2
arrLen + wLen
itemLen + arrLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
;set class
MultiByteToWideChar_(#CP_ACP, 0, class$, -1, *THIS\tmpl + *THIS\tmplSize - arrLen, wlen)
;title array
If title$
arrLen = 0
wLen = MultiByteToWideChar_(#CP_ACP, 0, title$, -1, 0, 0)*2
arrLen + wLen
itemLen + arrLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
;set title
MultiByteToWideChar_(#CP_ACP, 0, title$, -1, *THIS\tmpl + *THIS\tmplSize - arrLen, wlen)
Else
arrLen = SizeOf(WORD)
itemLen + arrLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
EndIf
;creation data array
arrLen = SizeOf(WORD)
itemLen + arrLen
*THIS\tmplSize + arrLen
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
*THIS\tmplSize + (itemLen % 4)
*THIS\tmpl = ReAllocateMemory(*THIS\tmpl, *THIS\tmplSize)
*THIS\cdit + 1
*dtmp.DLGTEMPLATE = *THIS\tmpl
*dtmp\cdit = *THIS\cdit
ProcedureReturn *THIS\cdit
EndProcedure
;dialogs_test.pb
;- TEST
Enumeration
#IDC_BT
#IDC_ED
EndEnumeration
Procedure DlgProc1(hwnd, msg, wParam, lParam)
Select msg
Case #WM_COMMAND
Select wparam>>16
Case #BN_CLICKED
Select wparam & $ffff
Case #IDC_BT
Debug "click"
EndSelect
EndSelect
ProcedureReturn 1
Case #WM_CLOSE
EndDialog_(hwnd, 1)
ProcedureReturn 1
Default : ProcedureReturn 0
EndSelect
EndProcedure
; ;create dialog
; CDialog(@oDLG1.DialogOBJ, @pDLG1.IDialog)
; pDLG1\CreateTmpl(#WS_SYSMENU|#DS_SETFONT, 0, 10, 10, 200, 200, "Modal Dialog", "Arial", 10)
; pDLG1\AddControl("Button", #WS_VISIBLE|#WS_CHILD, 0, 2, 2, 80, 20, "Click Me", #IDC_BT)
; pDLG1\AddControl("Edit", #WS_VISIBLE|#WS_CHILD, #WS_EX_CLIENTEDGE, 0, 40, 40, 20, "text", #IDC_ED)
;
; ;open
; pDLG1\OpenModal(0, @DlgProc1(), 0)
;
; ;free memory template
; pDLG1\DestroyTmpl()
; End
;psheet.pbi
#PSP_DLGINDIRECT = 1
#PSH_PROPSHEETPAGE = 8
#PSH_NOAPPLYNOW = 128
#PSN_FIRST = -200
#PSN_KILLACTIVE = #PSN_FIRST - 1
#PSN_SETACTIVE = #PSN_FIRST - 0
#PSN_APPLY = #PSN_FIRST - 2
#PSN_RESET = -203
#PSN_QUERYCANCEL = -209
#PSNRET_NOERROR = 0
#PSNRET_INVALID = 1
#PSNRET_INVALID_NOCHANGEPAGE = 2
#PSM_CHANGED = #WM_USER + 104
Structure PROPSHEETHEADER
dwSize.l
dwFlags.l
hwndParent.l
hInstance.l
StructureUnion
hIcon.l
pszIcon.l
EndStructureUnion
pszCaption.s
nPages.l
StructureUnion
nStartPage.l
*pStartPage
EndStructureUnion
StructureUnion
ppsp.l
phpage.l
EndStructureUnion
pfnCallback.l
EndStructure
Structure PSHNOTIFY
hdr.NMHDR
lParam.l
EndStructure
Interface IPSheet
Create(flags.l, hwndParent.l, caption$, nStartPage.l)
AddPage(flags, Template.l, DlgProc.l)
Open()
put_Parent(hwndParent.l)
DestroyHdr()
EndInterface
Structure PSheetFunctionsVT
PST_Create.l
PST_AddPage.l
PST_Open.l
PST_put_Parent.l
PST_DestroyHdr.l
EndStructure
Structure PSheetOBJ
*VirtualTable.PSheetFunctionsVT
;prop
nPages.l
psh.PROPSHEETHEADER
pgsSize.l ;size of pages array
EndStructure
;- DECLARATION
Declare PST_Create(*THIS.PSheetOBJ, flags.l, hwndParent.l, caption$, nStartPage.l)
Declare PST_AddPage(*THIS.PSheetOBJ, flags, Template.l, DlgProc.l)
Declare PST_Open(*THIS.PSheetOBJ)
Declare PST_put_Parent(*THIS.PSheetOBJ, hwndParent.l)
Declare PST_DestroyHdr(*THIS.PSheetOBJ)
;- CONSTRUCTOR
Global g_PSheetFunctionsVT.PSheetFunctionsVT
g_PSheetFunctionsVT\PST_Create = @PST_Create()
g_PSheetFunctionsVT\PST_AddPage = @PST_AddPage()
g_PSheetFunctionsVT\PST_Open = @PST_Open()
g_PSheetFunctionsVT\PST_put_Parent = @PST_put_Parent()
g_PSheetFunctionsVT\PST_DestroyHdr = @PST_DestroyHdr()
;psheet.pb
Procedure CPSheet(*THIS.PSheetOBJ, *Ifce.LONG)
*THIS\VirtualTable = g_PSheetFunctionsVT
If *Ifce : *Ifce\l = *THIS : EndIf
EndProcedure
Procedure PST_DestroyHdr(*THIS.PSheetOBJ)
If *THIS\psh\ppsp : FreeMemory(*THIS\psh\ppsp) : EndIf
RtlZeroMemory_(*THIS\psh, SizeOf(PROPSHEETHEADER))
*THIS\nPages = 0
*THIS\pgsSize = 0
EndProcedure
Procedure PST_Open(*THIS.PSheetOBJ) : ProcedureReturn PropertySheet_(*THIS\psh) : EndProcedure
Procedure PST_put_Parent(*THIS.PSheetOBJ, hwndParent.l) : *THIS\psh\hwndParent = hwndParent : EndProcedure
Procedure PST_Create(*THIS.PSheetOBJ, flags.l, hwndParent.l, caption$, nStartPage.l)
*THIS\psh\dwSize = SizeOf(PROPSHEETHEADER)
*THIS\psh\dwFlags = flags
*THIS\psh\hwndParent = hwndParent
*THIS\psh\pszCaption = caption$
*THIS\psh\nPages = 0
*THIS\psh\nStartPage = nStartPage
*THIS\psh\ppsp= #Null
EndProcedure
Procedure PST_AddPage(*THIS.PSheetOBJ, flags, Template.l, DlgProc.l)
*THIS\pgsSize + SizeOf(PROPSHEETPAGE)
*THIS\psh\ppsp = ReAllocateMemory(*THIS\psh\ppsp, *THIS\pgsSize)
*psp.PROPSHEETPAGE = *THIS\psh\ppsp + *THIS\pgsSize - SizeOf(PROPSHEETPAGE)
*psp\dwSize = SizeOf(PROPSHEETPAGE)
*psp\dwFlags = flags
*psp\pResource = Template
*psp\pfnDlgProc = DlgProc
*THIS\nPages + 1
*psh.PROPSHEETHEADER = *THIS\psh
*psh\nPages = *THIS\nPages
ProcedureReturn *THIS\nPages
EndProcedure
;psheet_test.pb
;- TEST
Enumeration
#IDC_BT1
#IDC_ED1
#IDC_BT2
#IDC_ED2
EndEnumeration
Procedure PageProc1(hwnd, msg, wParam, lParam)
Select msg
Case #WM_NOTIFY
*pnmh.NMHDR = lParam
Select *pnmh\code
Case #PSN_APPLY ;clicked OK, Close, or Apply
Debug "apply"
SetWindowLong_(hwnd, #DWL_MSGRESULT, #PSNRET_NOERROR) ;valid changes, close
;SetWindowLong_(hwnd, #DWL_MSGRESULT, #PSNRET_INVALID) ;invalid changes, don't close
ProcedureReturn 1
Case #PSN_QUERYCANCEL ;clicked Cancel or X button
Debug "cancel"
;SetWindowLong_(hwnd, #DWL_MSGRESULT, 1) ;prevent cancel
SetWindowLong_(hwnd, #DWL_MSGRESULT, 0) ;allow cancel
ProcedureReturn 1
Case #PSN_KILLACTIVE ;page about to lose activation
Debug "kill active 1"
;SetWindowLong_(hwnd, #DWL_MSGRESULT, 1) ;prevent
SetWindowLong_(hwnd, #DWL_MSGRESULT, 0) ;allow
ProcedureReturn 1
Case #PSN_SETACTIVE ;page about to be activated
Debug "set active 1"
;SetWindowLong_(hwnd, #DWL_MSGRESULT, -1) ;activate the next or the previous page
SetWindowLong_(hwnd, #DWL_MSGRESULT, 0) ;allow
ProcedureReturn 1
EndSelect
Case #WM_COMMAND
Select wparam>>16
Case #BN_CLICKED
Select wparam & $ffff
Case #IDC_BT1
Debug "click 1"
EndSelect
EndSelect
ProcedureReturn 1
Default : ProcedureReturn 0
EndSelect
EndProcedure
Procedure PageProc2(hwnd, msg, wParam, lParam)
Select msg
Case #WM_COMMAND
Select wparam>>16
Case #BN_CLICKED
Select wparam & $ffff
Case #IDC_BT2
Debug "click 2"
EndSelect
EndSelect
ProcedureReturn 1
Default : ProcedureReturn 0
EndSelect
EndProcedure
;create 2 pages, modeless dialogs
CDialog(@oDLG1.DialogOBJ, @pDLG1.IDialog)
pDLG1\CreateTmpl(#DS_SETFONT, 0, 10, 10, 200, 200, "Page 1", "Tahoma", 10)
pDLG1\AddControl("Button", #WS_VISIBLE|#WS_CHILD, 0, 2, 2, 80, 20, "Click Me", #IDC_BT1)
pDLG1\AddControl("Edit", #WS_VISIBLE|#WS_CHILD, #WS_EX_CLIENTEDGE, 0, 40, 40, 20, "text", #IDC_ED1)
CDialog(@oDLG2.DialogOBJ, @pDLG2.IDialog)
pDLG2\CreateTmpl(#DS_SETFONT, 0, 10, 10, 200, 200, "Page 2", "Tahoma", 10)
pDLG2\AddControl("Button", #WS_VISIBLE|#WS_CHILD, 0, 2, 2, 80, 20, "Click Me2", #IDC_BT2)
pDLG2\AddControl("Edit", #WS_VISIBLE|#WS_CHILD, #WS_EX_CLIENTEDGE, 0, 40, 40, 20, "text2", #IDC_ED2)
;create a property sheet, add pages
CPSheet(@oPST1.PSheetOBJ, @pPST1.IPSheet)
pPST1\Create(#PSH_PROPSHEETPAGE|#PSH_NOAPPLYNOW, 0, "Property Sheet", 0) ;no parent window
pPST1\AddPage(#PSP_DLGINDIRECT, pDLG1\get_Tmpl(), @PageProc1())
pPST1\AddPage(#PSP_DLGINDIRECT, pDLG2\get_Tmpl(), @PageProc2())
;show modal (default)
pPST1\Open()
;free mem
pDLG1\DestroyTmpl()
pDLG2\DestroyTmpl()
pPST1\DestroyHdr()
End