伊莉討論區

標題: VB6 InputBox改成ComboBox輸入 [打印本頁]
作者: Waroger    時間: 2018-6-29 02:55 PM     標題: VB6 InputBox改成ComboBox輸入

本帖最後由 Waroger 於 2018-6-29 02:59 PM 編輯

將VB6 的InputBox元件改成下拉式選單，除了讓使用者方便輸入並能限制使用者輸入固定的數值。
  1. '底下在模組

  3. Private Type POINTAPI
  4.         x As Long
  5.         Y As Long
  6. End Type

  8. Private Type RECT
  9.         Left As Long
  10.         Top As Long
  11.         Right As Long
  12.         Bottom As Long
  13. End Type
  14. Private Type WINDOWPLACEMENT
  15.         Length As Long
  16.         flags As Long
  17.         showCmd As Long
  18.         ptMinPosition As POINTAPI
  19.         ptMaxPosition As POINTAPI
  20.         rcNormalPosition As RECT
  21. End Type

  23. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  24. Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  25. Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  26. Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
  27. Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
  28. Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  29. Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  30. Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
  31. Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  32. Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  33. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  34. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

  36. Public ms As String, cm As ComboBox

  38. Public Sub chg2ComboBox(ByVal h As Long, ByVal m As Long, ByVal i As Long, ByVal t As Long)
  39.     Dim x As Long, k As String
  40.     Static f As Long, tmp As String, b As Boolean
  41.    
  42.     x = FindWindow("#32770", ms)
  43.     If x Then
  44.        If b Then
  45.           k = cm
  46.           If tmp <> k Then SetWindowText f, k: tmp = k
  47.        Else
  48.           f = FindWindowEx(x, ByVal 0&, "Edit", vbNullString)
  49.           If f Then
  50.              Dim w As WINDOWPLACEMENT
  51.             
  52.              w.Length = Len(w)
  53.              GetWindowPlacement f, w
  54.              SetParent cm.hwnd, x
  55.              SetWindowPlacement cm.hwnd, w
  56.              w.showCmd = 0
  57.              SetWindowPlacement f, w
  58.              b = True
  59.           End If
  60.          
  61.        End If
  62.     Else
  63.        b = False: f = 0: tmp = ""
  64.        KillTimer h, i
  65.     End If
  66. End Sub

  68. '------------------------------------
  69. '底下在表單，置放一個CommandButton

  71. Const GW_CHILD = 5
  72. Const GWL_STYLE = (-16)
  73. Const NV_INPUTBOX As Long = &H5000&

  75. Private Sub Command1_Click()
  76.     Dim i, s
  77.    
  78.     Set cm = Controls.Add("VB.ComboBox", "Combo1")
  79.     With cm
  80.          .FontName = "微軟正黑體"
  81.          .FontItalic = True
  82.          .ForeColor = vbRed
  83.          .FontSize = 9
  84.          .Visible = True
  85.          s = Array("台北市", "新北市", "台北市", "台中市", "台南市", "高雄市")
  86.          For Each i In s
  87.              cm.AddItem i
  88.          Next
  89.          DestroyWindow GetWindow(.hwnd, GW_CHILD)
  90.          SetWindowLong .hwnd, GWL_STYLE, GetWindowLong(.hwnd, GWL_STYLE) + 1
  91.     End With
  92.     ms = "選擇城市"
  93.     SetTimer hwnd, NV_INPUTBOX, 10, AddressOf chg2ComboBox
  94.     s = InputBox("請選擇所在城市", ms)
  95.     Controls.Remove cm
  96.     If StrPtr(s) Then MsgBox s
  97. End Sub
複製代碼




歡迎光臨 伊莉討論區 (http://a401.file-static.com/) Powered by Discuz!