billset.cls

金算盘软件代码

        If lngOldHeight * (2 * intI) > lngHeight Then Exit For
        If .Row > 0 Then
            If .Row - .TopRow + 1 = intI Or .Row - .TopRow + 1 = intI - 1 Then
                DrawBLine hdc, 0, lngOldHeight * (2 * intI) - Screen.TwipsPerPixelY, _
                    lngWidth, lngOldHeight * (2 * intI) - Screen.TwipsPerPixelY, _
                    CLng(RGB(0, 0, 255))
                    GoTo NextOne
            End If
        End If
        DrawBLine hdc, 0, lngOldHeight * (2 * intI) - Screen.TwipsPerPixelY, _
            lngWidth, lngOldHeight * (2 * intI) - Screen.TwipsPerPixelY, _
            frmColor.lngGridLineColor
NextOne:
        If lngOldHeight * (2 * intI + 1) > lngHeight Then Exit For
    
    Next intI

    '画竖线
    For intI = 1 To 4
        lngLeft = .ColPos(intI) + .ColWidth(intI) - Screen.TwipsPerPixelX
        If lngLeft >= lngWidth Then
        Else
            DrawALine hdc, lngLeft, 0, _
                           lngLeft, lngHeight, _
                            GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, frmColor.lngGridLineColor
            If intI = 4 And mblnLeftRight Then
                DrawALine hdc, .ColPos(intI) + .ColWidth(intI) + Screen.TwipsPerPixelX, 0, .ColPos(intI) + .ColWidth(intI) + Screen.TwipsPerPixelX, .Height, GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, frmColor.lngGridLineColor
            End If
        End If
    Next intI
    
    '对作废图片的刷新操作
    If frmName.chkPrint(1).Value = 0 Then
    Else
        BillPublic.DrawAIcon frmName.hWnd, .Left + (lngWidth - 140 * Screen.TwipsPerPixelX) \ 2, .top + (lngHeight + 3 * lngOldHeight - 70 * Screen.TwipsPerPixelY) \ 2, 1024
'        BillPublic.DrawAIcon .hwnd, lngWidth / 3 + 30, 15, 1024
        Utility.RemoveFormResPicture (1024)
    End If
    ReleaseDC .hWnd, hdc
    End With
    My.blnRefresh = True
End Sub

Private Sub DrawTotalBox()
    Dim intI As Integer
    Dim hdc As Long
    Dim lngTop As Long
    Dim lngLeft As Long
    Dim lngRight As Long
    Dim lngBotton As Long
    Dim lngHeight As Long
    Dim lngWidth As Long
    hdc = GetDC(frmName.hWnd)
    DrawAllButton hdc
    '画阴影
    With frmName.LblBack
        lngLeft = .Left
        lngTop = .top
        lngRight = lngLeft + .width
        lngBotton = lngTop + .Height
    End With
    DrawABox hdc, lngRight, _
                  lngTop + 3 * Screen.TwipsPerPixelY, _
                  lngRight + 2 * Screen.TwipsPerPixelX, _
                  lngBotton + 3 * Screen.TwipsPerPixelY, _
                 RGB(128, 128, 128), True
    DrawABox hdc, lngLeft + 3 * Screen.TwipsPerPixelX, _
                 lngBotton, _
                 lngRight, _
                 lngBotton + 3 * Screen.TwipsPerPixelY, _
                 RGB(128, 128, 128), True
    
    '画标题下的横线
    With frmName.lblCaption
        lngLeft = .Left
        lngTop = .top
        lngRight = lngLeft + .width
        lngBotton = lngTop + .Height
    End With
    DrawALine hdc, lngLeft, lngBotton + 2 * Screen.TwipsPerPixelY, _
        lngRight, lngBotton + 2 * Screen.TwipsPerPixelY, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngCaptionForeColor
         
    '画合计栏上的金额线及合计金额
'    DrawABox hdc, .Left + .ColPos(4) + 1 * Screen.TwipsPerPixelX, .top + .Height + Screen.TwipsPerPixelY, .Left + .Width - 3 * Screen.TwipsPerPixelX, .top + .Height + lngOldHeight - Screen.TwipsPerPixelY, frmColor.lngBackColor, True
'    WriteCashTotalAmount 4
'
'    '画合计栏上的竖线
'    For intI = 3 To 4
'        If .ColPos(intI) + .ColWidth(intI) >= .Width - 15 Or (Not .ColIsVisible(intI)) Then
'        Else
'            DrawBLine hdc, .Left + .ColPos(intI) + .ColWidth(intI), .top + .Height, _
'                            .Left + .ColPos(intI) + .ColWidth(intI), .top + .Height + lngOldHeight, _
'                              frmColor.lngGridLineColor
'        End If
'    Next intI
'    DrawBLine hdc, frmName.lblTotal(0).Left + frmName.lblTotal(0).Width + 1 * Screen.TwipsPerPixelX, frmName.lblTotal(0).top, _
'                    frmName.lblTotal(0).Left + frmName.lblTotal(0).Width + 1 * Screen.TwipsPerPixelX, frmName.lblTotal(0).top + frmName.lblTotal(0).Height, _
'                      frmColor.lngGridLineColor
'
    '画GRID下的表格
    With frmName.GrdCol
        lngLeft = .Left
        lngTop = .top
        lngRight = lngLeft + .width
        lngBotton = lngTop + .Height
    End With
    DrawABoxWithClip hdc, lngLeft - Screen.TwipsPerPixelX, lngTop - 1 * Screen.TwipsPerPixelY, _
        lngRight, lngBotton + 2 * Screen.TwipsPerPixelY, FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor, 4
    DrawABoxWithClip hdc, lngLeft - 3 * Screen.TwipsPerPixelX, lngTop - 3 * Screen.TwipsPerPixelY, _
        lngRight + 2 * Screen.TwipsPerPixelX, lngBotton + 2 * Screen.TwipsPerPixelY, FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor, 4

    '画快捷键的下画线
    If UCase(frmName.Name) = "FRMPAYABLE" Or UCase(frmName.Name) = "FRMINVOICE" Then
        For intI = 0 To 4 Step 2
               DrawALine hdc, frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 2 * lngOneTextWidth, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
                    frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 1 * lngOneTextWidth, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, RGB(0, 0, 0)
        Next intI
    ElseIf UCase(frmName.Name) = "FRMRECEIVE" Or UCase(frmName.Name) = "FRMPAYMENT" Then
        For intI = 0 To 4 Step 2
            If intI <> 2 Then
                DrawALine hdc, frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 2 * lngOneTextWidth, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
                    frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 1 * lngOneTextWidth, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, RGB(0, 0, 0)
            End If
        Next intI
    End If
    Utility.DrawABox hdc, frmName.LblMemo(1).Left - Screen.TwipsPerPixelX, _
                    frmName.LblMemo(1).top - Screen.TwipsPerPixelY, _
                    frmName.LblMemo(1).Left + frmName.LblMemo(1).width + Screen.TwipsPerPixelX, _
                    frmName.LblMemo(1).top + frmName.LblMemo(1).Height - 1 * Screen.TwipsPerPixelY, _
                    frmColor.lngGridBorderColor
    
    If frmName.picInput.Visible And My.bytIndex > 2 Then
        frmName.picInput.Refresh
    End If
    ReleaseDC frmName.hWnd, hdc
End Sub
Private Sub DrawAllButton(ByVal hdc As Long)
    Dim i As Integer
        
    For i = 1 To frmName.lblField.Count - 1
        If frmName.lblField(i).Visible And (Field(i).lngCtrType = tdate Or Field(i).lngCtrType = TRefer) Then
            DrawAButton hdc, frmName.lblField(i).Left + frmName.lblField(i).width - intButtonWidth, _
                            frmName.lblField(i).top, intButtonWidth, frmName.lblField(i).Height, 0, , _
                            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
        End If
    Next i
    For i = 1 To frmName.lblHead.Count - 1
        If (i \ 2) * 2 <> i Then
            If frmName.lblHead(i).Visible Then
                DrawAButton hdc, frmName.lblHead(i).Left + frmName.lblHead(i).width - intButtonWidth - 2 * Screen.TwipsPerPixelX, _
                            frmName.lblHead(i).top + 1 * Screen.TwipsPerPixelY, intButtonWidth, frmName.lblHead(i).Height - 2 * Screen.TwipsPerPixelY, 0, , _
                            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
            End If
        End If
    Next i

End Sub


Private Sub GrdAndLabelInitial()
'列表及LABEL控件初始化
    Dim intI As Integer
    '--------------------------
    '应收/应付、收款/付款单只显示1--4列
    '--------------------------
    frmName.GrdCol.ColWidth(0) = 0
    For intI = 5 To frmName.GrdCol.Cols - 1 - 1
        frmName.GrdCol.ColWidth(intI) = 0
    Next intI
'---------------------------------------------------------------------------
    If Not blnLeftRight Then '上下结构
        frmName.GrdCol.ColWidth(frmName.GrdCol.Cols - 1) = 0
    Else  '左右结构
        intI = frmName.GrdCol.Cols - 1
        frmName.GrdCol.ColWidth(intI) = ColProperty(intI).lngColWidth
        frmName.GrdCol.ColAlignment(intI) = 7
        frmName.GrdCol.FixedAlignment(intI) = 4
    End If
'---------------------------------------------------------------------------
    For intI = 1 To 4
'        If frmName.grdCol.ColWidth(intI) = 0 Then
'            frmName.grdCol.ColWidth(intI) = ColProperty(intI).lngColWidth
'        End If
        
        If ColProperty(intI).blnUsable = False Then
            frmName.GrdCol.ColWidth(intI) = 0
        Else
            frmName.GrdCol.ColWidth(intI) = ColProperty(intI).lngColWidth
        End If
        
        If ColProperty(intI).lngCtrType = tCurrency Then
            frmName.GrdCol.ColAlignment(intI) = 7
        Else
            frmName.GrdCol.ColAlignment(intI) = 1
        End If
        frmName.GrdCol.FixedAlignment(intI) = 4
    Next intI
    
    For intI = 0 To frmName.lblField.UBound
        If Field(intI).lngCtrType = tCurrency Then frmName.lblField(intI).Alignment = 1
        If intI = 0 Then
            frmName.lblField(intI).WordWrap = True
        Else
            frmName.lblField(intI).WordWrap = False
        End If
    Next intI
End Sub

Private Sub RowAdjust(ByVal intRow As Integer)
 '调整一行的LABEL控件宽度（第0号LABEL控件宽度与第第2，3行LABEL控件一起调整）
    Dim lngRowUsableWidth As Long
    Dim lngSumWidth As Long
    Dim lngSumMaxWidth As Long
    Dim lngOneAdded As Long
    Dim intVisibleNO As Integer
    Dim i As Integer
    Dim intFirstIndex As Integer
    Dim intEndIndex As Integer
    intFirstIndex = 0
    '行总可用宽度
    Select Case intRow
        Case 1
            lngPosition(0, 2) = lngPosition(0, 3)
            lngPosition(1, 2) = lngPosition(1, 3)
            lngPosition(2, 2) = lngPosition(2, 3)
            Exit Sub
        Case 2, 3
            lngRowUsableWidth = ((frmName.ScaleWidth - (intCmd0Width + 5 * Screen.TwipsPerPixelX) _
                        - (5 + 3 + 3 + 2 * 5) * Screen.TwipsPerPixelX _
                        - lngPosition(0, 3) - 3 * Screen.TwipsPerPixelX) \ Screen.TwipsPerPixelX) * Screen.TwipsPerPixelX
        Case Else
            lngRowUsableWidth = ((frmName.ScaleWidth - (intCmd0Width + 5 * Screen.TwipsPerPixelX) _
                        - (5 + 3 + 3 + 2 * 5 + 1) * Screen.TwipsPerPixelX) \ Screen.TwipsPerPixelX) * Screen.TwipsPerPixelX
    End Select
    
    For i = 0 To frmName.lblField.UBound
        If Field(i).bytRow = intRow Then
            If intFirstIndex = 0 Then
               intFirstIndex = i    '行初始控件序号
            End If
            If Field(i).blnVisible Then
                intVisibleNO = intVisibleNO + 1    '行可视控件个数
            End If
            intEndIndex = i  '行结束控件序号
        End If
    Next i
         
        '行控件现宽度和
        lngSumWidth = 0
        lngSumMaxWidth = 0
        For i = intFirstIndex To intEndIndex
            If Field(i).blnVisible Then
                lngSumWidth = lngSumWidth + lngPosition(i, 2)
                lngSumMaxWidth = lngSumMaxWidth + lngPosition(i, 3)
            End If
        Next i
        
        lngRowUsableWidth = lngRowUsableWidth - (intVisibleNO - 1) * SPACETWIPS
        
        '可增加宽度和
        lngRowUsableWidth = lngRowUsableWidth - lngSumWidth
        For i = intFirstIndex To intEndIndex
            If lngRowUsableWidth <= 0 Or lngSumMaxWidth = 0 Then
                Exit For
            End If
            If Field(i).blnVisible Then
                lngOneAdded = (CLng(lngRowUsableWidth * lngPosition(i, 3) / lngSumMaxWidth) \ Screen.TwipsPerPixelX) * _
                             Screen.TwipsPerPixelX
                If lngOneAdded < 0 Then
                    '增加后小于最小宽度
                    Exit Sub
                ElseIf lngPosition(i, 2) + lngOneAdded > lngPosition(i, 3) Then
                    '增加后大于最大宽度
                    lngRowUsableWidth = lngRowUsableWidth - (lngPosition(i, 3) - lngPosition(i, 2))
                    lngSumMaxWidth = lngSumMaxWidth - lngPosition(i, 3)
                    lngPosition(i, 2) = lngPosition(i, 3)
                Else
                    lngRowUsableWidth = lngRowUsableWidth - lngOneAdded
                    lngSumMaxWidth = lngSumMaxWidth - lngPosition(i, 3)
                    lngPosition(i, 2) = lngPosition(i, 2) + lngOneAdded
                End If
            End If
        Next i

End Sub
Private Function blnFieldButtonAdjust() As Boolean
   '将FIELDBUTTON的位置LEFT,TOP,WIDTH 存于数组LNGPOSITION之第0,1,2列
   '如第四行不可见返回FALSE,否则返回TRUE
   
    Dim bln4RowIsVisible As Boolean
    Dim i As Integer, j As Integer
    Dim lngTop As Long, lngLeft As Long
    
    For i = 0 To frmName.lblField.UBound
        lngPosition(i, 2) = Field(i).bytMinSize * lngOneTextWidth  '最小宽度
        lngPosition(i, 3) = Field(i).bytFieldSize * lngOneTextWidth '最大宽度
    Next i
    
    For i = 1 To 4
        RowAdjust (i)     '行宽度调整
    Next i
        
    lngPosition(0, 0) = 8 * Screen.TwipsPerPixelX
    lngPosition(0, 1) = frmName.LblBack.top + 3 * Screen.TwipsPerPixelX + intCaptionHeight + intFieldHeight + SpaceTwRow
 '   lngPosition(0, 2) = intField0width
    
    lngPosition(1, 0) = ((frmName.ScaleWidth - (intCmd0Width + 5 * Screen.TwipsPerPixelX) - 5 * Screen.TwipsPerPixelX _
                        - lngPosition(1, 2) - (2 + 7) * Screen.TwipsPerPixelX) \ Screen.TwipsPerPixelX) * Screen.TwipsPerPixelX     'LEFT
    lngPosition(1, 1) = frmName.LblBack.top + 3 * Screen.TwipsPerPixelY          'TOP
    
    For i = 2 To frmName.lblField.Count - 1
        If Field(i).bytRow = Field(i - 1).bytRow Then
            lngPosition(i, 1) = lngPosition(i - 1, 1)        ' TOP
            If Field(i - 1).blnVisible Then
                'LEFT
                lngPosition(i, 0) = lngPosition(i - 1, 0) - lngPosition(i, 2) - SPACETWIPS
            Else
                'LEFT
                lngPosition(