;*** methods of CAsmClass coclass
;--- How to add new properties/methods to custom Interface IAsmClass
;--- 1. AsmCtrl.IDL: add the properties/methods to IAsmClass
;--- 2. add the properties/methods to vtable CAsmClassVtbl in this file
;--- 3. add new variables - if required - to CAsmClass.inc
;--- 4. add implementation of new functions in this file.
;--- properties require a get/set function pair.
;--- 5. to access new variables with m_ prefix, use the MEMBER macro
;--- as it is done in this file (search for "member")
.586
.model flat, stdcall
option casemap:none ; case sensitive
option proc:private
.nolist
.nocref
WIN32_LEAN_AND_MEAN equ 1
INC_OLE2 equ 1
include windows.inc
include olectl.inc
include macros.inc
include disphlp.inc
include olecntrl.inc
include debugout.inc
include AsmCtrl.inc ;type information (COMView generated)
include AsmCtrlc.inc ;dispatch helper (COMView generated)
.list
.cref
include CAsmClass.inc
Destroy@CAsmClass proto :ptr CAsmClass
AboutBox PROTO :ptr CAsmClass
aboutBoxProc PROTO :HWND, :DWORD, :WPARAM, :LPARAM
;--- exit procs: called from the macros in olecntrl.inc
;--- to ensure these exits are called place the prototypes here
OnInitNew@CAsmClass PROTO :ptr CAsmClass
OnInPlaceActivate@CAsmClass PROTO :ptr CAsmClass, :HWND, :ptr RECT
OnDraw@CAsmClass PROTO :ptr CAsmClass, :ptr DVTARGETDEVICE, :HDC, :HDC, :ptr RECT, :ptr RECT
GetPages@CAsmClass PROTO :ptr CAsmClass, :ptr CAUUID
OnDoVerb@CAsmClass PROTO :ptr CAsmClass, :SDWORD, :ptr MSG, :LPOLECLIENTSITE, :HWND, :ptr RECT
OnInvoke@CAsmClass PROTO :ptr CAsmClass, :DWORD, :DWORD, :ptr DISPPARAM, :ptr VARIANT, :ptr EXCEPINFO, :ptr DWORD
IDD_ABOUT EQU 1000 ;resource ID
?INVOKELOG equ 1 ;log all IDispatch::Invoke being called (debug only)
.const
CLSID_CAsmClass sCLSID_AsmClass
IID_IAsmClass sIID_IAsmClass
IID__AsmClassEvent sIID__AsmClassEvent
;--- add new interface IIDs here if required
;IID_IDummy IID <1,2,3,<4,5,6,7,8,9,0Ah,0Bh>>
;-----------------------------------------------------------------
;--- define the IIDs for outgoing interfaces (must match ?NUMCP)
;--- one outgoing interface as here will do in most cases
;-----------------------------------------------------------------
BEGIN_CONNECTION_POINT_MAP CAsmClass
CONNECTION_POINT_ENTRY IID__AsmClassEvent
END_CONNECTION_POINT_MAP
;-----------------------------------------------------------------
;--- IOleObject
;-----------------------------------------------------------------
szWndClassName BYTE "CAsmClassClass",0 ; window class name
.data
g_bRegistered BYTE FALSE ; flag if our window class is registered
;--------------------------------------------------------------------------
;--- IUnknown interface: the table of supp. interfaces must be defined
;--------------------------------------------------------------------------
.const
DEFINE_KNOWN_INTERFACES CAsmClass, IAsmClass
;--- to add new interfaces to the list of interfaces known by QueryInterface
;--- add it to DEFINE_KNOWN_INTERFACES like this:
; DEFINE_KNOWN_INTERFACES CAsmClass, IAsmClass, IDummy
;-----------------------------------------------------------------
;--- ICategorizeProperties: Array of DISPIDs belonging to specific Category
;-----------------------------------------------------------------
;--- this interface is for VB support to group properties a bit nicer
PropArray1 dd 0,1,2, DISPID_FORECOLOR, DISPID_BACKCOLOR, DISPID_ABOUTBOX
NUMPROPARRAY1 equ ($ - offset PropArray1) / sizeof DWORD
;--- category table (ID, Name, ptr to DispID-Array, length of Array)
Categories label dword
Category <1, CStr("AsmClass"), offset PropArray1, NUMPROPARRAY1>
NUMCATEGORIES equ ($ - offset Categories) / sizeof Category
;-----------------------------------------------------------------
;--- IPersistStreamInit, IPersistPropertyBag: table of persistant properties
;-----------------------------------------------------------------
;--- here bags can be defined which will be saved/loaded automatically
BagTab label BagEntry
BagEntry {VT_I4, CAsmClass.dwValue, CStrW(L("Value")) }
BagEntry {VT_I4, CAsmClass.dwBackColor, CStrW(L("BackColor"))}
BagEntry {VT_I4, CAsmClass.dwForeColor, CStrW(L("ForeColor"))}
BagEntry {VT_I2, CAsmClass.wClientEdge, CStrW(L("ClientEdge"))}
BagEntry {VT_I4, CAsmClass.himetricExtent.cx_,CStrW(L("Width"))}
BagEntry {VT_I4, CAsmClass.himetricExtent.cy,CStrW(L("Height"))}
NUMBAGS equ ($ - offset BagTab) / sizeof BagEntry
;--- define max size for IPersistStreamInit: so no exit proc needed
?SAVESIZE equ (sizeof CAsmClass.dwValue + sizeof CAsmClass.dwBackColor +\
sizeof CAsmClass.dwForeColor + sizeof CAsmClass.wClientEdge +\
sizeof CAsmClass.himetricExtent)
;--------------------------------------------------------------------------
;--- IDispatch interface
;--------------------------------------------------------------------------
;--- the IDispatch/IAsmClass vtable. This vtable is our responsibility
;--- it is strongly recommended being located at offset 0 in the
;--- CAsmClass structure - thats first entry in BEGIN_COM_MAP table!
;--- Otherwise we could not use the "standard" IUnknown procs
;--- and would have to adjust "this" in all of the IAsmClass methods
CAsmClassVtbl label IAsmClassVtbl
IDispatchVtbl {QueryInterface@CAsmClass, AddRef@CAsmClass, Release@CAsmClass,\
GetTypeInfoCount_, GetTypeInfo_, GetIDsOfNames_, Invoke_}
dd put_Value, get_Value
dd Raise
dd put_ForeColor, get_ForeColor
dd put_BackColor, get_BackColor
dd put_ClientEdge, get_ClientEdge
dd AboutBox
dd put_Value2, get_Value2
;---- add new methods/properties here
; dd put_PropertyX, get_PropertyX
;--------------------------------------------------------------------------
;--- define table of registry entries for this CLSID
;--- REGSTRUCT = {LPSTR lpszSubKey; LPSTR lpszValueName; LPSTR lpszData}
;--- -1 in lpszSubKey -> key in HKEY_CLASSES_ROOT, in which next
;--- entries will be written. %s is szCLSID in such entries.
;--- else: -1 in lpszData: replaced by szCLSID, -2 in lpszData: replaced by szTLBID
;--- %s is module path in such entries
;--------------------------------------------------------------------------
IDI_ICON equ 0 ;index of icon resource for DefaultIcon
IDB_BITMAP equ 299
MISCSTATUS equ OLEMISC_SETCLIENTSITEFIRST + OLEMISC_ACTIVATEWHENVISIBLE + \
OLEMISC_INSIDEOUT + OLEMISC_RECOMPOSEONRESIZE
DEFAULTICON textequ @CatStr(!",%IDI_ICON,!")
TOOLBOXBITMAP textequ @CatStr(!",%IDB_BITMAP,!")
MISCSTATUS$ textequ @CatStr(!",%MISCSTATUS,!")
ProgId textequ <"AsmClass">
Description textequ <"OCX control in pure ASM">
?COMPCAT = 1 ;1= define "Implemented Categories" registry keys
sGUID_SavelyScriptable textequ <"{7DD95801-9882-11CF-9FA9-00AA006C42C4}">
sGUID_SavelyInitializable textequ <"{7DD95802-9882-11CF-9FA9-00AA006C42C4}">
RegKeys_CAsmClass label REGSTRUCT
REGSTRUCT <-1, 0, CStr("CLSID\%s")>
REGSTRUCT <0, 0, CStr(Description)>
REGSTRUCT
REGSTRUCT
REGSTRUCT )>
REGSTRUCT )>
REGSTRUCT )>
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT )>
if ?COMPCAT
REGSTRUCT
REGSTRUCT ), 0, 0>
REGSTRUCT ), 0, 0>
endif
REGSTRUCT <-1, 0, CStr(ProgId)>
REGSTRUCT <0, 0, CStr(Description)>
REGSTRUCT
REGSTRUCT )>
REGSTRUCT <-1, 0, CStr()>
REGSTRUCT <0, 0, CStr(Description)>
REGSTRUCT
REGSTRUCT
REGSTRUCT <-1, 0, 0>
;-----------------------------------------------------------------
.code
__this textequ
_this textequ <[__this].CAsmClass>
;--------------------------------------------------------------------------
;--- provide short names for our members so "dwValue"
;--- can be accessed with "m_dwValue" instead of "[ebx].CAsmClass.dwValue"
;--------------------------------------------------------------------------
MEMBER dwValue, dwBackColor, dwForeColor, wClientEdge, szText, dwValue2
;--- add new variables here
; MEMBER dwDummy
;-----------------------------------------------------------------
;--- the following macros include most of the code needed
;-----------------------------------------------------------------
;--- DEFINE_DISPATCH: needs IID of IAsmClass as parameter
;--- DEFINE_STD_COM_METHODS: include code for all other interfaces
;-----------------------------------------------------------------
DEFINE_DISPATCH CAsmClass, IID_IAsmClass
DEFINE_STD_COM_METHODS CAsmClass
DEFINE_FIREEVENTHELPER
;--------------------------------------------------------------------------
;--------------- constructor CAsmClass
;--------------------------------------------------------------------------
Create@CAsmClass proc public uses esi __this pClass: ptr ObjectEntry, pUnkOuter:LPUNKNOWN
invoke LocalAlloc, LMEM_FIXED or LMEM_ZEROINIT,sizeof CAsmClass
.if (eax == NULL)
ret
.endif
mov __this,eax
;--------------------------------------------------------------------------
;--- the IAsmClass/IDispatch interface is in our responsibility
;--- so set the vtable ptr now
;--------------------------------------------------------------------------
mov m__IDispatch, OFFSET CAsmClassVtbl
;--- for other new interfaces, initialize vtable ptr here
; mov m__IDummy, OFFSET CDummyVtbl_CAsmClass
;--------------------------------------------------------------------------
;--- include the standard COM constructor code
;--------------------------------------------------------------------------
mov esi, pClass
assume esi:ptr ObjectEntry
STD_COM_CONSTRUCTOR CAsmClass, [esi].pLibId, [esi].dwVerMajor, [esi].dwVerMinor
assume esi:nothing
;--------------------------------------------------------------------------
;--- init member variables
;--------------------------------------------------------------------------
mov eax, 0808080H
mov m_dwForeColor, eax
mov eax, 0000000H
mov m_dwBackColor, eax
;--- add other member initialization here
; mov m_dwDummy, 1
;--------------------------------------------------------------------------
;--- a LPUNKNOWN must be returned since we will support aggregation
;--------------------------------------------------------------------------
if ?AGGREGATION
lea eax, m__IUnknown
ret
else
return __this
endif
Create@CAsmClass endp
;--------------------------------------------------------------------------
;--------------- destructor
;--------------------------------------------------------------------------
Destroy@CAsmClass PROC public uses __this this_:ptr CAsmClass
DebugOut "Destroy@CAsmClass enter"
mov __this,this_
;--- add other deinit code here (releasing interfaces, closing files,...)
;--------------------------------------------------------------------------
;--- include the standard COM destructor code
;--------------------------------------------------------------------------
STD_COM_DESTRUCTOR CAsmClass
invoke LocalFree, __this
DebugOut "Destroy@CAsmClass exit"
ret
Destroy@CAsmClass ENDP
;--------------------------------------------------------------------------
;--- now come some exits. These procs are called from inside olecntrl.inc.
;--------------------------------------------------------------------------
;------------------------------------------------------------------------
;--- IPersistStreamInit::InitNew
;------------------------------------------------------------------------
OnInitNew@CAsmClass PROC this_:ptr CAsmClass
;--- initialize object (currently nothing to do)
return S_OK
OnInitNew@CAsmClass endp
;------------------------------------------------------------------------
;--- IViewObject::Draw
;------------------------------------------------------------------------
;--- this exit routine draws content (with or without window)
OnDraw@CAsmClass proc this_:ptr CAsmClass, ptd:ptr DVTARGETDEVICE,
hicTargetDev:HDC, hdcDraw:HDC, lprcBounds:ptr RECT, lprcWBounds:ptr RECT
local szText[256]:byte
local szId[16]:byte
LOCAL tRect:RECT
mov eax, m_dwBackColor
invoke CreateSolidBrush, eax
push eax
invoke FillRect, hdcDraw, lprcBounds, eax
pop eax
invoke DeleteObject, eax
invoke SetTextColor, hdcDraw, m_dwForeColor
push eax
invoke SetBkColor, hdcDraw, m_dwBackColor
push eax
push ebx
mov eax,0
cpuid
mov dword ptr szId+0,ebx
pop ebx
mov dword ptr szId+4,edx
mov dword ptr szId+8,ecx
mov szId+12,0
mov ecx,eax
invoke wsprintf,addr szText, CStr(<"Max CPUID value=%u",13,10,"%s",13,10,"%s">),ecx,addr szId,addr m_szText
invoke CopyRect,addr tRect, lprcBounds
invoke DrawText, hdcDraw, ADDR szText, -1, addr tRect, DT_CALCRECT
mov ecx,lprcBounds
;------------------------------------ center text manually
mov edx,[ecx].RECT.bottom
sub edx,[ecx].RECT.top
.if (edx >= eax)
sub edx,eax
shr edx,1
add tRect.top,edx
add edx,eax
add tRect.bottom,edx
.endif
mov eax, tRect.right
sub eax, tRect.left
mov edx,[ecx].RECT.right
sub edx,[ecx].RECT.left
.if (edx >= eax)
sub edx,eax
shr edx,1
add tRect.left,edx
add edx,eax
add tRect.right,edx
.endif
invoke DrawText, hdcDraw, ADDR szText, -1, addr tRect, 0
pop eax
invoke SetBkColor, hdcDraw, eax
pop eax
invoke SetTextColor, hdcDraw, eax
return S_OK
OnDraw@CAsmClass endp
;------------------------------------------------------------------------
;--- IOleObject
;------------------------------------------------------------------------
;--- this exit is called from inside IOleObject:DoVerb
;--- we are being in-place-activated, create window
OnInPlaceActivate@CAsmClass PROC uses __this this_:ptr CAsmClass, hwndParent:HWND,lprcRect:ptr RECT
local wc:WNDCLASS
local dwXPos:dword
local dwYPos:dword
local dwCX:dword
local dwCY:dword
mov __this, this_
;---------------------------- register window class it not done yet
.if (!g_bRegistered)
mov wc.style, 0
mov wc.lpfnWndProc, OFFSET wndproc
mov wc.cbClsExtra,NULL
mov wc.cbWndExtra,4
push g_hInstance
pop wc.hInstance
mov wc.hbrBackground,0
mov wc.lpszMenuName,NULL ;OFFSET MenuName
mov wc.lpszClassName,offset szWndClassName
mov wc.hIcon,NULL
mov eax, 32512 ;IDC_ARROW
invoke LoadCursor,NULL,eax
mov wc.hCursor,eax
invoke RegisterClass, addr wc
mov g_bRegistered,TRUE
.endif
mov eax,lprcRect
mov edx,[eax].RECT.left
mov ecx,[eax].RECT.right
sub ecx,edx
mov dwCX,ecx
mov dwXPos,edx
mov edx,[eax].RECT.top
mov ecx,[eax].RECT.bottom
sub ecx,edx
mov dwCY,ecx
mov dwYPos,edx
;------------------ better do not rely on infos from
;------------------ IOleObject:SetExtend. So save dimensions here
mov eax,dwCX
mov m_pixelExtent.cx_,eax
mov eax,dwCY
mov m_pixelExtent.cy,eax
.if (m_wClientEdge)
mov ecx,WS_EX_CLIENTEDGE
.else
mov ecx,0
.endif
invoke CreateWindowEx, ecx, offset szWndClassName,\
CStr(""), WS_CHILD or WS_VISIBLE, dwXPos,\
dwYPos, dwCX, dwCY, hwndParent, 0, g_hInstance, __this
mov m_hWnd,eax
return S_OK
OnInPlaceActivate@CAsmClass ENDP
;--- another exit from inside IOleObject:DoVerb
;--- called if the verb is NOT a standard verb (that is, it's > 0)
OnDoVerb@CAsmClass proc uses __this this_:ptr CAsmClass, iVerb:SDWORD, lpmsg:ptr MSG,
pOleClientSite:LPOLECLIENTSITE, hwndParent:HWND, lprcPosRect:ptr RECT
mov __this, this_
.if (iVerb == 1)
invoke AboutBox, __this
mov eax, S_OK
.else
mov eax, OLEOBJ_S_INVALIDVERB
.endif
ret
OnDoVerb@CAsmClass endp
;--------------------------------------------------------------------------
;--- wnd proc if we are activated in place
;--------------------------------------------------------------------------
wndproc PROC uses __this hWnd:HWND, uMessage:DWORD, wParam:WPARAM, lParam:LPARAM
local ps:PAINTSTRUCT
local rect:RECT
invoke GetWindowLong,hWnd,0
mov __this,eax
mov eax,uMessage
.IF (eax == WM_CREATE)
DebugOut "WM_CREATE received"
mov eax,lParam
invoke SetWindowLong,hWnd,0,(CREATESTRUCT ptr [eax]).lpCreateParams
.ELSEIF (eax == WM_PAINT)
invoke BeginPaint,hWnd,addr ps
;------------------------------------ just call the draw routine
mov rect.left,0
mov rect.top,0
mov eax,m_pixelExtent.cx_
mov rect.right,eax
mov eax,m_pixelExtent.cy
mov rect.bottom,eax
lea ecx, m__IViewObject2
invoke OnDraw@CAsmClass, __this, 0, 0, ps.hdc, addr rect, 0
invoke EndPaint,hWnd,addr ps
xor eax, eax
.ELSEIF (eax == WM_ERASEBKGND)
mov eax,1
.ELSEIF (eax == WM_LBUTTONDOWN)
invoke OnUIActivate@CAsmClass, m_pOleClientSite
;------------------------------------ fire an event.
;------------------------------------ m_pConnectionPoint is a variable array
;------------------------------------ defined from connection point map (has one
;------------------------------------ entry only)
mov eax,lParam
movzx edx,ax ;edx = x
shr eax,16 ;eax = y
invoke FIREEVENT(m_pConnectionPoint[0], _AsmClassEvent, OnClick), edx, eax
.ELSEIF (eax == WM_DESTROY)
DebugOut "WM_DESTROY received"
xor eax,eax
.ELSE
invoke DefWindowProc, hWnd, uMessage, wParam, lParam
.ENDIF
ret
wndproc ENDP
;-------------------------------------------------
;--- ISpecifyPropertyPages support
;--- supply CLSIDs of property pages to show
;-------------------------------------------------
GetPages@CAsmClass proc uses esi edi this_:ptr CAsmClass, pPages:ptr CAUUID
mov edx, pPages
mov [edx].CAUUID.cElems, 2
invoke CoTaskMemAlloc, (SIZEOF GUID) * 2
mov edx, pPages
mov [edx].CAUUID.pElems, eax
mov edi, eax
mov esi, offset CLSID_StockFontPage
movsd
movsd
movsd
movsd
mov esi, offset CLSID_StockColorPage
movsd
movsd
movsd
movsd
return S_OK
GetPages@CAsmClass endp
;-------------------------------------------------------------
;--- IAsmClass/IDispatch interface: define all specific methods
;-------------------------------------------------------------
;--- OnInvoke is a exit proc for IDispatch::Invoke. Set EAX to -1
;--- if this proc has NOT handled the event and you want further processing
OnInvoke@CAsmClass proc uses __this this_:ptr CAsmClass, dispID:DWORD,
wFlags:DWORD, pDispParams:ptr DISPPARAM, pVarResult:ptr VARIANT,
pExcepInfo:ptr EXCEPINFO, puArgErr:ptr DWORD
mov __this, this_
.if (dispID == DISPID_ENABLED)
mov edx, pVarResult
mov [edx].VARIANT.vt, VT_BOOL
.if (m_hWnd)
mov [edx].VARIANT.boolVal, TRUE
.else
mov [edx].VARIANT.boolVal, FALSE
.endif
mov eax, S_OK
jmp done
.endif
mov eax, -1
done:
ret
OnInvoke@CAsmClass endp
put_Value proc uses __this this_:ptr CAsmClass, newVal:DWORD
mov __this,this_
DebugOut "put_Value"
mov eax,newVal
mov m_dwValue,eax
mov m_isDirty, TRUE
return S_OK
put_Value endp
;--------------------------------------------------------------------------
get_Value proc uses __this this_:ptr CAsmClass, pVal:ptr DWORD
mov __this,this_
DebugOut "get_Value"
mov eax,pVal
.if (eax)
mov edx,m_dwValue
mov [eax],edx
mov eax,S_OK
.else
mov eax, E_POINTER
.endif
ret
get_Value endp
;--------------------------------------------------------------------------
;--- Raise demonstrates some parameter technics
;--- user defined type (enum) in dwOptions
;--- pointer to variant in pvtText
;--- [out] parameter
;--- optional parameters in vtText2 and iOptValue
;--- default value in vtText2
;--------------------------------------------------------------------------
Raise proc uses __this this_:ptr CAsmClass, dwOptions:DWORD, pvtText:ptr VARIANT, pbstrOut:ptr DWORD, vtText2:VARIANT, iOptValue:DWORD, pUnknown:LPUNKNOWN
local vtTemp:VARIANT
local szText2[64]:byte
mov __this, this_
invoke VariantInit, addr vtTemp
invoke VariantChangeType, addr vtTemp, addr vtText2, 0, VT_BSTR
.if (eax == S_OK)
invoke WideCharToMultiByte, CP_ACP, 0, vtTemp.bstrVal,-1, addr m_szText, 64,0,0
invoke VariantClear, addr vtTemp
.endif
invoke VariantInit, addr vtTemp
invoke VariantChangeType, addr vtTemp, pvtText, 0, VT_BSTR
mov szText2, 0
.if (eax == S_OK)
invoke WideCharToMultiByte, CP_ACP, 0, vtTemp.bstrVal,-1, addr szText2, 64,0,0
invoke VariantClear, addr vtTemp
.endif
mov ecx, pvtText
movzx ecx, [ecx].VARIANT.vt
movzx edx, vtText2.vt
DebugOut "Raise(dwOptions=%X, vtText1=%u,%s, pbstrOut=%X, vtText2(opt)=%u,%s, iOptValue(opt)=%X, pUnknown(opt)=%X)", dwOptions, ecx, addr szText2, pbstrOut, edx, addr m_szText, iOptValue, pUnknown
mov eax,dwOptions
add m_dwValue,eax
mov ecx, pbstrOut
.if (ecx)
push ecx
invoke SysAllocString, CStrW(L("Test"))
pop ecx
mov [ecx], eax
.endif
mov m_isDirty, TRUE
return S_OK
Raise endp
;--------------------------------------------------------------------------
put_ForeColor proc uses __this this_:ptr CAsmClass, NewColor:DWORD
mov __this, this_
DebugOut "put_ForeColor"
mov eax,NewColor
mov m_dwForeColor,eax
mov m_isDirty, TRUE
invoke SendViewChange@CAsmClass, __this
return S_OK
put_ForeColor endp
;--------------------------------------------------------------------------
get_ForeColor proc uses __this this_:ptr CAsmClass, pColor:DWORD
mov __this,this_
DebugOut "get_ForeColor"
mov eax,pColor
.if (eax)
mov edx, m_dwForeColor
mov [eax],edx
mov eax,S_OK
.else
mov eax, E_POINTER
.endif
ret
get_ForeColor endp
;--------------------------------------------------------------------------
put_BackColor proc uses __this this_:ptr CAsmClass, NewColor:DWORD
mov __this,this_
DebugOut "put_BackColor"
mov eax,NewColor
mov m_dwBackColor,eax
mov m_isDirty, TRUE
invoke SendViewChange@CAsmClass, __this
return S_OK
put_BackColor endp
;--------------------------------------------------------------------------
get_BackColor proc uses __this this_:ptr CAsmClass, pColor:DWORD
mov __this,this_
DebugOut "get_BackColor"
mov eax,pColor
.if (eax)
mov edx,m_dwBackColor
mov [eax],edx
mov eax,S_OK
.else
mov eax, E_POINTER
.endif
ret
get_BackColor endp
;--------------------------------------------------------------------------
;--- the ClientEdge property should change the window style
;--- but to get into effect the window will have to be closed + reopened
;--------------------------------------------------------------------------
put_ClientEdge proc uses __this this_:ptr CAsmClass, fEdge:DWORD
mov __this,this_
DebugOut "put_ClientEdge"
xor ecx,ecx
movzx eax,word ptr fEdge
test eax,eax
setne cl
mov m_wClientEdge,cx
mov m_isDirty, TRUE
.if (m_hWnd)
movzx eax,m_wClientEdge
.if (eax)
mov ecx,WS_EX_CLIENTEDGE
.else
mov ecx,0
.endif
invoke SetWindowLong,m_hWnd,GWL_EXSTYLE,ecx
.endif
invoke SendViewChange@CAsmClass, __this
return S_OK
put_ClientEdge endp
;--------------------------------------------------------------------------
get_ClientEdge proc uses __this this_:ptr CAsmClass, pClientEdge:ptr word
mov __this,this_
DebugOut "get_ClientEdge"
mov eax,pClientEdge
.if (eax)
mov dx, m_wClientEdge
mov [eax],dx
mov eax,S_OK
.else
mov eax, E_POINTER
.endif
ret
get_ClientEdge endp
;--------------------------------------------------------------------------
AboutBox proc uses __this this_:ptr CAsmClass
LOCAL hWnd:HWND
LOCAL pOleWindow:LPOLEWINDOW
local pOleInPlaceSite:LPOLEINPLACESITE
mov __this, this_
DebugOut "AboutBox"
;-------------------------------- get a parent hWnd from the container
mov hWnd, NULL
.if (m_pOleClientSite)
invoke vf(m_pOleClientSite, IUnknown, QueryInterface), addr IID_IOleInPlaceSite, ADDR pOleInPlaceSite
.if SUCCEEDED(eax)
invoke vf(pOleInPlaceSite, IOleWindow, GetWindow_), ADDR hWnd
invoke vf(pOleInPlaceSite, IOleWindow, Release)
.endif
.endif
invoke DialogBoxParam, g_hInstance, IDD_ABOUT, hWnd, ADDR aboutBoxProc, NULL
return S_OK
AboutBox endp
;--------------------------------------------------------------------------
aboutBoxProc proc hWnd:HWND, uMessage:DWORD, wParam:WPARAM, lParam:LPARAM
mov eax,uMessage
.IF (eax == WM_COMMAND)
movzx eax,word ptr wParam
.IF (eax == IDOK)
invoke EndDialog, hWnd, 0
.ENDIF
xor eax,eax
.ELSEIF (eax == WM_INITDIALOG)
mov eax,1
.ELSE
xor eax,eax
.ENDIF
ret
aboutBoxProc endp
;--------------------------------------------------------------------------
put_Value2 proc uses __this this_:ptr CAsmClass, newVal:DWORD
mov __this,this_
DebugOut "put_Value2"
mov eax,newVal
mov m_dwValue2,eax
mov m_isDirty, TRUE
return S_OK
put_Value2 endp
;--------------------------------------------------------------------------
get_Value2 proc uses __this this_:ptr CAsmClass, pVal:ptr DWORD
mov __this,this_
DebugOut "get_Value2"
mov eax,pVal
.if (eax)
mov edx,m_dwValue2
mov [eax],edx
mov eax,S_OK
.else
mov eax, E_POINTER
.endif
ret
get_Value2 endp
end
|
;*** methods of CAsmProp coclass
.586
.model flat, stdcall
option casemap:none ; case sensitive
option proc:private
.nolist
.nocref
WIN32_LEAN_AND_MEAN equ 1
INC_OLE2 equ 1
include windows.inc
include olectl.inc
include macros.inc
include disphlp.inc
include olecntrl.inc
include debugout.inc
include AsmCtrl.inc ;type information (COMView generated)
.list
.cref
include CAsmClass.inc
include CAsmProp.inc
IDD_PROPPAGE equ 1001
IDC_EDIT1 equ 40000
Destroy@CAsmProp proto :ptr CAsmProp
.const
CLSID_CAsmProp sCLSID_AsmProp
;--------------------------------------------------------------------------
;--- IUnknown interface: the table of supp. interfaces must be defined
;--------------------------------------------------------------------------
.const
DEFINE_KNOWN_INTERFACES CAsmProp, IPropertyPage
;--------------------------------------------------------------------------
;--- define table of registry entries for this CLSID
;--- REGSTRUCT = {LPSTR lpszSubKey; LPSTR lpszValueName; LPSTR lpszData}
;--- -1 in lpszSubKey -> key in HKEY_CLASSES_ROOT, in which next
;--- entries will be written. %s is szCLSID in such entries.
;--- else: -1 in lpszData: replaced by szCLSID, -2 in lpszData: replaced by szTLBID
;--- %s is module path in such entries
;--------------------------------------------------------------------------
Description textequ <"OCX control in ASM Property Page">
RegKeys_CAsmProp label REGSTRUCT
REGSTRUCT <-1, 0, CStr("CLSID\%s")>
REGSTRUCT <0, 0, CStr(Description)>
REGSTRUCT
REGSTRUCT
REGSTRUCT
REGSTRUCT <-1, 0, 0>
;-----------------------------------------------------------------
.const
CAsmPropVtbl label IPropertyPageVtbl
IUnknownVtbl {QueryInterface@CAsmProp, AddRef@CAsmProp, Release@CAsmProp}
dd SetPageSite
dd Activate
dd Deactivate
dd GetPageInfo
dd SetObjects
dd Show
dd Move
dd IsPageDirty
dd Apply
dd Help
dd TranslateAccelerator_
.code
__this textequ
_this textequ <[__this].CAsmProp>
MEMBER pPropertyPageSite, hWnd, pObject, rect, bModal, bIsDirty, bInitUI
DEFINE_STD_COM_METHODS CAsmProp
;--------------------------------------------------------------------------
;--------------- constructor CAsmProp
;--------------------------------------------------------------------------
Create@CAsmProp proc public uses __this pClass: ptr ObjectEntry, pUnkOuter:LPUNKNOWN
DebugOut "Create@CAsmProp"
invoke LocalAlloc, LMEM_FIXED or LMEM_ZEROINIT,sizeof CAsmProp
.if (eax == NULL)
ret
.endif
mov __this,eax
mov m__IPropertyPage, OFFSET CAsmPropVtbl
STD_COM_CONSTRUCTOR CAsmProp
if ?AGGREGATION
lea eax, m__IUnknown
ret
else
return __this
endif
Create@CAsmProp endp
;--------------------------------------------------------------------------
;--------------- destructor
;--------------------------------------------------------------------------
Destroy@CAsmProp PROC public uses __this this_:ptr CAsmProp
DebugOut "Destroy@CAsmProp enter"
mov __this,this_
STD_COM_DESTRUCTOR CAsmProp
.if (m_pPropertyPageSite)
invoke vf(m_pPropertyPageSite, IUnknown, Release)
.endif
.if (m_pObject)
invoke vf(m_pObject, IUnknown, Release)
.endif
invoke LocalFree, __this
ret
Destroy@CAsmProp ENDP
;--- the window proc of the property sheet
dlgproc proc uses __this hWnd:HWND, uMessage:DWORD, wParam:WPARAM, lParam:LPARAM
local dwValue:DWORD
mov eax,uMessage
.IF (eax == WM_COMMAND)
DebugOut "CAsmProp wndproc WM_COMMAND"
movzx eax, word ptr wParam
.if (eax == IDC_EDIT1)
movzx eax, word ptr wParam+2
.if (eax == EN_CHANGE)
invoke GetWindowLong, hWnd, DWL_USER
mov __this, eax
.if (!m_bInitUI)
mov m_bIsDirty, TRUE
invoke vf(m_pPropertyPageSite, IPropertyPageSite, OnStatusChange),\
PROPPAGESTATUS_DIRTY
.endif
.endif
.endif
xor eax,eax
.ELSEIF (eax == WM_INITDIALOG)
DebugOut "CAsmProp wndproc WM_INITDIALOG"
invoke SetWindowLong, hWnd, DWL_USER, lParam
mov __this, lParam
.if (m_pObject)
mov m_bInitUI, TRUE
invoke vf(m_pObject, IAsmClass, get_Value), addr dwValue
.if (eax == S_OK)
invoke SetDlgItemInt, hWnd, IDC_EDIT1, dwValue, FALSE
.endif
mov m_bInitUI, FALSE
.endif
mov eax,1
.ELSEIF (eax == WM_CLOSE)
DebugOut "CAsmProp wndproc WM_CLOSE"
invoke DestroyWindow, hWnd
.ELSE
xor eax,eax
.ENDIF
ret
dlgproc endp
SetPageSite proc uses __this this_:ptr CAsmProp, pSite:ptr IPropertyPageSite
DebugOut "SetPageSite@CAsmProp"
mov __this, this_
invoke ComPtrAssign, addr m_pPropertyPageSite, pSite
mov eax, S_OK
ret
SetPageSite endp
Activate proc uses __this this_:ptr CAsmProp, hWnd:HWND, pRect:LPRECT, bModal:BOOL
DebugOut "Activate@CAsmProp"
mov __this, this_
invoke CopyRect, addr m_rect, pRect
invoke CreateDialogParam, g_hInstance, IDD_PROPPAGE, hWnd, offset dlgproc, __this
.if (eax)
mov m_hWnd, eax
mov eax, S_OK
.else
mov eax, E_OUTOFMEMORY
.endif
ret
Activate endp
Deactivate proc uses __this this_:ptr CAsmProp
DebugOut "Deactivate@CAsmProp"
mov __this, this_
.if (m_hWnd)
invoke DestroyWindow, m_hWnd
mov m_hWnd, NULL
.endif
mov eax, S_OK
ret
Deactivate endp
GetPageInfo proc uses __this esi this_:ptr CAsmProp, pPPInfo:ptr PROPPAGEINFO
DebugOut "GetPageInfo@CAsmProp"
mov __this, this_
mov esi, pPPInfo
mov [esi].PROPPAGEINFO.cb, sizeof PROPPAGEINFO
invoke CoTaskMemAlloc, 32*2
mov [esi].PROPPAGEINFO.pszTitle, eax
.if (eax)
invoke lstrcpyW, eax, CStrW(L("AsmCtrl PropPage"))
.endif
mov [esi].PROPPAGEINFO.size_.cx_, 240
mov [esi].PROPPAGEINFO.size_.cy, 180
invoke CoTaskMemAlloc, 32*2
mov [esi].PROPPAGEINFO.pszDocString, eax
.if (eax)
invoke lstrcpyW, eax, CStrW(L("AsmCtrl DocString"))
.endif
if 0
invoke CoTaskMemAlloc, 32*2
mov [esi].PROPPAGEINFO.pszHelpFile, eax
.if (eax)
invoke lstrcpyW, eax, CStrW(L("AsmCtrl HelpFile"))
.endif
else
mov [esi].PROPPAGEINFO.pszHelpFile, NULL
endif
mov [esi].PROPPAGEINFO.dwHelpContext, 0
mov eax, S_OK
ret
GetPageInfo endp
;--- currently only 1 object supported
SetObjects proc uses __this this_:ptr CAsmProp, cObjects:DWORD, ppUnk:ptr LPUNKNOWN
DebugOut "SetObjects@CAsmProp"
mov __this, this_
mov ecx, cObjects
.if (ecx)
mov edx, ppUnk
mov eax, [edx]
.if (eax)
lea ecx, m_pObject
invoke vf(eax, IUnknown, QueryInterface), offset IID_IAsmClass, ecx
.endif
.else
.if (m_pObject)
invoke vf(m_pObject, IUnknown, Release)
mov m_pObject, NULL
.endif
.endif
mov eax, S_OK
ret
SetObjects endp
Show proc uses __this this_:ptr CAsmProp, nCmdShow:DWORD
DebugOut "Show@CAsmProp"
mov __this, this_
.if (nCmdShow)
invoke ShowWindow, m_hWnd, SW_SHOW
.else
invoke ShowWindow, m_hWnd, SW_HIDE
.endif
mov eax, S_OK
ret
Show endp
Move proc uses __this this_:ptr CAsmProp, pRect:LPRECT
DebugOut "Move@CAsmProp"
mov __this, this_
invoke CopyRect, addr m_rect, pRect
mov eax, S_OK
ret
Move endp
IsPageDirty proc uses __this this_:ptr CAsmProp
DebugOut "IsPageDirty@CAsmProp"
mov __this, this_
.if (m_bIsDirty)
mov eax, S_OK
.else
mov eax, S_FALSE
.endif
ret
IsPageDirty endp
Apply proc uses __this this_:ptr CAsmProp
DebugOut "Apply@CAsmProp"
mov __this, this_
.if (m_hWnd)
invoke GetDlgItemInt, m_hWnd, IDC_EDIT1, NULL, FALSE
invoke vf(m_pObject, IAsmClass, put_Value), eax
.endif
mov m_bIsDirty, FALSE
mov eax, S_OK
ret
Apply endp
Help proc uses __this this_:ptr CAsmProp, pHelp:LPOLESTR
DebugOut "Help@CAsmProp"
mov eax, E_NOTIMPL
ret
Help endp
TranslateAccelerator_ proc uses __this this_:ptr CAsmProp, pMsg:ptr MSG
DebugOut "TranslateAccelerator@CAsmProp"
mov eax, E_NOTIMPL
ret
TranslateAccelerator_ endp
end
|
