| ilim | Дата: Среда, 09.11.2011, 22:29 | Сообщение # 1 |
 Генералиссимус
Группа: Администраторы
Сообщений: 680
Награды: 17
Репутация: 4
Статус: Оффлайн
| 'Если нужно показать кнопку, когда пользователь прокрутит
'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
|
| |
| |
