Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Change ComboBox Style @ Run-Time

10 views
Skip to first unread message

Andy DF

unread,
Sep 3, 2004, 1:29:51 PM9/3/04
to
I need to load a Combobox at run time with Controls.Add and I need it to be
DropDownList.

I'm not getting to work my GetWindowLong/SetWindowLong calls.
Can it be done?

TIA,

--
Andy,
pcto...@hotmail.com


Tom Esh

unread,
Sep 3, 2004, 2:58:47 PM9/3/04
to
On Fri, 3 Sep 2004 19:29:51 +0200, "Andy DF" <Priva...@vb.com>
wrote:

>I need to load a Combobox at run time with Controls.Add and I need it to be
>DropDownList.
>
>I'm not getting to work my GetWindowLong/SetWindowLong calls.
>Can it be done?

It's one of those styles that can only be specified when the control
window is created, hence read-only at runtime.
One alternative is to create your own combo with the Api
(CreateWindowEx). Of course the drawback there is VB will know nothing
about it and you'll have to use strictly Api methods with it, plus
subclassing for all events.
A better solution IMO is to use a windows hook (SetWindowsHookEx) to
change the style ~as~ it's being created. Essentially the steps are:
1) Set the hook.
2) Controls.Add
3) Unhook
Your hook callback would be responsible for changing the style bit.

If it helps, here's a generic CBT hook style changer I use.
('scuse the line wraps):

'==== Api Decl ====================================
Private Declare Function SetWindowsHookEx Lib "user32" Alias
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpFn As Long, ByVal
hMod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook
As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As
Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As
Long
Private Const WH_CBT = 5&
Private Const HC_ACTION = 0&
Private Const HCBT_CREATEWND = 3&

Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias
"GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String,
ByVal nMaxCount As Long) As Long

'==== module ================================
'hook arg vars...
Dim m_hHook As Long
Dim m_ClassName As String
Dim m_StylesAdd As Long, m_StylesRemove As Long
Dim m_ExStylesAdd As Long, m_ExStylesRemove As Long
Dim m_CallNext As Boolean
Dim m_UseExactClassname As Boolean

Public Sub CbtHookStyle(sClassname As String, Optional ByVal
UseExactClassname As Boolean = False, Optional ByVal StylesAdd As Long
= 0&, Optional ByVal StylesRemove As Long = 0&, Optional ByVal
ExStylesAdd As Long = 0&, Optional ByVal ExStylesRemove As Long = 0&,
Optional ByVal CallNextHook As Boolean = False)
'Sets hook - call just prior to adding control
CbtUnhookStyle 'allow only 1 active at any time
m_ClassName = sClassname
m_StylesAdd = StylesAdd
m_StylesRemove = StylesRemove
m_ExStylesAdd = ExStylesAdd
m_ExStylesRemove = ExStylesRemove
m_CallNext = CallNextHook
m_UseExactClassname = UseExactClassname
m_hHook = SetWindowsHookEx(WH_CBT, AddressOf CbtHook, 0&,
App.ThreadID)
End Sub

Public Sub CbtUnhookStyle()
'unhooks - call immediately after adding control
If m_hHook <> 0& Then
UnhookWindowsHookEx m_hHook
m_hHook = 0&
End If
End Sub

Private Function CbtHook(ByVal nCode As Long, ByVal hwnd As Long,
ByVal lpCBCT As Long) As Long
Select Case nCode
Case Is < HC_ACTION
CbtHook = CallNextHookEx(m_hHook, nCode, hwnd, ByVal
lpCBCT)
Exit Function '===============>>>
Case HCBT_CREATEWND
OnCreate ByVal hwnd
Case Else
'do nothing
End Select

If m_CallNext Then
CbtHook = CallNextHookEx(m_hHook, nCode, hwnd, ByVal lpCBCT)
End If
End Function

Private Sub OnCreate(ByVal hwnd As Long)
Dim L As Long, lRet As Long
Dim sClass As String
Dim bHit As Boolean

sClass = String(256, 0)
lRet = GetClassName(hwnd, sClass, 255&)
If lRet > 0& Then
If m_UseExactClassname Then
'(non case-sens match)
sClass = Left$(sClass, lRet)
bHit = (StrComp(sClass, m_ClassName, vbTextCompare) = 0)
Else
'(fuzzy match)
bHit = (InStr(1, sClass, m_ClassName, vbTextCompare) > 0)
End If
If bHit Then
'make style, exstyle changes...
If (m_StylesAdd Or m_StylesRemove) <> 0& Then
L = GetWindowLong(hwnd, GWL_STYLE)
L = L Or m_StylesAdd
L = L And (Not m_StylesRemove)
SetWindowLong hwnd, GWL_STYLE, L
End If

If (m_ExStylesAdd Or m_ExStylesRemove) <> 0& Then
L = GetWindowLong(hwnd, GWL_EXSTYLE)
L = L Or m_ExStylesAdd
L = L And (Not m_ExStylesRemove)
SetWindowLong hwnd, GWL_EXSTYLE, L
End If
End If 'is class
End If
End Sub

-Tom
MVP - Visual Basic
(please post replies to the newsgroup)

Andy DF

unread,
Sep 7, 2004, 3:40:35 AM9/7/04
to
Tom,

just wanted to thank you, works great.

--
Andy,
pcto...@hotmail.com


"Tom Esh" <tjeshGi...@earthlink.net> ha scritto nel messaggio
news:i6ehj05k02jcqtnlc...@4ax.com...

0 new messages