Solved

how do i send color format and bold and size

Posted on 2004-08-11
8
268 Views
Last Modified: 2008-01-09
VB:
--------------------------------------------------------------------------------
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
   
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
   
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
    (ByVal hwnd As Long) As Long
   
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
   
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 Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_KEYDOWN = &H100
Private Const WM_SETTEXT = &HC

Private lhWnd(1) As Long
Private palLong As Long
Private palGroupName As String
Private palStatusBar As Long
Private palStatusText As String
Private palLastJoined As String
Private palTextBox As Long
Private isRunning As Boolean

Private Sub Form_Load()

    With Timer1
        .Enabled = False
        .Interval = 1
    End With
   
    Command1.Caption = "Start Greeter"
    Text1.Text = "***-Welcome  %sn-***"
    isRunning = False
   
     With RichTextBox1
        .SelBold = True
        .SelColor = vbRed
           .SelFontSize = 12
            End With
           RichTextBox1.SelText = Text1.Text

End Sub

Private Sub Command1_Click()

    If isRunning = True Then
   
        Command1.Caption = "Start Greeter"
             isRunning = False
                Timer1 = False
    Else
   
        Command1.Caption = "Stop Greeter"
             isRunning = True
                Timer1 = True
    End If

End Sub

Private Sub Timer1_Timer()

    Dim I As Integer
    Dim NickName As String
    Dim GreetMSG As String
     
       
    lhWnd(0) = FindWindow("#32770", vbNullString) 'Find Group Window
    lhWnd(1) = FindWindowEx(lhWnd(0), 0&, "#32770", vbNullString) 'Find Group Child Win
    palStatusBar = FindWindowEx(lhWnd(0), 0&, "msctls_statusbar32", vbNullString)
    palGroupName = String(GetWindowTextLength(lhWnd(0)) + 1, Chr$(0))
    GetWindowText lhWnd(0), palGroupName, Len(palGroupName)
    palTextBox = FindWindowEx(lhWnd(1), 0&, "richedit20a", vbNullString)
    palTextBox = FindWindowEx(lhWnd(1), palTextBox, "richedit20a", vbNullString)
   
    If InStr(1, LCase(palGroupName), LCase(" GROUP")) Then 'Verify Group
 
        If isRunning = True Then
       
            palLong = SendMessageLong(palStatusBar, WM_GETTEXTLENGTH, 0&, 0&) 'Get Text Length
            palStatusText = String(palLong + 1, " ") 'Create Buffer
            Call SendMessageByString(palStatusBar, WM_GETTEXT, palLong + 1, palStatusText) 'Get Text
            palStatusText = Left(palStatusText, palLong) 'Remove Blanks
   
            I = InStr(1, palStatusText, "joined") - 13 'Check for Join Messages
           
            If I < 0 Then Exit Sub 'If no join message then GET OUT!
           
            NickName = Mid(palStatusText, 8, I) 'Get the Nickname
             On Error Resume Next
AppActivate "Group - Voice Conference"
On Error Resume Next
            If palLastJoined <> NickName Then 'Check if not joined already
                palLastJoined = NickName 'Remember the last Nickname joined
               
                GreetMSG = Replace(Text1.Text, "%sn", NickName) 'Replace %sn with The NickName
               On Error Resume Next
AppActivate "Group - Voice Conference"
On Error Resume Next
                Call SendMessageByString(palTextBox, WM_SETTEXT, 0&, GreetMSG) 'Set Text in Box
                Call SendMessageLong(palTextBox, WM_KEYDOWN, 13, 0&) 'Press Enter
               
            End If
        End If
    End If
End Sub
its an autogreeter for a chat called paltalk
0
Comment
Question by:torrment53
  • 4
8 Comments
 
LVL 3

Expert Comment

by:Belthazor
ID: 11784460
hi,
i dont think this is gonna work at all: The chat client has its own 'bold' and 'color' handling, and you cant format your text like the program does. If there are any buttons to do this, you could try pressing them with keydown messages.

Belthazor
0
 
LVL 1

Author Comment

by:torrment53
ID: 11786785
i know it can be done other ppl are doing it only thing is when its in a string its harder when i us richtextbox i can use formatting but when the text is sent from a string im not sure how to do it
0
 
LVL 1

Author Comment

by:torrment53
ID: 11963912
i figured it out works good now
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 1

Author Comment

by:torrment53
ID: 11964008
commondialogue control richtextbox and picture box with command buttons in it heres the code all togeather
vb:
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
   
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
   
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
    (ByVal hwnd As Long) As Long
   
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
   
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 Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_KEYDOWN = &H100
Private Const WM_SETTEXT = &HC

Private lhWnd(1) As Long
Private palLong As Long
Private palGroupName As String
Private palStatusBar As Long
Private palStatusText As String
Private palLastJoined As String
Private palTextBox As Long
Private isRunning As Boolean

Private Sub cmda1_Click()
REB1.SelFontSize = 8
End Sub

Private Sub cmda2_Click()
REB1.SelFontSize = 10
End Sub

Private Sub cmda3_Click()
REB1.SelFontSize = 12
End Sub

Private Sub cmdb_Click()
If REB1.SelBold = True Then
    REB1.SelBold = False
Else
    REB1.SelBold = True
End If
End Sub

Private Sub cmdcolor_Click()
cd1.ShowColor
REB1.SelColor = cd1.Color
End Sub

Private Sub cmdi_Click()
If REB1.SelItalic = True Then
    REB1.SelItalic = False
Else
    REB1.SelItalic = True
End If
End Sub

Private Sub cmdsnd_Click()
    Dim I As Integer
    Dim NickName As String
    Dim GreetMSG As String
     
       
    lhWnd(0) = FindWindow("#32770", vbNullString) 'Find Group Window
    lhWnd(1) = FindWindowEx(lhWnd(0), 0&, "#32770", vbNullString) 'Find Group Child Win
    palStatusBar = FindWindowEx(lhWnd(0), 0&, "msctls_statusbar32", vbNullString)
    palGroupName = String(GetWindowTextLength(lhWnd(0)) + 1, Chr$(0))
    GetWindowText lhWnd(0), palGroupName, Len(palGroupName)
    palTextBox = FindWindowEx(lhWnd(1), 0&, "richedit20a", vbNullString)
    palTextBox = FindWindowEx(lhWnd(1), palTextBox, "richedit20a", vbNullString)
    If InStr(1, LCase(palGroupName), LCase(" GROUP")) Then 'Verify Group
        NickName = " Python"
        GreetMSG = REB1.TextRTF
        Call SendMessageByString(palTextBox, WM_SETTEXT, 0&, GreetMSG) 'Set Text in Box
        Call SendMessageLong(palTextBox, WM_KEYDOWN, 13, 0&) 'Press Enter
    End If
End Sub



Private Sub cmdu_Click()
If REB1.SelUnderline = True Then
    REB1.SelUnderline = False
Else
    REB1.SelUnderline = True
End If
End Sub


Private Sub Form_Load()

    With Timer1
        .Enabled = False
        .Interval = 1
    End With
   
    Command1.Caption = "Start Greeter"
    REB1.Text = "***-Welcome  %sn-***"
    isRunning = False
   
           

End Sub

Private Sub Command1_Click()

    If isRunning = True Then
   
        Command1.Caption = "Start Greeter"
             isRunning = False
                Timer1 = False
    Else
   
        Command1.Caption = "Stop Greeter"
             isRunning = True
                Timer1 = True
    End If

End Sub



Private Sub REB1_Change()

End Sub

Private Sub Timer1_Timer()

    Dim I As Integer
    Dim NickName As String
    Dim GreetMSG As String
     
       
    lhWnd(0) = FindWindow("#32770", vbNullString) 'Find Group Window
    lhWnd(1) = FindWindowEx(lhWnd(0), 0&, "#32770", vbNullString) 'Find Group Child Win
    palStatusBar = FindWindowEx(lhWnd(0), 0&, "msctls_statusbar32", vbNullString)
    palGroupName = String(GetWindowTextLength(lhWnd(0)) + 1, Chr$(0))
    GetWindowText lhWnd(0), palGroupName, Len(palGroupName)
    palTextBox = FindWindowEx(lhWnd(1), 0&, "richedit20a", vbNullString)
    palTextBox = FindWindowEx(lhWnd(1), palTextBox, "richedit20a", vbNullString)
   
    If InStr(1, LCase(palGroupName), LCase(" GROUP")) Then 'Verify Group
 
        If isRunning = True Then
       
            palLong = SendMessageLong(palStatusBar, WM_GETTEXTLENGTH, 0&, 0&) 'Get Text Length
            palStatusText = String(palLong + 1, " ") 'Create Buffer
            Call SendMessageByString(palStatusBar, WM_GETTEXT, palLong + 1, palStatusText) 'Get Text
            palStatusText = Left(palStatusText, palLong) 'Remove Blanks
   
            I = InStr(1, palStatusText, "joined") - 13 'Check for Join Messages
           
            If I < 0 Then Exit Sub 'If no join message then GET OUT!
           
            NickName = Mid(palStatusText, 8, I) 'Get the Nickname
         
            If palLastJoined <> NickName Then 'Check if not joined already
                palLastJoined = NickName 'Remember the last Nickname joined
               
                GreetMSG = Replace(REB1.TextRTF, "%sn", NickName) 'Replace %sn with The NickName
               
                Call SendMessageByString(palTextBox, WM_SETTEXT, 0&, GreetMSG) 'Set Text in Box
                Call SendMessageLong(palTextBox, WM_KEYDOWN, 13, 0&) 'Press Enter
               
            End If
        End If
    End If
End Sub


0
 
LVL 1

Author Comment

by:torrment53
ID: 12396506
plz close ? i gave my own answer and sorry im not positive about how to go about ending a ? thanks
0
 

Accepted Solution

by:
modulo earned 0 total points
ID: 12689633
PAQed with points refunded (400)

modulo
Community Support Moderator
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now