单元格设置.frm

用友U8财务软件VB源程序, 本版本为2002年版本

    '自动换行
    frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
    Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
    If CellFormat.WordWrap Then
        Me.chkWrapText = 1
    Else
        Me.chkWrapText = 0
    End If
    
    '合并单元格
    If frmVchDefine.lDownRow = frmVchDefine.lUpRow And Not frmVchDefine.FieldObjectRC(frmVchDefine.lDownRow, IIf(frmVchDefine.lDownCol > 1, frmVchDefine.lDownCol - 1, frmVchDefine.lDownCol), frmVchDefine.lUpCol, True) Is Nothing Then
        frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
        Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
        chkMergeCell.Enabled = True
        If CellFormat.MergeCells = True Then
            chkMergeCell.Value = 1
        Else
            chkMergeCell.Value = 0
        End If
    Else
        chkMergeCell.Enabled = False
        chkMergeCell.Value = 2
    End If
    
    '字体
    Dim FontColor(16, 3) As Byte
    
    FontColor(1, 1) = 0
    FontColor(1, 2) = 0
    FontColor(1, 3) = 0
    
    FontColor(2, 1) = 0
    FontColor(2, 2) = 0
    FontColor(2, 3) = 255
    
    FontColor(3, 1) = 0
    FontColor(3, 2) = 255
    FontColor(3, 3) = 255
    
    FontColor(4, 1) = 0
    FontColor(4, 2) = 255
    FontColor(4, 3) = 0
    
    FontColor(5, 1) = 255
    FontColor(5, 2) = 0
    FontColor(5, 3) = 255
    
    FontColor(6, 1) = 255
    FontColor(6, 2) = 0
    FontColor(6, 3) = 0
    
    FontColor(7, 1) = 255
    FontColor(7, 2) = 255
    FontColor(7, 3) = 0
    
    FontColor(8, 1) = 255
    FontColor(8, 2) = 255
    FontColor(8, 3) = 255
    
    FontColor(9, 1) = 0
    FontColor(9, 2) = 0
    FontColor(9, 3) = 128
    
    FontColor(10, 1) = 0
    FontColor(10, 2) = 128
    FontColor(10, 3) = 128
    
    FontColor(11, 1) = 0
    FontColor(11, 2) = 128
    FontColor(11, 3) = 0
    
    FontColor(12, 1) = 128
    FontColor(12, 2) = 0
    FontColor(12, 3) = 128
    
    FontColor(13, 1) = 128
    FontColor(13, 2) = 0
    FontColor(13, 3) = 0
    
    FontColor(14, 1) = 128
    FontColor(14, 2) = 128
    FontColor(14, 3) = 0
    
    FontColor(15, 1) = 128
    FontColor(15, 2) = 128
    FontColor(15, 3) = 128
    
    FontColor(16, 1) = 192
    FontColor(16, 2) = 192
    FontColor(16, 3) = 192
    
    frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
    Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
    Dim FontDec As Long
    Me.cboFontName.Text = CellFormat.FontName
    For i = 1 To Me.cboFontName.ListCount
        If Me.cboFontName.List(i) = CellFormat.FontName Then
            Me.cboFontName.ListIndex = i
            Exit For
        End If
    Next
    If CellFormat.FontBold And CellFormat.FontItalic Then
        Me.cboFontStyle.ListIndex = 3
    ElseIf Not CellFormat.FontBold And CellFormat.FontItalic Then
        Me.cboFontStyle.ListIndex = 2
    ElseIf CellFormat.FontBold And Not CellFormat.FontItalic Then
        Me.cboFontStyle.ListIndex = 1
    ElseIf Not CellFormat.FontBold And Not CellFormat.FontItalic Then
        Me.cboFontStyle.ListIndex = 0
    End If
    Me.cboFontSize.Text = CellFormat.FontSize
    If CellFormat.FontStrikeout Then
        Me.chkFontStrikethru.Value = 1
    Else
        Me.chkFontStrikethru.Value = 0
    End If
    If CellFormat.FontUnderline Then
        Me.chkFontUnderline.Value = 1
    Else
        Me.chkFontUnderline.Value = 0
    End If
    
    For i = 1 To 16
        FontDec = CLng(FontColor(i, 3) * CLng(65536) + FontColor(i, 2) * CLng(256) + FontColor(i, 1))
        If StrComp(FontDec, CellFormat.FontColor, vbTextCompare) = 0 Then
            imgcboFontColor.ComboItems.Item(i).Selected = True
            Exit For
        End If
    Next

    '线型
    frmVchDefine.objF1Book.SetSelection frmVchDefine.lDownRow, frmVchDefine.lDownCol, frmVchDefine.lUpRow, frmVchDefine.lUpCol
    Set CellFormat = frmVchDefine.objF1Book.GetCellFormat
    If CellFormat.BorderStyle(F1LeftBorder) <> 0 Then
        tlbBorder(0).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1LeftBorder)
        Border(1) = True
    Else
        tlbBorder(0).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(1) = False
    End If
    If CellFormat.BorderStyle(F1HInsideBorder) <> 0 Then
        tlbBorder(1).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1HInsideBorder)
        Border(2) = True
    Else
        tlbBorder(1).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(2) = False
    End If
    If CellFormat.BorderStyle(F1RightBorder) <> 0 Then
        tlbBorder(2).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1RightBorder)
        Border(3) = True
    Else
        tlbBorder(2).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(3) = False
    End If
    If CellFormat.BorderStyle(F1TopBorder) <> 0 Then
        tlbBorder(3).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1TopBorder)
        Border(4) = True
    Else
        tlbBorder(3).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(4) = False
    End If
    If CellFormat.BorderStyle(F1VInsideBorder) <> 0 Then
        tlbBorder(4).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1VInsideBorder)
        Border(5) = True
    Else
        tlbBorder(4).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(5) = False
    End If
    If CellFormat.BorderStyle(F1BottomBorder) <> 0 Then
        tlbBorder(5).Buttons(1).Value = tbrPressed
        LineIndex = CellFormat.BorderStyle(F1BottomBorder)
        Border(6) = True
    Else
        tlbBorder(5).Buttons(1).Value = tbrUnpressed
        LineIndex = 0
        Border(6) = False
    End If
    Me.tlbLine.Buttons(LineIndex + 1).Value = tbrPressed
    
    '图案
    Pattern(1) = 0
    Pattern(1) = 1
    Pattern(2) = 3
    Pattern(3) = 2
    Pattern(4) = 4
    Pattern(5) = 17
    Pattern(6) = 18
    Pattern(7) = 5
    Pattern(8) = 6
    Pattern(9) = 7
    Pattern(10) = 8
    Pattern(11) = 9
    Pattern(12) = 10
    Pattern(13) = 11
    Pattern(14) = 12
    Pattern(15) = 13
    Pattern(16) = 14
    Pattern(17) = 15
    Pattern(18) = 16
    
    If CellFormat.PatternStyle = 0 Then
        PatternIndex = 19
    ElseIf CellFormat.PatternStyle > 0 And CellFormat.PatternStyle <= 18 Then
        For i = 1 To 18
            If Pattern(i) = CellFormat.PatternStyle Then
                PatternIndex = i
                Exit For
            End If
        Next
    End If
    Me.picPattern.Picture = Me.ilsPattern(1).ListImages(PatternIndex).Picture
    If PatternIndex >= 1 And PatternIndex <= 18 Then
        Me.tlbPattern.Buttons(PatternIndex).Value = tbrPressed
    ElseIf PatternIndex = 19 Then
        Me.tlbPatternNo.Buttons(1).Value = tbrPressed
    End If
End Sub

Private Sub tabcellformat_Click()
    If Me.tabCellFormat.SelectedItem.Index = 2 Then
    
    End If
    Me.fraCell(Me.tabCellFormat.SelectedItem.Index - 1).ZOrder
End Sub

Private Sub tlbBor_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim i As Integer
    If Button.Index = 1 Then
        tlbBorder(0).Buttons(1).Value = tbrPressed
        tlbBorder(1).Buttons(1).Value = tbrPressed
        tlbBorder(2).Buttons(1).Value = tbrPressed
        tlbBorder(3).Buttons(1).Value = tbrPressed
        tlbBorder(4).Buttons(1).Value = tbrPressed
        tlbBorder(5).Buttons(1).Value = tbrPressed
        For i = 1 To 6
            Border(i) = True
        Next
    ElseIf Button.Index = 2 Then
        tlbBorder(0).Buttons(1).Value = tbrUnpressed
        tlbBorder(1).Buttons(1).Value = tbrUnpressed
        tlbBorder(2).Buttons(1).Value = tbrUnpressed
        tlbBorder(3).Buttons(1).Value = tbrUnpressed
        tlbBorder(4).Buttons(1).Value = tbrUnpressed
        tlbBorder(5).Buttons(1).Value = tbrUnpressed
        For i = 1 To 6
            Border(i) = False
        Next
    ElseIf Button.Index = 3 Then
        tlbBorder(0).Buttons(1).Value = tbrPressed
    '    tlbBorder(1).Buttons(1).Value = tbrUnpressed
        tlbBorder(2).Buttons(1).Value = tbrPressed
        tlbBorder(3).Buttons(1).Value = tbrPressed
    '    tlbBorder(4).Buttons(1).Value = tbrUnpressed
        tlbBorder(5).Buttons(1).Value = tbrPressed
        For i = 1 To 6
            Border(i) = True
        Next
        Border(2) = False: Border(5) = False
    ElseIf Button.Index = 4 Then
    '    tlbBorder(0).Buttons(1).Value = tbrUnpressed
        tlbBorder(1).Buttons(1).Value = tbrPressed
    '    tlbBorder(2).Buttons(1).Value = tbrUnpressed
    '    tlbBorder(3).Buttons(1).Value = tbrUnpressed
        tlbBorder(4).Buttons(1).Value = tbrPressed
    '    tlbBorder(5).Buttons(1).Value = tbrUnpressed
        For i = 1 To 6
            Border(i) = False
        Next
        Border(2) = True: Border(5) = True
    End If
End Sub

Private Sub tlbBorder_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    If Me.tlbBorder(Index).Buttons(1).Value = tbrUnpressed Then
    '    Me.tlbBorder(Index).Style = tbrFlat
        Me.tlbBorder(Index).Buttons(1).Value = tbrPressed
    Else
    '    Me.tlbBorder(Index).Style = tbrStandard
        Me.tlbBorder(Index).Buttons(1).Value = tbrUnpressed
    End If
End Sub

Private Sub tlbLine_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim i As Integer
    
    For i = 1 To tlbPattern.Buttons.Count
        If Button.Index <> i Then
            tlbPattern.Buttons(i).Value = tbrUnpressed
        Else
            Button.Value = tbrPressed
            LineIndex = i - 1
        End If
    Next
    tlbLine.Refresh
End Sub

Private Sub tlbPattern_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim i As Integer
    tlbPatternNo.Buttons(1).Value = tbrUnpressed
    
    picPattern.AutoRedraw = True
    
    For i = 1 To tlbPattern.Buttons.Count
        If Button.Index <> i Then
            tlbPattern.Buttons(i).Value = tbrUnpressed
        Else
            picPattern.Picture = Me.ilsPattern(1).ListImages(i).Picture
            Button.Value = tbrPressed
            PatternIndex = i
        End If
    Next
    tlbPattern.Refresh
End Sub

Private Sub tlbPatternNo_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim i As Integer
    
    For i = 1 To tlbPattern.Buttons.Count
        If tlbPattern.Buttons(i).Value = tbrPressed Then
            tlbPattern.Buttons(i).Value = tbrUnpressed
        End If
    Next
    picPattern.Picture = Me.ilsPattern(1).ListImages(19).Picture
    tlbPattern.Refresh
    tlbPatternNo.Buttons(1).Value = tbrPressed
    PatternIndex = 19
End Sub