clsstartperiod.cls

金算盘软件代码

Public Property Get lngNowID() As Long
     lngNowID = My.lngNowID
End Property
'当前输入区域属性
Public Property Let bytRegion(ByVal vData As Byte)
   Let My.bytRegion = vData
End Property
Public Property Get bytRegion() As Byte
     bytRegion = My.bytRegion
End Property
'当前输入区域序号属性
Public Property Let bytIndex(ByVal vData As Byte)
   Let My.bytIndex = vData
End Property
Public Property Get bytIndex() As Byte
     bytIndex = My.bytIndex
End Property

'数据是否改变属性
Public Property Let blnIsChanged(ByVal vData As Boolean)
   Let My.blnIsChanged = vData
End Property
Public Property Get blnIsChanged() As Boolean
     blnIsChanged = My.blnIsChanged
End Property
'窗体是否刷新属性
Public Property Let blnRefresh(ByVal vData As Boolean)
   Let My.blnRefresh = vData
End Property
Public Property Get blnRefresh() As Boolean
    blnRefresh = My.blnRefresh
End Property
'是否可行粘贴属性
Public Property Let blnPasteRec(ByVal vData As Boolean)
   Let My.blnPasteRec = vData
End Property
Public Property Get blnPasteRec() As Boolean
    blnPasteRec = My.blnPasteRec
End Property
'是否可删除属性
Public Property Let blnMayDelete(ByVal vData As Boolean)
   Let My.blnMayDelete = vData
End Property
Public Property Get blnMayDelete() As Boolean
    blnMayDelete = My.blnMayDelete
End Property
'是否触发CHANGE事件属性
Public Property Let blnChangeEvent(ByVal vData As Boolean)
   Let My.blnChangeEvent = vData
End Property
Public Property Get blnChangeEvent() As Boolean
    blnChangeEvent = My.blnChangeEvent
End Property
    
'会计年度属性
Public Property Let intAccountYear(ByVal vData As Integer)
   Let My.intAccountYear = vData
End Property
Public Property Get intAccountYear() As Integer
    intAccountYear = My.intAccountYear
End Property
'会计期间属性
Public Property Let bytAccountPeriod(ByVal vData As Byte)
   Let My.bytAccountPeriod = vData
End Property
Public Property Get bytAccountPeriod() As Byte
'    bytAccountPeriod = My.bytAccountPeriod
    bytAccountPeriod = 0
End Property
'GRD原列号属性
Public Property Let lngOldCol(ByVal vData As Long)
   Let My.lngOldCol = vData
End Property
Public Property Get lngOldCol() As Long
    lngOldCol = My.lngOldCol
End Property
'GRD原行号属性
Public Property Let lngOldRow(ByVal vData As Long)
   Let My.lngOldRow = vData
End Property
Public Property Get lngOldRow() As Long
    lngOldRow = My.lngOldRow
End Property
    
Public Property Get grdBorderWidth() As Integer
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.grdBorderWidth
    grdBorderWidth = intGrdBorderWidth
End Property
Public Property Set Form(ByVal vData As Form)
'当把对象赋值给属性时在 Set 语句左边使用。
'Syntax: Set x.GridName = Form1
    IntSpace = Screen.TwipsPerPixelX   '粘贴控件之间距
    SPACETWIPS = 2 * Screen.TwipsPerPixelX '单据头控件之列距
    SpaceTwRow = Screen.TwipsPerPixelY   '单据头控件之行距
    Set frmName = vData
    NewQ.SetWin frmName.picInput.hwnd
    
    My.blnIsChanged = False
    My.bytRegion = FcmdButton
    My.bytIndex = 0
    frmName.GrdCol.Cols = 29
'
'    '设置窗体控件颜色
'    'SetFormColor fccolor
'    'ApplyFormColor frmName, fccolor
'    fccolor = BillPublic.ApplyFormColorOfTemplate(frmName)
'
'    SeparateLineColor = fccolor.lngGridLineColor   'GRID列分隔线色

    '给GRDCOL设HOOK
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = frmName.GrdCol.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True

    Set mclsHook = New SubClass32.SubClass
    mclsHook.hwnd = frmName.hwnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True
    Set HookHe = New Hook
    HookHe.SetHookAll frmName.hwnd
    
'    Set mclsPicHook = New SubClass32.SubClass
'    mclsPicHook.hWnd = picInput.hWnd
'    mclsPicHook.Messages(WM_PAINT) = True
    
'    My.intAccountYear = gclsBase.AccountYear    '会计年度
'    My.bytAccountPeriod = gclsBase.Period   '会计期间
    My.intAccountYear = 1998    '会计年度
    My.bytAccountPeriod = 0   '会计期间
    My.blnCtrlBinding = False
    My.blnRefresh = False
    My.blnPasteRec = False
    
    Set clsRecord = New RecordClass  '控件参照类
    ReDim Field(14) As ClassField        '表头输入控件的附加属性
    'redim PicLbl(10) As ClassPicInputField  'PIC输入时的附加属性
    ReDim ColProperty(44) As ClassGridProperty   'GRID附加属性
'设置GRID附加属性
'    frmname.lblInput(0).Height = frmname.grdCol.RowHeight(0)
'    frmname.lblTitle(0).Height = frmname.grdCol.RowHeight(0)
    SetColProperty
'创建GRID列粘贴控键
  Dim i As Integer
    frmName.lblTotal(0).ZOrder 0
    For i = 1 To frmName.GrdCol.Cols
        Load frmName.lblTotal(i)
        frmName.lblTotal(i).Caption = ""
        frmName.lblTotal(i).ZOrder 0
    Next i
    frmName.lblTotal(1).Alignment = 2
'   创建Field控件(表头输入)
    CreateField (14)
    CreatelblNote
'    GrdAndLabelInitial
    ReDim strColRow(45) As String  '单据体行复制/粘贴存储区
    ReDim arrItemProperty(1) As ItemProperty
'设置默认小数位数
    If Not gclsBase Is Nothing Then
        intCurDec = gclsBase.NaturalCurDec
        intRateDec = gclsBase.PriceDec
    End If
    lngBackColor = GetSysColor(COLOR_BTNFACE)
    If WanNeng Then
        frmName.tblReceipt.Visible = True
        SetImageList frmName.tblReceipt
        SetToolBarTextImage frmName.tblReceipt, 2, intReceiptTypeID
    End If
End Property
Public Property Get Form() As Object
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.GridName
    Set Form = frmName
End Property
'确定滚动条的存在(待优化)
Private Sub ScrollBarExist(blnHscroll As Boolean, blnVscroll As Boolean)
    Dim intTotalColsWidth As Long
    intTotalColsWidth = lngSumOfColWidth()
    If frmName.GrdCol.Rows <= 2 Then
        '总行数小于2,必无垂直滚动条
        blnVscroll = False
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * 0 Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If (Not frmName.GrdCol.RowIsVisible(frmName.GrdCol.Rows - 1)) Or (Not frmName.GrdCol.RowIsVisible(1)) Then
        '第一行或最大行不可视(第0行为固定行),必有垂直滚动条
        blnVscroll = True
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * 0 - gclsEniv.VScrollWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth >= frmName.GrdCol.width - 2 * 0 Then
        blnHscroll = True
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight - gclsEniv.HScrollHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth < frmName.GrdCol.width - 2 * 0 - gclsEniv.VScrollWidth Then
        blnHscroll = False
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    
    If intTotalColsWidth < frmName.GrdCol.width - 2 * 0 _
        And intTotalColsWidth > frmName.GrdCol.width - 2 * 0 - gclsEniv.VScrollWidth Then
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
            blnHscroll = True
        Else
            blnVscroll = False
            blnHscroll = False
        End If
    End If

EndProc:
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarVertical Then
        blnHscroll = False
    End If
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarHorizontal Then
        blnVscroll = False
    End If

End Sub
'在GRID上确定行是否可见
Private Function blnRowIsVisible(ByVal RowNo As Integer) As Boolean
    '该行高度完全可视时为TRUE
    Dim blnHscroll As Boolean, blnVscroll As Boolean
    If frmName.GrdCol.Rows <= 1 Then
        frmName.GrdCol.Rows = 2
    End If
    If RowNo > frmName.GrdCol.Rows - 1 Then
        blnRowIsVisible = False
    End If
    If frmName.GrdCol.RowIsVisible(RowNo) = False Then
        blnRowIsVisible = False
        Exit Function
    End If
    Call ScrollBarExist(blnHscroll, blnVscroll) '判断是否滚动条
    If blnHscroll Then
        '下边有滚动水平条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height - gclsEniv.HScrollHeight Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   Else
        '下边无水平滚动条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   End If
End Function

'在GRID上确定行是否可见
Private Function blnColIsVisible(ByVal colNo As Integer) As Boolean
    Dim blnHscroll As Boolean, blnVscroll As Boolean, lngUsableWidth As Long
    '该行高度完全可视时为TRUE
    With frmName.GrdCol
        If colNo = 1 Then '第一列
            blnColIsVisible = True
            Exit Function
        ElseIf .ColWidth(colNo) = 0 Then '宽度为0列
            blnColIsVisible = False
            Exit Function
        ElseIf .LeftCol > colNo Then '小于GRDCOL的最左可视列
            blnColIsVisible = False
            Exit Function
        ElseIf .Cols - 1 = colNo Then 'GRDCOL最后列
            blnColIsVisible = False
            Exit Function
        ElseIf .ColIsVisible(colNo) = False Then 'GRDCOL最后列
            blnColIsVisible = False
            Exit Function
        Else
            '列可视
            If .ColIsVisible(colNo + 1) And .ColWidth(colNo + 1) > 0 Then
                '其右一列可视
                blnColIsVisible = True
                Exit Function
            Else
                Call ScrollBarExist(blnHscroll, blnVscroll) '判断是否滚动条
                lngUsableWidth = IIf(blnVscroll, .width - gclsEniv.VScrollWidth, .width)
                If ColProperty(colNo).lngCtrType = TRefer Or ColProperty(colNo).lngCtrType = tdate Or ColProperty(colNo).lngCtrType = TSpinText Then
                    If lngUsableWidth - .ColPos(colNo) >= 500 Then
                        blnColIsVisible = True
                        Exit Function
                    Else
                        blnColIsVisible = False
                        Exit Function
                    End If
                Else
                    If lngUsableWidth - .ColPos(colNo) > 100 Then
                        blnColIsVisible = True
                        Exit Function
                    Else
                        blnColIsVisible = False
                        Exit Function
                    End If