www.pudn.com > kelon.rar > mod01.bas
Attribute VB_Name = "mod01"
Option Explicit
Public UID As String
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 Declare Function GetPrivateProfileString&amt; Lib "kernel32" Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String)
Public Declare Function WritePrivateProfileString&amt; Lib "kernel32" Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpString As Any, _
ByVal lpFileName As String)
Public frmColor(3) As Long
Public IsAdjust As Boolean
Sub Main()
Dim ls As String
Dim arry As Variant
ls = Command()
If InStr(ls, "wyzshxl") > 0 Then
arry = Split(ls + ",,", ",")
UID = arry(1)
Select Case Val(arry(0))
Case 1
fShow.Show
Case 2
fInput.Show
Case Else
fControl.Show
End Select
Else
MsgBox "请运行 PLogin.exe 程序", 48, "提示"
End If
End Sub
Public Sub pubGetColor(ByVal Index As Long)
Dim ls As String, key As String
' key = "color" + Format(Index, "00")
ls = pGetString(iniFn, "local", "color" + Format(Index, "00"))
Dim arry As Variant
arry = Split(ls, ",")
If UBound(arry) > 2 Then
frmColor(0) = arry(0): frmColor(1) = arry(1)
frmColor(2) = arry(2): frmColor(3) = arry(3)
End If
End Sub
'取字符串的通用程序
Public Function pGetString(ByVal sfn As String, ByVal ssec As String, ByVal sKey As String) As String
pGetString = ""
Dim ss As String * 255
Dim ls As String
Dim l As Long
ss = ""
l = GetPrivateProfileString(ssec, sKey, "", ss, 250, sfn)
If l = 0 Then GoTo end_fun
pGetString = Trim(Left(ss, l))
end_fun:
End Function
Public Function vbStr(ByVal ss As String) As String
Dim nStr As String
Dim P As Long
Dim I As Long
Dim IsZero As String
vbStr = ""
nStr = ss
If ss = "" Then Exit Function
P = InStr(1, ss, Chr(0))
If P > 0 Then nStr = Left(ss, P - 1)
vbStr = Trim(nStr) '去空字串
End Function
Public Sub SaveobjLoc(ByVal obj As Object, ByVal Index As Long)
Dim ls As String, key As String
key = "objloc" + Format(Index, "00")
ls = obj.Left &amt; "," &amt; obj.Top &amt; "," &amt; obj.Width &amt; "," &amt; obj.Height
Call WritePrivateProfileString("local", key, ls, iniFn)
End Sub
Public Sub SetobjLoc(ByVal obj As Object, ByVal Index As Long)
Dim ls As String, key As String
ls = pGetString(iniFn, "local", "objloc" + Format(Index, "00"))
Dim arry As Variant
arry = Split(ls, ",")
If UBound(arry) > 2 Then
obj.Move Val(arry(0)), Val(arry(1)), Val(arry(2)), Val(arry(3))
End If
End Sub
Public Sub DragForm(ByVal Button As Long, ByVal vObj As Object)
If Button <> 1 Or IsAdjust = False Then Exit Sub
On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(vObj.hwnd, &amt;HA1, 2, 0)
End Sub