PDA

View Full Version : تشخیص متن زیر کرسر موس



arsalansalar
شنبه 08 دی 1386, 22:01 عصر
با سلام
من در این سایت و خیلی از سایتهای برنامه نویسی که سرچ می کردم خیلی از دوستان دنبال برنامه ای بودند که متن زیر کرسر موس را capture کند.
من این نرم افزار را به زبان های vb,vb.net,delphi,c#,cپیدا کردم اگر کسی می خواهد با این ایمیل ارتباط برقرار کند.
arsalan_moghashang{@}yahoo{dot}com (arsalan_moghashang@yahoo.com)

hesam_hma
شنبه 08 دی 1386, 23:21 عصر
دوست عزیز سلام
اگه براتون مقدوره همینجا این برنامه رو قرار بدید تا همه دوستان استفاده کنند
با تشکر

Hossis
سه شنبه 11 دی 1386, 21:51 عصر
این کد در وی بی 6 جواب می ده (در Rich TextBox)

'Add 1 Rich Text Box and 1 Label to your form.
'Insert the following code to your form:
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Public Function RichWordOver(rch As RichTextBox, x As Single, y As Single) As String
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
pt.x = x \ Screen.TwipsPerPixelX
pt.y = y \ Screen.TwipsPerPixelY
pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If pos <= 0 Then Exit Function
txt = rch.Text
For start_pos = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For
Next start_pos
start_pos = start_pos + 1
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or ch = "_") Then Exit For
Next end_pos
end_pos = end_pos - 1
If start_pos <= end_pos Then _
RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function
Private Sub Form_Load()
RichTextBox1.Text = "This example will show you how to" & _
vbCrLf & vbCrLf & "know on which word the mouse hover in Rich Text Box"
End Sub
Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x _
As Single, y As Single)
Dim txt As String
txt = RichWordOver(RichTextBox1, x, y)
If Label1.Caption <> txt Then _
Label1.Caption = txt
End Sub

titbasoft
سه شنبه 11 دی 1386, 21:57 عصر
اگر کدی دارید و می خواهید در اختیار عموم باشه می تونید همینجا یا بهتر در تاپیک Source code (http://barnamenevis.org/forum/showthread.php?t=58718) آپلودش کنید