FuctionMod.bas

Option Explicit Private A As String, B As String, C As String Private T As String 'INI文件名字 Private Const INI_Name = "VRSW.INI" '对主窗口INITIALIZE读取信息 Public Function Main_Init() Dim x As Long, y As Long Dim XT As String, YT As String T = Space$(1000) '事先定义读取值的字串宽度 x = INI_Read("POSITON", "X") XT = Left$(T, Len(Trim$(T)) - 1) y = INI_Read("POSITON", "Y") YT = Left$(T, Len(Trim$(T)) - 1) If (x = 0 And y = 0) Then '初始化 MainFrm.Move Screen.Width - MainFrm.Width - 500, 500 Call INI_Write("POSITON", "X", Screen.Width - MainFrm.Width - 500) Call INI_Write("POSITON", "Y", 500) Call INI_Write("POSITON", "HEIGHT", 8310) Call INI_Write("POSITON", "WIDTH", 2070) Call INI_Write("SYSTEM", "DATA", Date$) Call INI_Write("SYSTEM", "TIME", Time$) Call INI_Write("INSTALINI", "PATH", App.Path) Call INI_Write("INSTALINI", "SN", App.Major & App.Minor) Call INI_Write("INSTALINI", "NAME", App.EXEName) Exit Function Else If (x And y) = 0 Then '对出错信息记录到文件中 MainFrm.Move Screen.Width - MainFrm.Width - 500, 500 Call INI_Error 'Call INI_Write Exit Function End If End If '初始值 MainFrm.Move XT, YT x = INI_Read("POSITON", "WIDTH") XT = Left$(T, Len(Trim$(T)) - 1) y = INI_Read("POSITON", "HEIGHT") YT = Left$(T, Len(Trim$(T)) - 1) MainFrm.Width = XT MainFrm.Height = YT End Function Public Function INI_Write(A, B, C) '写信息 '修改INI文件中TIP字段中START的值 '如果该文件不存在会自动建立,当函数返回值为0时说明修改不成功 Dim FLAGS As Long FLAGS = WritePrivateProfileString(A, B, C, App.Path & "/" & INI_Name) 'B = WritePrivateProfileString("SECEND", "DATA", Date$, App.Path & "/" & INI_Name) 'C = WritePrivateProfileString("THIRD", "NAME", "", App.Path & "/" & INI_Name) If FLAGS = 0 Then MsgBox ("写文件时出错") End Function Public Function INI_Read(A, B) As Long '读取信息返回GetPrivateProfileString函数的值并通过T返回字段的内容 '读取INI文件中 "TIP" 字段中 "START" 的值 '当函数返回值为0时说明读取数据出错 'A = GetPrivateProfileString("TIP", "START", "", T, 1000, App.Path & "/" & INI_Name) INI_Read = GetPrivateProfileString(A, B, "", T, 1000, App.Path & "/" & INI_Name) End Function Public Function INI_Error() 'Create File To LOG,等待完善！ End Function '变成最上层窗体 Function AlwaysOnTop(Form_hWnd As Long, Flag As Boolean) As Boolean Const SWP_NOMOVE = 2 Const SWP_NOSIZE = 1 Const B_FLAGS = SWP_NOMOVE Or SWP_NOSIZE Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 Dim i As Long If Flag Then i = SetWindowPos(Form_hWnd, HWND_TOPMOST, 0, 0, 0, 0, B_FLAGS) Else i = SetWindowPos(Form_hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, B_FLAGS) End If End Function '自动隐藏窗体函数 Public Sub QQHiden(Myform As Form) 'RECT ,POINTAPI 在module里定义 Dim MyRect As RECT, MyCur As POINTAPI Dim dl As Long On Error Resume Next dl = GetWindowRect(Myform.hWnd, MyRect) dl = GetCursorPos(MyCur) '如果鼠标在窗体上,并且窗体隐藏了,显示出来 If (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Top <= 0 Then Myform.Top = 0 Exit Sub End If '如果鼠标不在窗体上,并且窗体靠近了上方,隐藏窗体 If Not (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Top <= 0 Then Myform.Top = 0 - Myform.Height + 330 / 4 Exit Sub End If '如果窗体靠近左边屏幕,显示或隐藏窗体 If (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Left <= 0 Then Myform.Left = 0 Exit Sub End If If Not (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Left <= 0 Then Myform.Left = 0 - Myform.Width + 330 / 4 Exit Sub End If '如果窗体靠近右边屏幕,显示或隐藏窗体 If (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Left >= Screen.Width - Myform.Width Then Myform.Left = Screen.Width - Myform.Width Exit Sub End If If Not (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Left >= Screen.Width - Myform.Width Then Myform.Left = Screen.Width - 330 / 4 Exit Sub End If End Sub '获得当前鼠标位置的颜色信息 Public Function GetColorFromPoint(ByVal x As Integer, ByVal y As Integer) As Long Dim hWnd As Long Dim hDC As Long Dim rColor As Long Dim rDC As Long hWnd = GetDesktopWindow() hDC = GetWindowDC(hWnd) rColor = GetPixel(hDC, x, y) rDC = ReleaseDC(hWnd, hDC) GetColorFromPoint = rColor End Function