tsgl.bas

这是用Visual Basic6开发的大型喷绘业务管理系统,数据库采用Access数据库

Attribute VB_Name = "TSGL"
 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
 Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'Public Const PS_SOLID = 0
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Public Const DFC_BUTTON& = 4
Public Const DFC_CAPTION& = 1
Public Const DFC_MENU& = 2
Public Const DFC_SCROLL = 3
Public Const DFCS_ADJUSTRECT = &H2000
Public Const DFCS_BUTTON3STATE& = &H8
Public Const DFCS_BUTTONCHECK& = &H0
Public Const DFCS_BUTTONPUSH = &H10
Public Const NEWTRANSPARENT = 3
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Const BDR_INNER = &HC
Public Const BDR_OUTER = &H3
Public Const BDR_RAISED = &H5
Public Const BDR_RAISEDINNER = &H4
Public Const BDR_RAISEDOUTER = &H1
Public Const BDR_SUNKEN = &HA
Public Const LB_SETHORIZONTALEXTENT = &H194
Public Const PS_SOLID = 0
'Public Const NEWTRANSPARENT = 3
Public Const BDR_SUNKENINNER = &H8
Public Const BDR_SUNKENOUTER = &H2
Public Const BF_ADJUST = &H2000   ' Calculate the space left over.
Public Const BF_BOTTOM = &H8
Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)

Public Const BF_DIAGONAL = &H10

Public Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
Public Const BF_LEFT = &H1
Public Const BF_MIDDLE = &H800    ' Fill in the middle.
Public Const BF_MONO = &H8000     ' For monochrome borders.
Public Const BF_RIGHT = &H4

Public Const BF_SOFT = &H1000     ' Use for softer buttons.
Public Const BF_TOP = &H2
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_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_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Public Const BI_bitfields = 3&
Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Public GS_CZY As String
Public Const MessStr = "该程序已经执行了非法操作,请速与该供应商取得联系！！"
Public Const MessStr1 = "该程序已经执行了非法操作,可能是文件丢失。请速与该供应商取得联系！！"
Public Flagbrow As Long
Public NodeText As String
''''''''''
Public CustomInFlag As Integer
Public CUSTOMSelectText(9) As String
'''''''''''''
Public BOOKFLAG As String
Public SEARCHFLAG As Long
'Public tWND As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_SHOWWINDOW = &H40
'Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
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
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public tWND As Long, bWnd As Long, sSave As String * 250
Public hBrush As Long, hdc5 As Long
     Public dx As Long, dy As Long
     Public rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
     Public i As Long, j As Long, bcolor As Long
     Public ind As Integer
     Public DispCnt As Long
     '''''''定义LISTVIEW1的对象变量'''''
     Public clm As ColumnHeader
     Public itm As ListItem
     '''''''定义TREEVIEW的对象变量'''
     Public Tree As Node
     Public Treesub As Node
     Public TreeSub1 As Node
     Public GoodsTree As String
     Public FormFlag 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 Const CB_FINDSTRING = &H14C
     Public listviewtext(9) As String
     Public Flagh As Integer
     ''''''喷绘业务变量
     Public YWFlagh As Integer
     Public YWDeleFlag As Integer
     Public YWsearchTrue(20) As String
     Public rgn1, rgn2 As Long
     Public YWPRtableText(15) As String
     Public YWSEtableText1(20) As String
     Public YWSEtableText2(20) As String
     Public YWSErows As Integer
     '''''''机台业务变量''''''
     Public JTflagh As Integer
     Public JTPRtableText(15) As String
     Public JTSEtableText1(20) As String
     Public JTSEtableText2(20) As String
     Public JTSEtableText3(20) As String
     Public JTSEtableText4(20) As String
     Public JTSErows As Integer
     ''''''仓库布料变量'''
     Public ClothFlagh As Integer
     Public CLOTHtableText(10) As String
     Type Dat '自定义类型
    '为了和坐标配合，把变量设置为整数型
         sx As Integer '存扫描头次遇到非背景色的X坐标
         ex As Integer '存扫描非背景色结束的X坐标
         sy As Integer 'Y坐标的开始
         ey As Integer 'Y坐标的结束
     End Type
     '''''''''存储序列号变量'''''''
     Public SaveSerial As String
     Public SaveKeyCode As String
     Public SaveRunTimes As Integer
     '''''''''''''''''''
     ''''''''''注册表常量设置'''''''
        Public Const HKEYNAME = HKEY_LOCAL_MACHINE
        Public Const AppName = "SYPHManagerSoft"
        Public Const SectionName = "Config"
        Public Const KeyName = "login"
        Public Const AppName1 = "SYMicroSoft"
        Public Const SectionName1 = "Setting"
        Public Const KeyName1 = "user"
        Public Const AppName2 = "SYsetting"
        Public Const SectionName2 = "Counter"
        Public Const KeyName2 = "CountTime"
     Public mX As Integer
     Public mY As Integer
     '''''''生成不规则窗体'''''''''
Public Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Public Declare Function FillPath Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
     
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Sub DRAWbox(pic As PictureBox)
      Dim oldcursor&
    Dim i As Integer
    Dim pri As Integer
    Dim blue As Integer
    Dim pen As Long
    Dim oldpen As Long
    Dim throw As Long
    Dim ddd(10) As String
    For i = 0.05 To 4
        pen = CreatePen(PS_SOLID, i, RGB(0, 0, 255))
        oldpen = SelectObject(pic.hdc, pen)
        throw = Rectangle(pic.hdc, 1, 1, 152, 27)
        throw = SelectObject(pic.hdc, oldpen)
        throw = DeleteObject(pen)
    Next i
End Sub
 
  Public Sub showform(win As Form, ind)
     DispCnt = 60 '画几个矩形后显示窗体
     '`下面这段代码用来获得窗体颜色,不用me.backcolor的原因是窗体颜色不一定是系统调色板的颜色,如果用me.backcolor的话颜色可能会不准。
     hdc5 = GetDC(0)
     bcolor = GetBkColor(win.hdc)
     hBrush = CreateSolidBrush(bcolor) '`设定刷子颜色
     Call SelectObject(hdc5, hBrush)
     dx = win.width \ (DispCnt)
     dy = win.height \ (DispCnt)
     j = 1
     Select Case ind
     Case 1
            dx = dx \ 2:  dy = dy \ 2
            For i = DispCnt To 1 Step -1
                rx1 = (win.Left + dx * (i - 1)) \ Screen.TwipsPerPixelX
                ry1 = (win.Top + dy * (i - 1)) \ Screen.TwipsPerPixelY
                rx2 = rx1 + dx * 2 * j \ Screen.TwipsPerPixelX
                ry2 = rx1 + dy * 2 * j \ Screen.TwipsPerPixelY
                j = j + 1
                'Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
                Sleep (1)
            Next i
    Case 2
            For i = DispCnt To 1 Step -1
                rx1 = (win.Left + win.width - dx * j) \ Screen.TwipsPerPixelX
                ry1 = win.Top \ Screen.TwipsPerPixelY
                rx2 = (win.Left + win.width) \ Screen.TwipsPerPixelX
                ry2 = (win.Top + dy * j) \ Screen.TwipsPerPixelY
                j = j + 1
                Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
                Sleep (1)
            Next i
     Case 3
            For i = DispCnt To 1 Step -1
                rx1 = win.Left \ Screen.TwipsPerPixelX
                ry1 = win.Top \ Screen.TwipsPerPixelY
                rx2 = rx1 + dx * j \ Screen.TwipsPerPixelX
                ry2 = rx1 + dy * j \ Screen.TwipsPerPixelY
                j = j + 1
                Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
                Sleep (1)
            Next i
     Case 4
            For i = DispCnt To 1 Step -1
            rx1 = (win.Left + dx * (i - 1)) \ Screen.TwipsPerPixelX
            ry1 = (win.Top + dy * (i - 1)) \ Screen.TwipsPerPixelY
            rx2 = (win.Left + win.width) \ Screen.TwipsPerPixelX
            ry2 = (win.Top + win.height) \ Screen.TwipsPerPixelY
            j = j + 1
            Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
            Sleep (1): Next i
     Case 5
            For i = DispCnt To 1 Step -1
                rx1 = (win.Left) \ Screen.TwipsPerPixelX
                ry1 = (win.Top + win.height - dy * j) \ Screen.TwipsPerPixelY
                rx2 = (win.Left + dx * j) \ Screen.TwipsPerPixelX
                ry2 = (win.Top + win.height) \ Screen.TwipsPerPixelY
                j = j + 1
                Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
                Sleep (1)
            Next i
     End Select
    Call ReleaseDC(0, hdc5) '`释放设备描述表
    Call DeleteObject(hBrush) '`删除刷子
  End Sub