PDA

View Full Version : سوال: چگونه لیستی که با باز شدن combobox ظاهر میشود را تغیر اندازه دهم؟



pernia
دوشنبه 04 خرداد 1388, 16:10 عصر
سلام حرفه ای های ایران
من دارم یه combobox رو با رشته هایی که تعدادشون حدود 100 تا میشه پر میکنم
اما مشکل اینجاست که پس از اینکه combo رو با ماوس باز میکنیم ، فقط میشه در هر لحظه تعداد کمی از اونا (حدود 8 تا) رو دید !!!

من میخوام تغیری داخل این combo بدم که مثلا حدود 30 تا سطر رو نشون بده در هر لحظه ، در ضمن وقتی جای یه سطر داخلش نیست بزاره تا شبیه شکل زیر تغیر اندازه بدیم!
این دقیقا عکس اون چیزیه که دنبالشم!
بعضی از کنترل های وی بی دیگه بد رقم ضعف دارن حتی داخل dotnet هم همین مشکل وجود داره ! شدید گرفتار شدم!
http://www.img98.com/images/ldldd2ljbgsuugx0zk22.gif

hamed_arfaee
سه شنبه 05 خرداد 1388, 21:26 عصر
سلام

http://vbnet.mvps.org/index.html?code/comboapi/comboheight.htm

red11011
چهارشنبه 06 خرداد 1388, 08:41 صبح
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 Command Buttons, 1 Combo Box and 1 Text Box.
'At Run-Time, Insert into the Text Box the number of items the Combo Box will display
'for each scroll, and press Command1 to apply. Press Command2 to return to default state.
'Insert the following code to your module:
Option Explicit
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private lpPrevWndProc As Long
Public lHookedhWnd As Long
Public iListItems As Integer
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const WM_CTLCOLORLISTBOX = &H134
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(lHookedhWnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
Public Sub Unhook()
Dim lRetVal As Long
lRetVal = SetWindowLong(lHookedhWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg _
As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
Select Case uMsg
Case WM_CTLCOLORLISTBOX
Dim rc As RECT
Dim lItemHeight As Long
Dim lListHeight As Long
Static bIgnore As Boolean
Const LIST_ITEMS As Long = 20
If Not bIgnore Then
With rc
lItemHeight = SendMessage(lParam, LB_GETITEMHEIGHT, 0, ByVal 0&)
lListHeight = lItemHeight * iListItems + 2
Call GetWindowRect(lParam, rc)
bIgnore = True
Call MoveWindow(lParam, .Left, .Top, (.Right - .Left), lListHeight, True)
bIgnore = False
End With
End If
Case Else
End Select
End Function
'Insert the following code to your form:
Private Sub Command1_Click()
Command1.Enabled = Not (Command1.Enabled)
Command2.Enabled = Not (Command2.Enabled)
Hook
End Sub
Private Sub Command2_Click()
Command1.Enabled = Not (Command1.Enabled)
Command2.Enabled = Not (Command2.Enabled)
Unhook
End Sub
Private Sub Form_Load()
Command2.Enabled = False
Text1 = "2"
Command1.Caption = "Set"
Command2.Caption = "Release"
Dim i As Integer
For i = 1 To 51
Combo1.AddItem "Num " & i
Next
iListItems = 2
lHookedhWnd = Combo1.hWnd
End Sub
Private Sub Text1_Change()
iListItems = Val(Text1)
If iListItems < 1 Then
iListItems = 1
End If
End Sub
این هم هست

pernia
چهارشنبه 06 خرداد 1388, 14:37 عصر
فقط یه چیزش کمه!
اگه به اون عکس دقت کنید باید بشه از نظر عرضی هم زیادش کرد! چون string داخلش جاش نیست!

این مثال ها سطر هاش رو فقط زیاد میکنن که خوبه ولی وقتی توی این قسمت :

Call MoveWindow(Combo1.hWnd, pt.x, pt.y, Combo1.Width, newHeight, True)

به combo.width عددی اضافه میکنیم تا از نظر عرضی هم بهش اضلفه بشه متاسفانه خود combo هم
عرضش اضافه میشه!

به هر صورت کمال تشکر رو از کسانی که کمکم میکنن دارم.

pernia
چهارشنبه 06 خرداد 1388, 14:50 عصر
اقا درست شد اینا رئ هم پیدا کردم اضافه کردم بهش ردیف شد

Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Copyright ©1996-2009 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_SHOWDROPDOWN = &H14F
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160

Private Sub Command1_Click()
Dim cwidth As Long
Dim NewDropDownWidth As Long

'check if a number is entered into Text1.
'If not, bail out.
If Val(Text1.Text) Then
'here we simply set the dropdown list size to
'the value entered in Text1. Note: If the proposed
'width this is less than the width of the combo
'portion, the combo width is used (the dropdown
'can never be narrower than the combo box)
NewDropDownWidth = Val(Text1.Text)

'resize the dropdown portion of the combo box using SendMessage
Call SendMessage(Combo1.hwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, ByVal 0)

'reflect the new dropdown list width in the Label
cwidth = SendMessage(Combo1.hwnd, CB_GETDROPPEDWIDTH, 0, ByVal 0)
Label1.Caption = "Current dropdown width = " & cwidth & " pixels."

'drop the list down by code to show the new size
Call SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, True, ByVal 0)

End If
End Sub



دست همتون درد نکنه