form3.frm

来自「本程序适合办公室人员使用」· FRM 代码 · 共 315 行

FRM
315
字号
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form3 
   BackColor       =   &H00FF8080&
   BorderStyle     =   0  'None
   Caption         =   "Form3"
   ClientHeight    =   2145
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8175
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2145
   ScaleWidth      =   8175
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Interval        =   600
      Left            =   600
      Top             =   840
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H00FF8080&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   400
      Left            =   4080
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   0
      Width           =   6000
   End
   Begin MSWinsockLib.Winsock udpPeerA 
      Left            =   120
      Top             =   840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.CommandButton Command4 
      BackColor       =   &H00FF80FF&
      Caption         =   "SEND"
      Height          =   400
      Left            =   4080
      MaskColor       =   &H00FF80FF&
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   360
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H00FF80FF&
      Height          =   400
      Left            =   0
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   360
      Width           =   4095
   End
   Begin VB.CommandButton Command3 
      BackColor       =   &H00FF80FF&
      Caption         =   "CHAT"
      Height          =   400
      Left            =   4080
      MaskColor       =   &H00FF80FF&
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   720
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H00FF80FF&
      Caption         =   "关闭"
      Height          =   400
      Left            =   3480
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FF80FF&
      Caption         =   "dongxd的备忘录"
      Height          =   400
      Left            =   0
      MaskColor       =   &H0000FF00&
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   0
      Width           =   3495
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetWindowPos Lib "user32" ( _
  ByVal hwnd As Long, _
  ByVal hWndInsertAfter As Long, _
  ByVal X As Long, ByVal Y As Long, _
  ByVal cx As Long, ByVal cy As Long, _
  ByVal wFlags As Long _
) As Long
  Const HWND_TOPMOST = -1
  Const SWP_SHOWWINDOW = &H40
'文字变色
    Sub Chc(Cont As Control, Color1 As Integer, Color2 As Integer, Color3 As Integer)

    If Val(Cont.Tag) = Color1 Then

    Cont.Tag = Color2

    ElseIf Val(Cont.Tag) = Color2 Then

    Cont.Tag = Color3

    ElseIf Val(Cont.Tag) = Color3 Then

    Cont.Tag = Color1

    Else

    Cont.Tag = Color1

    End If

    Cont.ForeColor = QBColor(Cont.Tag)

    End Sub

Private Sub Command1_Click()
Load Form1
Form1.Show

End Sub

Private Sub Command2_Click()
End

End Sub

Private Sub Command3_Click()
retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 369, 52, SWP_SHOWWINDOW)
End Sub

Private Sub Command4_Click()
udpPeerA.SendData Text1.Text
Command3.Caption = ipdz
retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 369, 26, SWP_SHOWWINDOW)
End Sub

Private Sub Text2_dblclick()
FileNum = FreeFile()
Open App.Path & "\tx.txt" For Output As FileNum
Print #FileNum, Text2.Text
Close FileNum
End Sub



Private Sub Timer1_Timer()
Dim strTmp     As String, strArray()       As String
    
  Open App.Path & "\mz.ini" For Input As #1
  strTmp = StrConv(InputB(LOF(1), #1), vbUnicode)
  Close #1
    
  strArray = Split(strTmp, vbCrLf)
Close #1
Chc Text2, CInt(strArray(4)), CInt(strArray(5)), CInt(strArray(6))
End Sub

Private Sub udpPeerA_DataArrival(ByVal bytesTotal As Long) '取得数据时发生

Dim Tmp As String

udpPeerA.GetData Tmp, vbString '取得数据


Text1.Text = Tmp + Chr$(13) + Chr$(10) + Text1.Text

End Sub

Private Sub Form_Load()

'加载提醒功能
fno = FreeFile
Open App.Path & "\tx.txt" For Input As #fno
Do Until EOF(fno)
Line Input #fno, newline
Text2.Text = newline
Loop
Close #fno

    

'
On Error Resume Next
Dim portno As Integer
portno = 4000
tryagain:
Err.Clear


If Err.Number <> 0 Then
portno = portno + 1
GoTo tryagain
End If
With udpPeerA
    
     .RemotePort = portno '要连接到的端口号
     .LocalPort = portno '该Winsock控制将要使用的本地端口号,便于其它端与该Winsock通讯
     .Bind portno
   ipdz = udpPeerA.LocalIP
    .RemoteHost = ipdz '要连接到的计算机名
     End With


'
Dim strTmp     As String, strArray()       As String
    
  Open App.Path & "\mz.ini" For Input As #1
  strTmp = StrConv(InputB(LOF(1), #1), vbUnicode)
  Close #1
    
  strArray = Split(strTmp, vbCrLf)
Close #1
'
Command1.Caption = strArray(0)
'
If strArray(1) = "粉红" Then
Command1.BackColor = &HFF80FF
Command2.BackColor = &HFF80FF
Text2.BackColor = &HFF80FF
End If
'
If strArray(1) = "绿色" Then
Command1.BackColor = &HFF00&
Command2.BackColor = &HFF00&
Text2.BackColor = &HFF00&
End If
'
If strArray(1) = "紫色" Then
Command1.BackColor = &HC000C0
Command2.BackColor = &HC000C0
Text2.BackColor = &HC000C0
End If
'
If strArray(1) = "粉色" Then
Command1.BackColor = &HC0C0FF
Command2.BackColor = &HC0C0FF
Text2.BackColor = &HC0C0FF
End If

'
If strArray(1) = "白色" Then
Command1.BackColor = &HFFFFFF
Command2.BackColor = &HFFFFFF
Text2.BackColor = &HFFFFFF
End If
'
If strArray(1) = "黄色" Then
Command1.BackColor = &HFFFF&
Command2.BackColor = &HFFFF&
Text2.BackColor = &HFFFF&
End If
'
If strArray(1) = "红色" Then
Command1.BackColor = &HFF&
Command2.BackColor = &HFF&
Text2.BackColor = &HFF&
End If
'
'
If strArray(1) = "深蓝色" Then
Command1.BackColor = &HFF0000
Command2.BackColor = &HFF0000
Text2.BackColor = &HFF0000
End If
'
If strArray(1) = "浅蓝色" Then
Command1.BackColor = &HFFFF00
Command2.BackColor = &HFFFF00
Text2.BackColor = &HFFFF00
End If

'
If strArray(3) = "YES" Then

Text2.Left = 4110
Text2.Width = strArray(2)
Dim retValue As Long
 
    retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 273 + strArray(2) / 15, 26, SWP_SHOWWINDOW)
ElseIf strArray(3) = "NO" Then
retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 273, 26, SWP_SHOWWINDOW)
End If


'

End Sub


⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?