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 + -
显示快捷键?