ilim | Дата: Среда, 09.11.2011, 22:29 | Сообщение # 1 |
 Генералиссимус
Группа: Администраторы
Сообщений: 680
Награды: 17
Репутация: 4
Статус: Offline
| 'Если нужно показать кнопку, когда пользователь прокрутит 'TextBox до конца, (напр. пользователь должен прочесть договор, и только когда 'прочтет, то отобразить кнопку "Согласен")
Private Const EM_CHARFROMPOS = &HD7 Private Const EM_GETRECT = &HB2
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Command1_Click() Unload Me End Sub
Private Sub Form_Load() Text1.Text = "Ready-To-Run Visual Basic Algorithms, Second Edition" & _ vbCrLf & vbCrLf & "Extend your applications with powerful algorithms written in Visual Basic. Sorting, searching, trees, hashing, advanced recursion, network algorithms, object-oriented programming, and much more. Visual Basic Algorithms updated and expanded for Visual Basic 5." & _ vbCrLf & vbCrLf & "http://www.vb-helper.com/vba.htm" & _ vbCrLf & "----------" & _ vbCrLf & "Bug Proofing Visual Basic" & _ vbCrLf & vbCrLf & "Every program more than 10 lines long contains at least one bug. Learn how to prevent, detect, and eradicate bugs in your programs." & _ vbCrLf & vbCrLf & "http://www.vb-helper.com/err.htm" End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim pos As Long
' Get the position of the bottom of the control. X = CLng(ScaleX(X, ScaleMode, vbPixels)) Y = CLng(ScaleY(Y, ScaleMode, vbPixels))
' Get the character number pos = SendMessageLong(Text1.hWnd, EM_CHARFROMPOS, _ 0&, X + Y * &H10000) And &HFFFF&
Debug.Print X; Y; pos; Len(Text1.Text) '@ If pos >= Len(Text1.Text) Then Command1.Enabled = True End If End Sub
' See if the last line is visible. Private Sub Timer1_Timer() Static done_before As Boolean Static X As Long Static Y As Long
Dim r As RECT Dim pos As Long
' Get text box's client rectangle size. If Not done_before Then SendMessageAny Text1.hWnd, EM_GETRECT, 0&, r X = r.Right - 1 Y = r.Bottom - 1 done_before = True End If
' Get the character number pos = SendMessageLong(Text1.hWnd, _ EM_CHARFROMPOS, 0&, X + Y * &H10000) _ And &HFFFF&
If pos >= Len(Text1.Text) Then Command1.Enabled = True Timer1.Enabled = False End If End Sub
www.ilim.kz
|
|
| |