例子
'On form1 place 2 textboxes (with a height for a couple of lines) and 1 picturebox.
'Select a bitmap for the picturebox and set the autosize on true.
Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Execute the app. (F5) and you'll see the difference of the cursorshapes.
End Sub
Sub Text1_GotFocus()
'retrieve the window which has the focus
h& = GetFocus&()
'retrieve the handle of our picture
b& = Picture1.Picture
'Create a new cursor
'(handle, bitmap 0=none, width, height)
Call CreateCaret(h&, b&, 10, 10)
'Show our new cursor
X& = ShowCaret&(h&)
End Sub
Private Sub Text2_GotFocus()
'retrieve the window which has the focus
h& = GetFocus&()
'Create a new cursor
Call CreateCaret(h&, 0, 30, 30)
'Show the new cursor
X& = ShowCaret&(h&)
End Sub
Private Sub Form_Load()
Label1.Height = 300: Label1.Width = 5
Label1.BackColor = vbBlack
Label1.Left = 100: Label1.Top = 100
Timer1.Interval = 500
End Sub
Private Sub Picture1_KeyPress(KeyAscii As Integer)
Picture1.CurrentX = Label1.Left
Picture1.CurrentY = Label1.Top
If KeyAscii <> 13 Then
Picture1.Print Chr(KeyAscii)
Else
Label1.Left = 100
Label1.Top = Label1.Top + TextHeight("a")
End If
Label1.Left = Label1.Left + TextWidth("a")
End Sub
Private Sub Timer1_Timer()
Label1.Visible = Not Label1.Visible
End Sub
在图片框上加一个文本框,设置文本框的borderstyle述行为none,被景色与图片框被景色相同即可,根据光标在图片框上的位置而动态改变文本框的位置,并使文本框获得输入焦点,然后将文本框的文本赋值给图片框,具体代码如下:
private sub picture1_mousedown(x as single,y as single)
text1.top=picture1.currenty
text1.left=picture1.currentx
text1.setfocse
text1.visible=true
end sub
private sub text_change()
picture1.print text1.text
text1.visible=false
end sub