itemadjust.cls

金算盘软件代码

End Sub
Public Sub DrawReadOnlyCol()
    Dim intLeft As Integer
    Dim i As Integer
    Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
    Dim hdc As Long
    With frmName.GrdCol
        If .RowIsVisible(.Rows - 1) = False Then Exit Sub
        hdc = GetDC(.hWnd)
        intLeft = .LeftCol
        If intLeft = 0 Then intLeft = 1
        For i = intLeft To .Cols - 1
            If .ColWidth(i) <> 0 And ColProperty(i).blnReadOnly And .ColIsVisible(i) Then
                If .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) < .Height Then
                    x1 = .ColPos(i)
                    y1 = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1)
                    x2 = .ColPos(i) + .ColWidth(i) - Screen.TwipsPerPixelX
                    y2 = .Height
                    DrawABox hdc, x1, y1, x2, y2, _
                    RGB(192, 192, 192), RGB(192, 192, 192)
                End If
            End If
        Next i
        ReleaseDC .hWnd, hdc
    End With
End Sub

Private Sub DrawTotalBox()
    Dim intI As Integer
    Dim lngColor As Long
    Dim hdc As Long
    hdc = GetDC(frmName.hWnd)
    DrawAllButton hdc
    '画阴影
    DrawABox hdc, frmName.LblBack.Left + frmName.LblBack.width, _
        frmName.LblBack.top + 3 * Screen.TwipsPerPixelY, _
        frmName.LblBack.Left + frmName.LblBack.width + 2 * Screen.TwipsPerPixelX, _
        frmName.LblBack.top + frmName.LblBack.Height + 3 * Screen.TwipsPerPixelY, _
        RGB(128, 128, 128), True
    DrawABox hdc, frmName.LblBack.Left + 3 * Screen.TwipsPerPixelX, _
        frmName.LblBack.top + frmName.LblBack.Height + 0 * Screen.TwipsPerPixelY, _
        frmName.LblBack.Left + frmName.LblBack.width + 0 * Screen.TwipsPerPixelX, _
        frmName.LblBack.top + frmName.LblBack.Height + 3 * Screen.TwipsPerPixelY, _
        RGB(128, 128, 128), True
    
    '画标题下的横线
    DrawALine hdc, frmName.lblCaption.Left, frmName.lblCaption.top + frmName.lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        frmName.lblCaption.Left + frmName.lblCaption.width, frmName.lblCaption.top + frmName.lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngCaptionForeColor
    '画合计栏上的竖线
    For intI = 1 To frmName.GrdCol.Cols - 1
        If frmName.GrdCol.ColPos(intI) + frmName.GrdCol.ColWidth(intI) >= frmName.GrdCol.width - Screen.TwipsPerPixelX Or _
            (Not frmName.GrdCol.ColIsVisible(intI)) Then
        Else
            DrawALine hdc, frmName.GrdCol.Left + frmName.GrdCol.ColPos(intI) + frmName.GrdCol.ColWidth(intI) - Screen.TwipsPerPixelX, frmName.GrdCol.top + frmName.GrdCol.Height, _
                frmName.GrdCol.Left + frmName.GrdCol.ColPos(intI) + frmName.GrdCol.ColWidth(intI) - Screen.TwipsPerPixelX, frmName.GrdCol.top + frmName.GrdCol.Height + frmName.GrdCol.RowHeight(0), _
                FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor
        End If
    Next intI
    '画GRID下的表格
    DrawABox hdc, frmName.GrdCol.Left - 3 * Screen.TwipsPerPixelX _
        , frmName.GrdCol.top - 3 * Screen.TwipsPerPixelY _
        , frmName.GrdCol.Left + frmName.GrdCol.width + 2 * Screen.TwipsPerPixelX _
        , frmName.lblmemo(0).top - 5 * Screen.TwipsPerPixelY, frmColor.lngGridLineColor
    DrawABox hdc, frmName.GrdCol.Left - Screen.TwipsPerPixelX _
        , frmName.GrdCol.top - 1 * Screen.TwipsPerPixelY _
        , frmName.GrdCol.Left + frmName.GrdCol.width - 0 * Screen.TwipsPerPixelX _
        , frmName.lblmemo(0).top - 7 * Screen.TwipsPerPixelY, frmColor.lngGridLineColor
    DrawALine hdc, frmName.GrdCol.Left, frmName.GrdCol.top + frmName.GrdCol.Height + 0, _
        frmName.GrdCol.Left + frmName.GrdCol.width, frmName.GrdCol.top + frmName.GrdCol.Height + 0, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor
    DrawALine hdc, frmName.GrdCol.Left, frmName.GrdCol.top + frmName.GrdCol.Height + frmName.GrdCol.RowHeight(0) + 0, _
        frmName.GrdCol.Left + frmName.GrdCol.width, frmName.GrdCol.top + frmName.GrdCol.Height + frmName.GrdCol.RowHeight(0) + 0, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor
    DrawALine hdc, frmName.lblNote(0).Left + frmName.lblNote(0).width + 30, frmName.GrdCol.top + frmName.GrdCol.Height + frmName.GrdCol.RowHeight(0), _
                frmName.lblNote(0).Left + frmName.lblNote(0).width + 30, frmName.lblmemo(0).top - 7 * Screen.TwipsPerPixelY, _
                FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngGridLineColor
    '画备注框
        lngColor = frmColor.lngGridBorderColor
        With frmName
        DrawABox hdc, .lblmemo(1).Left - Screen.TwipsPerPixelX, _
                           .lblmemo(1).top - Screen.TwipsPerPixelY, _
                           .lblmemo(1).Left + .lblmemo(1).width + 1 * Screen.TwipsPerPixelX, _
                           .lblmemo(1).top + .lblmemo(1).Height - 1 * Screen.TwipsPerPixelY, _
                           lngColor
        End With
    '画制单人方框
    With frmName.lblmemo(frmName.lblmemo.Count - 1)
        DrawABox hdc, .Left - Screen.TwipsPerPixelX, .top - 2 * Screen.TwipsPerPixelY, .Left + .FontSize * 10.05 * StrLen(Trim(.Caption)), .top + .Height - Screen.TwipsPerPixelY, RGB(255, 0, 0), False
    End With
    '画快捷键的下画线
        intI = 4
      DrawALine hdc, frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 2 * frmName.FontSize * 10, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
            frmName.lblHead(intI).Left + frmName.lblHead(intI).width - 1 * frmName.FontSize * 10, frmName.lblHead(intI).top + frmName.lblHead(intI).Height + 0, _
            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, RGB(0, 0, 0)
    intI = 0
    DrawALine hdc, frmName.lblmemo(intI).Left + frmName.lblmemo(intI).width - 2 * frmName.FontSize * 10, frmName.lblmemo(intI).top + frmName.lblmemo(intI).Height + 0, _
        frmName.lblmemo(intI).Left + frmName.lblmemo(intI).width - 1 * frmName.FontSize * 10, frmName.lblmemo(intI).top + frmName.lblmemo(intI).Height + 0, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, frmColor.lngFooterForeColor 'RGB(0, 0, 0)
    ReleaseDC frmName.hWnd, hdc
End Sub
Private Sub DrawAllButton(ByVal hdc As Long)
    Dim i As Integer
    Dim lngBackColor As Long
    lngBackColor = GetSysColor(COLOR_BTNFACE)
    
    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, lngBackColor, _
                            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, lngBackColor, _
                            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
            End If
        End If
    Next i
End Sub


Private Sub GrdAndLabelInitial()
'列表及LABEL控件初始化    Dim inti As Integer
    Dim i%
    Dim intI As Integer
    With frmName.GrdCol
        .ColWidth(0) = 0
        For intI = 1 To .Cols - 1
            If ColProperty(intI).blnUsable Then
                .ColWidth(intI) = ColProperty(intI).lngColWidth
            Else
                .ColWidth(intI) = 0
            End If
            If ColProperty(intI).lngCtrType = tCurrency Then
                .ColAlignment(intI) = 7
                If frmName.lblTotal.Count > intI Then
                    frmName.lblTotal(intI).Alignment = 1
                End If
            Else
                .ColAlignment(intI) = 1
            End If
        Next intI
        If .Rows > .FixedRows Then
            For intI = .FixedRows To .Rows - 1
                .Row = intI
                For i% = 1 To .Cols - 1
                    .col = i%
                    If .ColWidth(i%) > 0 Then
                        If ColProperty(i%).blnReadOnly Then
                            .CellBackColor = RGB(192, 192, 192)
                        Else
                            .CellBackColor = frmColor.lngBackColor                      'RGB(255, 255, 255)
                        End If
                    End If
                Next i%
            Next intI
        End If
    End With
    
    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 Function lngGrdTop(ByVal bln4RowVisible As Boolean) As Long
    Dim lngTop As Long
    Dim i As Integer
    Dim j As Integer
    j = 1
    If bln4RowVisible Then
        lngTop = frmName.lblField(frmName.lblField.Count - 1).top + frmName.lblField(frmName.lblField.Count - 1).Height + SpaceTwRow * 2
        GoTo EndProc
    End If
    If Field(0).blnVisible Then
        lngTop = frmName.lblFieldCaption(frmName.lblField.Count - 1).top + SpaceTwRow
        GoTo EndProc
    End If
    For i = frmName.lblField.Count - 1 To 1 Step -1
        If Field(i).blnVisible Then
            j = i
            Exit For
        End If
    Next i
    lngTop = frmName.lblField(j).top + frmName.lblField(j).Height + SpaceTwRow * 2
    
EndProc:
    lngGrdTop = lngTop
End Function
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 * frmName.FontSize * 10) \ Screen.TwipsPerPixelX) * Screen.TwipsPerPixelX  '最小宽度
        lngPosition(i, 3) = ((Field(i).bytFieldSize * frmName.FontSize * 10) \ Screen.TwipsPerPixelX) * Screen.TwipsPerPixelX '最大宽度
    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