ddframe.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "dframe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim d_num As Integer
Dim d_top As Integer
Dim d_left As Integer
Dim d_width As Integer
Dim d_height As Integer
Dim r_top As Integer
Dim r_left As Integer
Dim r_right As Integer
Dim r_bottom As Integer
Dim d_x As Integer
Dim d_y As Integer
Dim d_lp As String
Dim d_lplen As Integer
Dim grect As RECT
Dim hrect As RECT
Dim lresu As Long
Dim lresul As Long
Dim d_treestyle As Variant
Dim d_linestyle As Variant
Dim d_img As String
Dim d_imagel As String
Dim d_root As String
Dim d_roottext As String
Dim d_imgtag1 As String
Dim d_tag As String
Dim txt As Long
Dim lbrush As Long
Dim lResult As Long
Dim Lfill As Long
Public Property Let danum(num As Integer)
      d_num = num
End Property
Public Property Get danum() As Integer
      danum = d_num
End Property
Public Property Let dtop(dtop1 As Integer)
       d_top = dtop1
End Property
Public Property Get dtop() As Integer
      dtop = d_top
End Property
Public Property Let dleft(dleft As Integer)
       d_left = dleft
End Property
Public Property Get dleft() As Integer
      dleft = d_left
End Property
Public Property Let dwidth(dwidth As Integer)
       d_width = dwidth
End Property
Public Property Get dwidth() As Integer
      dwidth = d_width
End Property
Public Property Let dheight(dheight As Integer)
       d_height = dheight
End Property
Public Property Get dheight() As Integer
      dheight = d_height
End Property
'''''''''''''''''''''
Public Property Let rtop(dtop As Integer)
       r_top = dtop
End Property
Public Property Get rtop() As Integer
      rtop = r_top
End Property
Public Property Let rleft(dleft As Integer)
       r_left = dleft
End Property
Public Property Get rleft() As Integer
      rleft = r_left
End Property
Public Property Let rright(dright As Integer)
       r_right = dright
End Property
Public Property Get rright() As Integer
      rright = r_right
End Property
Public Property Let rbottom(dbottom As Integer)
       r_bottom = dbottom
End Property
Public Property Get rbottom() As Integer
      rbottom = r_bottom
End Property
Public Property Let X(dx As Integer)
      d_x = dx
End Property
Public Property Get X() As Integer
      X = d_x
End Property
Public Property Let Y(dy As Integer)
      d_y = dy
End Property
Public Property Get Y() As Integer
      Y = d_y
End Property
Public Property Let lpString(lp As String)
      d_lp = lp
End Property
Public Property Get lpString() As String
      lpString = d_lp
End Property
Public Property Let lp_len(lplen As Integer)
      d_lplen = lplen
End Property
Public Property Get lp_len() As Integer
      lp_len = d_lplen
End Property
Public Property Let treestyle(dtreestyle As Variant)
       d_treestyle = dtreestyle
End Property
Public Property Get treestyle() As Variant
       treestyle = d_treestyle
End Property
Public Property Let linestyle(dlinestyle As Variant)
       d_linestyle = dlinestyle
End Property
Public Property Get linestyle() As Variant
       linestyle = d_linestyle
End Property
Public Property Let imgtag(dimg As String)

       d_img = dimg
End Property
Public Property Get imgtag() As String

       imgtag = d_img
End Property
Public Property Let imagel(dimagel As String)
       d_imagel = dimagel
End Property
Public Property Get imagel() As String
       imagel = d_imagel
End Property
Public Property Let root(droot As String)
       d_root = droot
End Property
Public Property Get root() As String
       root = d_root
End Property
Public Property Let roottext(droottext As String)
       d_roottext = droottext
End Property
Public Property Get roottext() As String
       roottext = d_roottext
End Property
Public Property Let imgtag1(dimgtag1 As String)
       d_imgtag1 = dimgtag1
End Property
Public Property Get imgtag1() As String
       imgtag1 = d_imgtag1
End Property
Public Property Let tag(dtag As String)
       d_tag = dtag
End Property
Public Property Get tag() As String
       tag = d_tag
End Property
Public Property Let red(dred As Integer)
       d_red = dred
End Property
Public Property Get red() As Integer
       red = d_red
End Property
Public Property Let blue(dblue As Integer)
       d_blue = dblue
End Property
Public Property Get blue() As Integer
       blue = d_blue
End Property
Public Property Let green(dgreen As Integer)
       d_green = dgreen
End Property
Public Property Get green() As Integer
       green = d_green
End Property
Public Property Let pwidth(pwidth As Integer)
       p_width = pwidth
End Property
Public Property Get pwidth() As Integer
       pwidth = p_width
End Property
Public Property Let pfirst(pfirst As Single)
       p_first = pfirst
End Property
Public Property Get pfirst() As Single
       pfirst = p_first
End Property
Public Property Let plast(dlast As Integer)
       d_last = dlast
End Property
Public Property Get plast() As Integer
       plast = d_last
End Property
Public Property Let pright(pright As Integer)
       p_right = pright
End Property
Public Property Get pright() As Integer
       pright = p_pright
End Property
Public Property Let pbottom(penbottom As Integer)
       pen_bottom = penbottom
End Property
Public Property Get pbottom() As Integer
       pbottom = pen_bottom
End Property
Public Property Let pchange(ppchange As Integer)
       p_change = ppchange
End Property
Public Property Get pchange() As Integer
       pchange = p_change
End Property

''''''''''''''''''''
Public Sub ddraw(frm1 As Form)
   If danum = 1 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawFrameControl(frm1.hdc, grect, DFC_SCROLL, DFCS_SCROLLDOWN Or DFCS_SCROLLUP)
   End If
   If danum = 2 Then
      hrect.Top = rtop
      hrect.Left = rleft
      hrect.Right = rright
      hrect.Bottom = rbottom
      lresul = DrawEdge(frm1.hdc, hrect, BDR_INNER Or BDR_SUNKEN, BF_RECT)
   End If
   If danum = 3 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, EDGE_ETCHED, BF_RECT)
      'lresu = DrawEdge(frmJHD.hdc, grect, EDGE_ETCHED, BF_FLAT)
   End If
   If danum = 4 Then
      ''''''''''''
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, BDR_SUNKEN, BF_RECT)
   End If
   If danum = 5 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, BDR_RAISEDINNER, BF_RECT)
   End If
End Sub
Public Sub cencerfrm(frm As Form)
     frm.Top = dtop
     frm.Left = dleft
     frm.width = dwidth
     frm.height = dheight
End Sub
Public Sub showtext(frm As Form)
     txt = TextOut(frm.hdc, X, Y, lpString, lp_len)
End Sub
Public Sub showtext1(pic As PictureBox)
     txt = TextOut(pic.hdc, X, Y, lpString, lp_len)
End Sub
Public Sub drawborder(frm As Form)
    Dim pen As Integer
    Dim oldpen As Integer
    Dim throw As Integer
    Dim i As Long
    'blue = pblue
    'blue = 50
    For i = pfirst To plast
    'For i = 0.05 To 9
       pen = CreatePen(PS_INSIDEFRAME, pwidth, RGB(red, blue, green))
       oldpen = SelectObject(frm.hdc, pen)
       throw = Rectangle(frm.hdc, i - 1, i - 1, pright - i, pbottom - i)
       throw = SelectObject(frm.hdc, oldpen)
       throw = DeleteObject(pen)
       blue = blue + pchange
    Next i
End Sub
Public Sub ddrawc(frm1 As Control)
   If danum = 1 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawFrameControl(frm1.hdc, grect, DFC_SCROLL, DFCS_SCROLLDOWN Or DFCS_SCROLLUP)
   End If
   If danum = 2 Then
      hrect.Top = rtop
      hrect.Left = rleft
      hrect.Right = rright
      hrect.Bottom = rbottom
      lresul = DrawEdge(frm1.hdc, hrect, BDR_INNER Or BDR_SUNKEN, BF_RECT)
   End If
   If danum = 3 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, EDGE_ETCHED, BF_RECT)
   End If
   If danum = 4 Then
      ''''''''''''
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, BDR_SUNKEN, BF_RECT)
   End If
   If danum = 5 Then
      grect.Top = rtop
      grect.Left = rleft
      grect.Right = rright
      grect.Bottom = rbottom
      lresu = DrawEdge(frm1.hdc, grect, BDR_RAISEDINNER, BF_RECT)
   End If
   If danum = 6 Then
      grect.Top = rtop + 3
      grect.Left = rleft
      grect.Right = rright - 3
      grect.Bottom = rbottom - 3
'      lbrush = CreatePen(PS_SOLID, 1, RGB(128, 128, 128))
'      oldpen = SelectObject(frm1.hdc, lbrush)
'      lresu = RoundRect(frm1.hdc, rtop - 1, rleft - 1, rright + 1, rbottom + 1, 3, 3)
'      lresu = DeleteObject(oldpen)
      ''''''''''最外边框
      lbrush = CreatePen(PS_SOLID, 1, RGB(255, 94, 32))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop, rleft, rright, rbottom, 5, 5)
      'Lfill = FillRect(frm1.hdc, grect, lbrush)
      lresu = DeleteObject(oldpen)
      ''''''里边一层
      lbrush = CreatePen(PS_SOLID, 1, RGB(255, 199, 142))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop + 1, rleft + 1, rright - 1, rbottom - 1, 1, 1)
      lresu = DeleteObject(oldpen)
      ''''''最里边一层'
      lbrush = CreatePen(PS_SOLID, 1, RGB(255, 229, 152))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop + 2, rleft + 2, rright - 2, rbottom - 2, 1, 1)
      lresu = DeleteObject(oldpen)
      
   End If
   If danum = 7 Then
      grect.Top = rtop + 3
      grect.Left = rleft
      grect.Right = rright - 3
      grect.Bottom = rbottom - 3
'      lbrush = CreatePen(PS_SOLID, 1, RGB(128, 128, 128))
'      oldpen = SelectObject(frm1.hdc, lbrush)
'      lresu = RoundRect(frm1.hdc, rtop - 1, rleft - 1, rright + 1, rbottom + 1, 3, 3)
'      lresu = DeleteObject(oldpen)
      ''''''''''最外边框
      lbrush = CreatePen(PS_SOLID, 1, RGB(26, 26, 255))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop, rleft, rright, rbottom, 5, 5)
      'Lfill = FillRect(frm1.hdc, grect, lbrush)
      lresu = DeleteObject(oldpen)
      ''''''里边一层
      lbrush = CreatePen(PS_SOLID, 1, RGB(155, 155, 255))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop + 1, rleft + 1, rright - 1, rbottom - 1, 1, 1)
      lresu = DeleteObject(oldpen)
      ''''''最里边一层'
      lbrush = CreatePen(PS_SOLID, 1, RGB(180, 180, 255))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop + 2, rleft + 2, rright - 2, rbottom - 2, 1, 1)
      lresu = DeleteObject(oldpen)
      
   End If
   If danum = 8 Then
      grect.Top = rtop + 3
      grect.Left = rleft
      grect.Right = rright - 3
      grect.Bottom = rbottom - 3

      ''''''''''最外边框
      lbrush = CreatePen(PS_SOLID, 1, RGB(128, 128, 128))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop, rleft, rright, rbottom, 5, 5)
      'Lfill = FillRect(frm1.hdc, grect, lbrush)
      lresu = DeleteObject(oldpen)
      ''''''''''最外边框
      lbrush = CreatePen(PS_SOLID, 1, RGB(255, 255, 255))
      oldpen = SelectObject(frm1.hdc, lbrush)
      lresu = RoundRect(frm1.hdc, rtop + 1, rleft + 1, rright - 1, rbottom - 1, 1, 1)
      'Lfill = FillRect(frm1.hdc, grect, lbrush)
      lresu = DeleteObject(oldpen)
      
      
   End If
End Sub