找一个有源码的自定义的多行文本编辑控件

Chice_wxg 2004-10-07 11:55:36

我曾经见过它，可惜现在找不到了。

它是用PictureBox控件自画实现了文本编辑框。

如今急用（另写代码来不及了，哎），哪位朋友见过请帮忙了~~~~~~~~~

给地址也行，直接发到信箱也行 chice_wxg[AT]163.com （请把[AT]换成 @ ）

多谢！

（可再另给200分 ^_^ ）

...全文

134 11 打赏收藏转发到动态举报

写回复

用AI写文章

11 条回复

切换为时间正序

请发表友善的回复…

发表回复

hxy2003 2004-10-09

打赏
举报

haohaohappy 2004-10-09

打赏
举报

恭喜恭喜，高手

jam021 2004-10-09

打赏
举报

关注,帮你顶!

Chice_wxg 2004-10-07

打赏
举报

呵呵，稍简单了点~~~~

我原来见的那个例子做的相当好的。

cso 2004-10-07

打赏
举报

这是一个用picture模仿text控件的例子，基本的输入功能都有，你可以慢慢修改将他做成为你自己的text控件，功能慢慢的加吧，等待你的好消息
========================================
加入一个Picture控件，然后输入以下代码：
Option Explicit

Private Declare Function CreateCaret& Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long)
Private Declare Function ShowCaret& Lib "user32" (ByVal hwnd As Long)
Private Declare Function SetCaretPos& Lib "user32" (ByVal x As Long, ByVal y As Long)
Private Declare Function HideCaret& Lib "user32" (ByVal hwnd As Long)

Private Declare Function DestroyCaret& Lib "user32" ()

Private Sub Form_Load()
Form1.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.FontSize = 14
End Sub

Private Sub Picture1_Click()
' Picture1_GotFocus
End Sub

Private Sub Picture1_GotFocus()
Dim dl&
Dim CreateHeight As Integer

CreateHeight = Picture1.TextHeight("I")
dl& = CreateCaret(Picture1.hwnd, 0, 2, CreateHeight)
dl& = SetCaretPos(Picture1.CurrentX, Picture1.CurrentY)
dl& = ShowCaret(Picture1.hwnd)
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
Dim dl&

dl& = HideCaret(Picture1.hwnd)
Picture1.Print Chr(KeyAscii);
If Picture1.CurrentX >= (Picture1.Width - Picture1.TextWidth("W")) Then '换行
Picture1.CurrentX = 0
Picture1.CurrentY = Picture1.CurrentY + Picture1.TextHeight("I")
End If
dl& = SetCaretPos(Picture1.CurrentX, Picture1.CurrentY)
dl& = ShowCaret(Picture1.hwnd)
End Sub

Private Sub Picture1_LostFocus()
Dim dl&
' dl& = DestroyCaret
End Sub

Chice_wxg 2004-10-07