www.pudn.com > DataCollectionSystem.rar > Global.bas, change:2003-06-04,size:6313b


Attribute VB_Name = "Global" 
Option Explicit 
  
Public Const BUTTON_NONE = 0 
Public Const BUTTON_UP = 1 
Public Const BUTTON_DOWN = 2 
 
Public Type POINTAPI 
    X   As Long 
    Y   As Long 
End Type 
 
Public Type RECT 
   Left     As Long 
   Top      As Long 
   Right    As Long 
   Bottom   As Long 
End Type 
 
 
Public Const BACKGROUND_COLOR = &H80000010 
Public Const BDR_RAISEDOUTER = &H1 
Public Const BDR_SUNKENOUTER = &H2 
Public Const BDR_RAISEDINNER = &H4 
Public Const BDR_SUNKENINNER = &H8 
 
Public Const BDR_OUTER = &H3 
Public Const BDR_INNER = &HC 
Public Const BDR_RAISED = &H5 
Public Const BDR_SUNKEN = &HA 
 
Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER) 
Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER) 
Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER) 
Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER) 
 
Public Const BF_LEFT = &H1 
Public Const BF_TOP = &H2 
Public Const BF_RIGHT = &H4 
Public Const BF_BOTTOM = &H8 
Public Const BF_MIDDLE = &H800 
 
Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT) 
Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT) 
Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT) 
Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT) 
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM) 
 
Public Const BF_DIAGONAL = &H10 
Public Const GWL_STYLE = (-16) 
 
' For diagonal lines, the BF_RECT flags specify the end point of 
' the vector bounded by the rectangle parameter. 
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP _ 
             Or BF_RIGHT) 
Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP _ 
             Or BF_LEFT) 
Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM _ 
             Or BF_LEFT) 
Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM _ 
             Or BF_RIGHT) 
 
'Public Const BF_MIDDLE = &H800    ' Fill in the middle. 
Public Const BF_SOFT = &H1000     ' Use for softer buttons. 
Public Const BF_ADJUST = &H2000   ' Calculate the space left over. 
Public Const BF_FLAT = &H4000     ' For flat rather than 3-D borders. 
Public Const BF_MONO = &H8000     ' For monochrome borders. 
 
Public 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 DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean 
Public Declare Function PtInRect Lib "user32" (RECT As RECT, ByVal lPtX As Long, ByVal lPtY As Long) As Integer 
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
 
Public Sub ShowProgressInStatusBar(status As StatusBar, Pic As PictureBox, frm As Form, ByVal bShowProgressBar As Boolean) 
 
    Dim tRC As RECT 
    If bShowProgressBar Then 
' Get the size of the Panel (2) Rectangle from the status bar 
' remember that Indexes in the API are always 0 based (well, 
' nearly always) - therefore Panel(2) = Panel(1) to the api 
' 
    SendMessageAny status.hwnd, SB_GETRECT, 0, tRC 
' 
' and convert it to twips.... 
' 
    With tRC 
        .Top = (.Top * Screen.TwipsPerPixelY) 
        .Left = (.Left * Screen.TwipsPerPixelX) 
        .Bottom = (.Bottom * Screen.TwipsPerPixelY) - .Top 
        .Right = (.Right * Screen.TwipsPerPixelX) - .Left 
    End With 
' 
' Now Reparent the ProgressBar to the statusbar 
' 
    With Pic 
         SetParent .hwnd, status.hwnd 
        .Move tRC.Left, tRC.Top, tRC.Right, tRC.Bottom 
        .Visible = True 
    End With 
         
    Else 
' 
' Reparent the progress bar back to the form and hide it 
' 
    SetParent Pic.hwnd, frm.hwnd 
    Pic.Visible = False 
    End If 
     
End Sub 
 
Public Sub setFlatHeader(lvList As ListView, frm As Form) 
 Dim R As Long 
     Dim Style As Long 
     Dim hHeader As Long 
    'get the handle to the listview header 
     hHeader = SendMessageLong(lvList.hwnd, LVM_GETHEADER, 0, ByVal 0&) 
    'get the current style attributes for the header 
     Style = GetWindowLong(hHeader, GWL_STYLE) 
    'modify the style by toggling the HDS_BUTTONS style 
     Style = Style Xor HDS_BUTTONS     'set the new style and redraw the listview 
     If Style Then 
         R = SetWindowLong(hHeader, GWL_STYLE, Style) 
         R = SetWindowPos(lvList.hwnd, frm.hwnd, 0, 0, 0, 0, SWP_FLAGS) 
     End If 
End Sub 
 
Public Sub selectByClick(lvList As ListView) 
Dim rStyle As Long 
   Dim R As Long 
   'get the current ListView style 
    rStyle = SendMessageLong(lvList.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&) 
     'set the extended style bit 
    rStyle = rStyle Or LVS_EX_ONECLICKACTIVATE 
   'set the new ListView style 
    R = SendMessageLong(lvList.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle) 
End Sub 
 
Public Sub setGridLine(lvList As ListView) 
Dim rStyle As Long 
    Dim R As Long  'get the current ListView style 
    rStyle = SendMessageLong(lvList.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&) 
    rStyle = rStyle Or LVS_EX_GRIDLINES 
    'set the new ListView style 
    R = SendMessageLong(lvList.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle) 
End Sub 
 
Public Sub fullRowSelected(lvList As ListView) 
Dim rStyle As Long 
    Dim R As Long 
    'get the current ListView style 
    rStyle = SendMessageLong(lvList.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&) 
    rStyle = rStyle Or LVS_EX_FULLROWSELECT 
    'set the new ListView style 
    R = SendMessageLong(lvList.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle) 
End Sub 
 
'Use with a picturebox 
'Forecolor of picturebox = the progress color 
' 
' 
Public Function UpdateProgress(pb As Control, ByVal Percent As Integer, Optional ByVal ShowPercent = False) 
    On Error Resume Next 
    Dim Num As String 
    If Not pb.AutoRedraw Then 
    pb.AutoRedraw = -1 
    End If 
pb.Cls 
pb.ScaleWidth = 100 
 
If ShowPercent = True Then 
    Num$ = Format$(Percent, "###0") + "%" 
    pb.CurrentX = 50 - pb.TextWidth(Num$) / 2 
    pb.CurrentY = (pb.ScaleHeight - pb.TextHeight(Num$)) / 2 
    pb.Print Num$ 'print percent 
End If 
 
pb.Line (0, 0)-(Percent, pb.ScaleHeight), , BF 
pb.Refresh 'show differents 
End Function