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& 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& 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 & "," & obj.Top & "," & obj.Width & "," & 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, &HA1, 2, 0) 
End Sub