Antonariyпереместить апдаун поверх текстбокса
Пробовал давно уже, несерьезно это.
В общем случае текст (кот. вводится в текстбокс) будет задвигаться под апдаун.
Да и все поведение этой конструкции попахивает глючностью.
Короче здесь проще сделать текстбокс через API. Сделал уже (см. вложение).
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Private Sub InitUpDown()
Dim fnt As IFont
Const UPDOWNSTYLE = WS_CHILDWINDOW Or WS_VISIBLE Or WS_GROUP Or _
UDS_SETBUDDYINT Or UDS_ALIGNRIGHT Or _
UDS_ARROWKEYS Or UDS_NOTHOUSANDS 'Or UDS_AUTOBUDDY
'===============================================================================
'создаем TextBox через API
hEdit1 = CreateWindowEx(WS_EX_CLIENTEDGE, "edit", "", _
ES_AUTOHSCROLL Or ES_NUMBER Or WS_VISIBLE Or WS_CHILD, _
0, 0, Picture_hEdit1.Width, Picture_hEdit1.Height, Picture_hEdit1.hWnd, 0&, App.hInstance, 0&)
Set fnt = Me.Font
SendMessage hEdit1, WM_SETFONT, fnt.hFont, ByVal 0
Set fnt = Nothing
Edit_SetMaxLength hEdit1, 2
'пристыковка UpDown к hEdit1
hWndUpDown_to_hEdit1 = CreateUpDownControl(UPDOWNSTYLE, 0, 0, 0, 0, _
Picture_hEdit1.hWnd, 1, _
App.hInstance, hEdit1, 99, 0, _
5)
End Sub
С Edit 2 сложности:
1) шрифт -к счастью я знаю как стянуть его у формы без всяких CreateFont
2) цвет текстбокса -он при создании наследует цвет родителя, т.е . ButtonFace.
Решается через ту же волшебную картинку-VBконтейнер(которая для TabIndex и для фокуса) -ей надо присвоить "Window Background"-и все автоматом будет хорошо.
Ну и "традиционная" чуть адаптированная под TextBox отработка фокуса:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
Private Sub Picture_hEdit1_GotFocus()
Debug.Print "Picture_hEdit1_GotFocus(VB_Container)"
PutFocus hEdit1
End Sub
Public Function NewPictureHEdit1WindowProc _
(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim uEN As Long
Select Case Msg
Case WM_COMMAND
uEN = HIWORD(VarPtr(ByVal wParam&))
Select Case uEN
Case EN_SETFOCUS
Debug.Print "EN_SETFOCUS(API_Control)"
Call SendMessage(Form1.Picture_hEdit1.hWnd, WM_SETFOCUS, 0&, 0&)
Case EN_KILLFOCUS
Debug.Print "EN_KILLFOCUS(API_Control)"
Case Else
End Select
Case Else
End Select
NewPictureHEdit1WindowProc = CallWindowProc _
(OldPictureHEdit1WindowProc, hWnd, Msg, wParam, lParam)
End Function
Private Function HIWORD(ByRef lThis As Long) As Long
If (lThis And &H80000000) = &H80000000 Then
HIWORD = ((lThis And &H7FFF0000) \ &H10000) Or &H8000&
Else
HIWORD = (lThis And &HFFFF0000) \ &H10000
End If
End Function
С UpDown+APItextbox я даже еще выигрываю, потому как с VB-шным текстбоксом надо сабклассить еще и сам UpDown,
а иначе при нажатии на вверх-вниз он уводит фокус из текстбокса, ну и плюс выделение всего текста (это если по "стандарту")
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Public Function NewUpDownRetryDelayMaxRndSetupWindowProc _
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_LBUTTONDOWN
FormRndSetup.TextRetryDelayMax.SetFocus
Case WM_LBUTTONUP
FormRndSetup.TextRetryDelayMax.SelStart = 0
FormRndSetup.TextRetryDelayMax.SelLength = Len(FormRndSetup.TextRetryDelayMax.Text)
Case Else
End Select
NewUpDownRetryDelayMaxRndSetupWindowProc = CallWindowProc( _
OldUpDownRetryDelayMaxRndSetupWindowProc, hwnd, Msg, wParam, _
lParam)
End Function
Так вот, в случае API-шного Edit этот код не нужен, там это автоматически сработает.
