home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / MSNClient_69858472002.psc / frmIM.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-04-07  |  10.8 KB  |  327 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "Richtx32.ocx"
  4. Begin VB.Form frmIM 
  5.    BackColor       =   &H00E0E0E0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Chatting: "
  8.    ClientHeight    =   6150
  9.    ClientLeft      =   45
  10.    ClientTop       =   735
  11.    ClientWidth     =   4740
  12.    Icon            =   "frmIM.frx":0000
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   6150
  16.    ScaleWidth      =   4740
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin MSComctlLib.ProgressBar prgXfr 
  19.       Height          =   255
  20.       Left            =   120
  21.       TabIndex        =   6
  22.       Top             =   4725
  23.       Visible         =   0   'False
  24.       Width           =   1335
  25.       _ExtentX        =   2355
  26.       _ExtentY        =   450
  27.       _Version        =   393216
  28.       Appearance      =   1
  29.       Max             =   1e14
  30.       Scrolling       =   1
  31.    End
  32.    Begin VB.TextBox txtTime 
  33.       Height          =   285
  34.       Left            =   4560
  35.       TabIndex        =   5
  36.       Top             =   4200
  37.       Visible         =   0   'False
  38.       Width           =   150
  39.    End
  40.    Begin VB.TextBox txtInfo 
  41.       Height          =   285
  42.       Left            =   4560
  43.       TabIndex        =   4
  44.       Top             =   4560
  45.       Visible         =   0   'False
  46.       Width           =   150
  47.    End
  48.    Begin VB.TextBox txtOut 
  49.       BeginProperty Font 
  50.          Name            =   "Verdana"
  51.          Size            =   9
  52.          Charset         =   0
  53.          Weight          =   400
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       Height          =   855
  59.       Left            =   120
  60.       TabIndex        =   0
  61.       Top             =   5040
  62.       Width           =   3495
  63.    End
  64.    Begin VB.Timer tmrIM 
  65.       Interval        =   20000
  66.       Left            =   0
  67.       Top             =   3840
  68.    End
  69.    Begin MSComctlLib.StatusBar staIM 
  70.       Align           =   2  'Align Bottom
  71.       Height          =   255
  72.       Left            =   0
  73.       TabIndex        =   3
  74.       Top             =   5895
  75.       Width           =   4740
  76.       _ExtentX        =   8361
  77.       _ExtentY        =   450
  78.       _Version        =   393216
  79.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  80.          NumPanels       =   1
  81.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  82.             AutoSize        =   1
  83.             Object.Width           =   8308
  84.          EndProperty
  85.       EndProperty
  86.    End
  87.    Begin RichTextLib.RichTextBox rtfIn 
  88.       Height          =   4455
  89.       Left            =   120
  90.       TabIndex        =   2
  91.       Top             =   240
  92.       Width           =   4455
  93.       _ExtentX        =   7858
  94.       _ExtentY        =   7858
  95.       _Version        =   393217
  96.       ReadOnly        =   -1  'True
  97.       ScrollBars      =   2
  98.       TextRTF         =   $"frmIM.frx":0442
  99.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  100.          Name            =   "Verdana"
  101.          Size            =   8.25
  102.          Charset         =   0
  103.          Weight          =   400
  104.          Underline       =   0   'False
  105.          Italic          =   0   'False
  106.          Strikethrough   =   0   'False
  107.       EndProperty
  108.    End
  109.    Begin VB.Label lblStatus 
  110.       AutoSize        =   -1  'True
  111.       BackStyle       =   0  'Transparent
  112.       BeginProperty Font 
  113.          Name            =   "Verdana"
  114.          Size            =   8.25
  115.          Charset         =   0
  116.          Weight          =   400
  117.          Underline       =   0   'False
  118.          Italic          =   0   'False
  119.          Strikethrough   =   0   'False
  120.       EndProperty
  121.       Height          =   195
  122.       Left            =   1560
  123.       TabIndex        =   7
  124.       Top             =   4755
  125.       Width           =   60
  126.    End
  127.    Begin VB.Label lblSend 
  128.       AutoSize        =   -1  'True
  129.       BackStyle       =   0  'Transparent
  130.       Caption         =   "Send"
  131.       BeginProperty Font 
  132.          Name            =   "Verdana"
  133.          Size            =   14.25
  134.          Charset         =   0
  135.          Weight          =   700
  136.          Underline       =   0   'False
  137.          Italic          =   0   'False
  138.          Strikethrough   =   0   'False
  139.       EndProperty
  140.       ForeColor       =   &H00808080&
  141.       Height          =   345
  142.       Left            =   3765
  143.       TabIndex        =   1
  144.       Top             =   5280
  145.       Width           =   810
  146.    End
  147.    Begin VB.Menu mnuActions 
  148.       Caption         =   "&Actions"
  149.       Begin VB.Menu mnuIWant 
  150.          Caption         =   "&I Want To..."
  151.          Begin VB.Menu mnuLeave 
  152.             Caption         =   "&Leave This Conversation"
  153.          End
  154.          Begin VB.Menu mnuInvite 
  155.             Caption         =   "Invite &Someone To This Conversation"
  156.          End
  157.          Begin VB.Menu mnuSend 
  158.             Caption         =   "&Send A File"
  159.          End
  160.          Begin VB.Menu mnuSpace 
  161.             Caption         =   "-"
  162.          End
  163.          Begin VB.Menu mnuCancel 
  164.             Caption         =   "&Cancel This Transfer"
  165.             Enabled         =   0   'False
  166.          End
  167.       End
  168.    End
  169.    Begin VB.Menu mnuOptions 
  170.       Caption         =   "&Options"
  171.       Begin VB.Menu mnuFont 
  172.          Caption         =   "&Font"
  173.          Begin VB.Menu mnuFonts 
  174.             Caption         =   "-"
  175.             Index           =   0
  176.          End
  177.       End
  178.    End
  179. Attribute VB_Name = "frmIM"
  180. Attribute VB_GlobalNameSpace = False
  181. Attribute VB_Creatable = False
  182. Attribute VB_PredeclaredId = True
  183. Attribute VB_Exposed = False
  184. Option Explicit
  185. Private strFont As String
  186. Private strFileName As String
  187. Private Sub Form_Load()
  188.     Dim intfont As Integer
  189.     mnuFonts(0).Caption = Screen.Fonts(0)
  190.     For intfont = 1 To Screen.FontCount - 1
  191.         Load mnuFonts(intfont)
  192.         mnuFonts(0).Caption = Screen.Fonts(intfont)
  193.     Next
  194. End Sub
  195. Private Sub Form_Unload(Cancel As Integer)
  196.     On Error Resume Next
  197.     frmOnline.XMSNC1.MSNLeaveSession CInt(Me.Tag)
  198.     Me.Tag = ""
  199.     Unload Me
  200. End Sub
  201. Private Sub Label1_Click()
  202. End Sub
  203. Private Sub lblSend_Click()
  204.     If strFont = "" Then
  205.         strFont = "Verdana"
  206.     End If
  207.     strFont = Replace(strFont, " ", "%20")
  208.     frmOnline.XMSNC1.MSNMessage CInt(Me.Tag), txtOut.Text, strFont
  209.     rtfIn.SelColor = vbBlack
  210.     rtfIn.SelStart = Len(rtfIn.Text)
  211.     rtfIn.SelFontSize = 10
  212.     rtfIn.SelFontName = "Tahoma"
  213.     rtfIn.SelText = frmOnline.XMSNC1.MSNFriendlyName & " says:" & vbCrLf & "   "
  214.     strFont = Replace(strFont, "%20", " ")
  215.     rtfIn.SelFontName = strFont
  216.     rtfIn.SelStart = Len(rtfIn.Text)
  217.     rtfIn.SelText = txtOut.Text & vbCrLf
  218.     txtOut.Text = ""
  219. End Sub
  220. Private Sub lblSend_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  221.     lblSend.MousePointer = 1
  222. End Sub
  223. Private Sub mnuCancel_Click()
  224.     frmOnline.XMSNC1.MSNCancelFileTransfer (CInt(Me.Tag))
  225.     mnuCancel.Enabled = False
  226. End Sub
  227. Private Sub mnuFonts_Click(Index As Integer)
  228.     strFont = mnuFonts(Index).Caption
  229.     txtOut.Font = strFont
  230. End Sub
  231. Private Sub mnuInvite_Click()
  232.     Dim strContacts As String, arrContacts() As String
  233.     Dim intLoop As Integer, arrSplitContacts() As String
  234.     Dim mNode As Node
  235.     strContacts = frmOnline.XMSNC1.MSNRetrieveContacts
  236.     arrContacts() = Split(strContacts, ";")
  237.         
  238.     For intLoop = 0 To UBound(arrContacts)
  239.         If arrContacts(intLoop) <> "" Then
  240.             arrSplitContacts() = Split(arrContacts(intLoop), ",")
  241.             Set mNode = frmOnline.tvContacts.Nodes(arrSplitContacts(0))
  242.             If InStr(txtInfo.Text, arrSplitContacts(0)) = 0 And mNode.Parent <> "Offline" Then
  243.                 frmInvite.lstInvite.AddItem arrSplitContacts(1)
  244.                 frmInvite.lstInvite1.AddItem arrSplitContacts(0)
  245.             End If
  246.         End If
  247.     Next intLoop
  248.     If frmInvite.lstInvite.ListCount = 0 Then
  249.         MsgBox "Either you are chatting with all of your contacts currently, or" & vbCrLf & "all of your remaining contacts are offline."
  250.         Exit Sub
  251.     End If
  252.     frmInvite.Tag = Me.Tag
  253.     frmInvite.Show vbModal
  254. End Sub
  255. Private Sub mnuLeave_Click()
  256.     Unload Me
  257.     Me.Hide
  258. End Sub
  259. Private Sub mnuSend_Click()
  260.     Dim strResult As String, strPath As String, strName As String, lngSize As Long
  261.     Dim intChar As Integer, lngKbs As Long, lngTime As Long, strTime As String
  262.     On Error GoTo ErrHandler
  263.     strResult = ShowOpen(Me, , , "Select A File To Send")
  264.     If strResult = "" Then
  265.         GoTo ErrHandler
  266.     End If
  267.     lngSize = FileLen(strResult)
  268.     intChar = InStrRev(strResult, "\")
  269.     strPath = Mid(strResult, 1, intChar)
  270.     strName = Mid(strResult, (intChar + 1))
  271.     strName = Replace(strName, Chr(0), "")
  272.     frmOnline.XMSNC1.MSNSendFile CInt(Me.Tag), strPath, strName, lngSize
  273.     lngKbs = (lngSize / 1024)
  274.     lngKbs = (lngKbs * 8)
  275.     lngTime = (lngKbs / 32) * 2
  276.     If lngTime < 60 Then
  277.         strTime = "seconds"
  278.     ElseIf lngTime >= 60 Then
  279.         lngTime = (lngTime \ 60)
  280.         strTime = "minutes"
  281.     End If
  282.     prgXfr.Tag = strName
  283.     prgXfr.Min = 0
  284.     prgXfr.Max = lngSize
  285.     prgXfr.Value = 0
  286.     prgXfr.Visible = True
  287.     lblStatus.Caption = "Sending..."
  288.     rtfIn.SelStart = Len(rtfIn.Text)
  289.     rtfIn.SelColor = vbBlack
  290.     rtfIn.SelBold = True
  291.     rtfIn.SelText = vbCrLf & "Sending: " & strName & vbCrLf & "Approx Transfer Time: " & lngTime & " " & strTime & " @ 28.8 Kbps" & vbCrLf & vbCrLf
  292.     rtfIn.SelColor = vbBlack
  293.     rtfIn.SelBold = False
  294.     strFileName = strName
  295.     mnuCancel.Enabled = True
  296.     Exit Sub
  297. ErrHandler:
  298.     Exit Sub
  299. End Sub
  300. Private Sub tmrIM_Timer()
  301.     If txtInfo.Text = "" Then
  302.         staIM.Panels(1).Text = "Waiting"
  303.     Else
  304.         staIM.Panels(1).Text = "Last Message Received: " & txtTime.Text
  305.     End If
  306. End Sub
  307. Private Sub txtOut_KeyPress(KeyAscii As Integer)
  308.     Static intTyped As Integer
  309.     If KeyAscii = 13 Then
  310.         lblSend_Click
  311.         staIM.Panels(1).Text = "Last Message Received: " & txtTime.Text
  312.         Exit Sub
  313.     End If
  314.     staIM.Panels(1).Text = "Typing a message"
  315.     If intTyped = 0 Then
  316.         intTyped = (intTyped + 1)
  317.         frmOnline.XMSNC1.MSNTyping (Me.Tag)
  318.         Exit Sub
  319.     ElseIf intTyped <> 10 Then
  320.         intTyped = (intTyped + 1)
  321.         Exit Sub
  322.     ElseIf intTyped = 10 Then
  323.         intTyped = 0
  324.         Exit Sub
  325.     End If
  326. End Sub
  327.