xpie.ctl

来自「多种图表的绘制及其运用」· CTL 代码 · 共 1,957 行 · 第 1/5 页

        intItemCnt = 0
        For intIdx = 0 To UBound(varItems)
            stgItem = Trim(CStr(varItems(intIdx)))
            If stgItem <> Empty Then
                'eight items allowed in the custom menu
                If intItemCnt > 7 Then Exit For
                mnuMainCustomItems(intItemCnt).Caption = stgItem
                mnuMainCustomItems(intItemCnt).Visible = True
                intItemCnt = intItemCnt + 1
            End If
        Next
    End If
    'let the separator visible if at least one custom menu item is visible
    mnuMainCustomItemsSeparator.Visible = (mnuMainCustomItems(0).Visible)

End Sub
Public Property Let MarginTop(lMargin As Long)
    uTopMargin = lMargin * Screen.TwipsPerPixelY
    DrawChart
    PropertyChanged "MarginTop"
End Property

Public Property Get MarginTop() As Long
Attribute MarginTop.VB_Description = "Determines the distance between the top edge of the chart and the top edge of its container (in pixels)."
    MarginTop = uTopMargin / Screen.TwipsPerPixelY
End Property

Public Property Let MarginBottom(lMargin As Long)
    uBottomMargin = lMargin * Screen.TwipsPerPixelY
    DrawChart
    PropertyChanged "MarginBottom"
End Property

Public Property Get MarginBottom() As Long
Attribute MarginBottom.VB_Description = "Determines the distance between the bottom edge of the chart and the bottom edge of its container (in pixels)."
    MarginBottom = uBottomMargin / Screen.TwipsPerPixelY
End Property

Public Property Let MarginLeft(lMargin As Long)
    uLeftMargin = lMargin * Screen.TwipsPerPixelX
    DrawChart
    PropertyChanged "MarginLeft"
End Property

Public Property Get MarginLeft() As Long
Attribute MarginLeft.VB_Description = "Determines the distance between the left edge of the chart and the left edge of its container (in pixels)."
    MarginLeft = uLeftMargin / Screen.TwipsPerPixelX
End Property

Public Property Let MarginRight(lMargin As Long)
    uRightMargin = lMargin * Screen.TwipsPerPixelX
    uRightMarginOrg = uRightMargin
    DrawChart
    PropertyChanged "MarginRight"
End Property

Public Property Get MarginRight() As Long
Attribute MarginRight.VB_Description = "Determines the distance between the right edge of the chart and the right edge of its container (in pixels)."
    MarginRight = uRightMargin / Screen.TwipsPerPixelX
End Property

Public Property Get MenuType() As ChartMenuConstants
Attribute MenuType.VB_Description = "Determines the type of the menu to be used."
    MenuType = uMenuType
End Property

Public Property Let MenuType(intVal As ChartMenuConstants)
    If intVal <> uMenuType Then
        uMenuType = intVal
        FixMenu
        PropertyChanged "MenuType"
    End If
End Property

Public Property Let PictureTile(blnVal As Boolean)
    If blnVal <> uPictureTile Then
        uPictureTile = blnVal
        DrawChart
        PropertyChanged "PictureTile"
    End If
End Property

Public Property Get PictureTile() As Boolean
Attribute PictureTile.VB_Description = "Determines if the picture used as the background of the chart must be tiled."
    PictureTile = uPictureTile
End Property

Public Sub PrintPie()
    
    On Error Resume Next
    
    Dim sngX As Single
    Dim sngY As Single
    Dim sngW As Single
    Dim sngH As Single
    Dim sngXBox As Single
    Dim sngWBox As Single
    Dim sngXDesc As Single
    Dim sngWDesc As Single
    Dim sngYoff As Single
    Dim sngXoff As Single
    Dim intIdx As Integer

    Screen.MousePointer = vbHourglass
    Printer.Orientation = uPrinterOrientation
    
    With picToPrinter
        .Cls
        sngW = IIf(bDisplayLegend = True, picSplitter.Left, UserControl.ScaleWidth)
        sngH = UserControl.ScaleHeight
        Select Case uPrinterFit
            Case prtFitStretched
                If (uLegendPrintMode = legPrintGraph) Then
                    .Width = Printer.ScaleWidth * Printer.ScaleX(picSplitter.Left, UserControl.ScaleMode, Printer.ScaleMode) / UserControl.ScaleWidth
                Else
                    .Width = Printer.ScaleWidth * Printer.ScaleX(UserControl.ScaleWidth, UserControl.ScaleMode, Printer.ScaleMode) / UserControl.ScaleWidth
                End If
                .Height = Printer.ScaleHeight
                .PaintPicture UserControl.Image, 0, 0, .Width, .Height, 0, 0, sngW, sngH
            
            Case Else
                .Width = sngW
                .Height = sngH
                .PaintPicture UserControl.Image, 0, 0, sngW, sngH, 0, 0, sngW, sngH
            
        End Select
        sngW = .Width
        sngH = .Height
    End With
    
    If (bDisplayLegend = True) Then
        If (uLegendPrintMode = legPrintGraph) Then
            With picToPrinterLegend
                .Width = picLegend.Width
                .Height = picLegend.Height
                .Cls
                picToPrinterLegend.Line (0, 0)-(.Width, .Height), uLegendBackColor, BF
                picToPrinterLegend.Line (0, 0)-(2 * Screen.TwipsPerPixelX, .Height), picSplitter.BackColor, BF
                Set .Font = picDescription(0).Font
            
                sngXBox = picBox(0).Left
                sngWBox = picBox(0).Width
                sngXDesc = picDescription(0).Left
                sngWDesc = picDescription(0).ScaleWidth
                For intIdx = 0 To picBox.Count - 1
                    sngY = picBox(intIdx).Top
                    .ForeColor = uLegendForeColor
                    .CurrentX = sngXDesc
                    .CurrentY = sngY
                    picToPrinterLegend.Print picDescription(intIdx).Tag
                    picToPrinterLegend.Line (sngXBox, sngY)-(sngXBox + sngWBox, sngY + sngWBox), picBox(intIdx).BackColor, BF
                Next
                Select Case uPrinterFit
                    Case prtFitStretched
                        sngXoff = Printer.ScaleWidth * Printer.ScaleX(.ScaleWidth, .ScaleMode, Printer.ScaleMode) / UserControl.ScaleWidth
                    Case Else
                        sngXoff = .ScaleWidth
                End Select
                picToPrinter.Width = picToPrinter.Width + sngXoff
                picToPrinter.PaintPicture .Image, picToPrinter.Width - sngXoff, 0, sngXoff, sngH
            End With
        End If
    End If
    
    With picToPrinter
        Select Case uPrinterFit
            Case prtFitCentered
                sngY = ((Printer.ScaleHeight - .ScaleHeight) / 2)
                sngX = ((Printer.ScaleWidth - .ScaleWidth) / 2)
            
            Case prtFitStretched, prtFitTopLeft
                sngX = 0
                sngY = 0
        
            Case prtFitTopRight
                sngX = Printer.ScaleWidth - .ScaleWidth
                sngY = 0
        
            Case prtFitBottomLeft
                sngX = 0
                sngY = Printer.ScaleHeight - .ScaleHeight
            
            Case prtFitBottomRight
                sngX = Printer.ScaleWidth - .ScaleWidth
                sngY = Printer.ScaleHeight - .ScaleHeight
        
        End Select
    
        Printer.PaintPicture .Image, sngX, sngY, .ScaleWidth, .ScaleHeight
        Printer.EndDoc
    End With
    
    If (bDisplayLegend = True) And (uLegendPrintMode = legPrintText) Then
        Call PrintLegend
    End If
    
    Screen.MousePointer = vbDefault

End Sub

Public Sub PrintLegend()

    Dim stg As String
    Dim sngX As Single
    Dim intIdx As Integer
    Dim varItems As Variant
    Dim oPieSegment As ActivePie.PieSegment
    
    If cItems.Count > 0 Then
        'this kind of error trapping is useful in case the user
        'did not define any item in the menu items string, so the default is used
        On Error GoTo Printlegend_error

        If uInfoItems = Empty Then uInfoItems = INFO_ITEMS
        varItems = Split(uInfoItems, "|")
        
        Printer.FontBold = True
        'dump chart title
        Printer.FontSize = UserControl.FontSize
        sngX = (Printer.ScaleWidth - Printer.TextWidth(uChartTitle)) / 2
        Printer.CurrentX = sngX
        Printer.Print uChartTitle
        
        'dump chart subtitle
        Printer.FontSize = Printer.FontSize - 2
        sngX = (Printer.ScaleWidth - Printer.TextWidth(uChartSubTitle)) / 2
        Printer.CurrentX = sngX
        Printer.Print uChartSubTitle
        Printer.FontSize = Printer.FontSize + 2
        Printer.Print
        
        Printer.FontBold = False
        If uGroupSegment = False Then
            For intIdx = 1 To cItems.Count
                With cItems(intIdx)
                    stg = .LegendDescription & " (" & Format(.Value, uDataFormat) & " - " & Format(cItemsAttributes(intIdx).Value, "#0.00\%") & ")"
                End With
                Printer.Print stg
            Next
        Else
            For intIdx = 1 To cGroups.Count
                With cGroups(intIdx)
                    stg = .Group & " (" & Format(.Value, uDataFormat) & " - " & Format(cGroupsAttributes(intIdx).Value, "#0.00\%") & ")"
                End With
                Printer.Print stg
            Next
        End If
        
        Printer.EndDoc
    End If
    Exit Sub

Printlegend_error:
    uInfoItems = INFO_ITEMS
    Resume Next

End Sub


Public Property Get LegendCaption() As String
    LegendCaption = uLegendCaption
End Property

Public Property Let ChartTitle(stgVal As String)
    If stgVal <> uChartTitle Then
        uChartTitle = stgVal
        DrawChart
        PropertyChanged "ChartTitle"
    End If
End Property

Public Property Get ChartTitle() As String
Attribute ChartTitle.VB_Description = "Determines the title of the chart."
    ChartTitle = uChartTitle
End Property

Public Property Let MenuItems(stgVal As String)
    uMenuItems = stgVal
    FixMenu
    PropertyChanged "MenuItems"
End Property

Public Property Let GroupExplodeMenuItems(stgVal As String)
    
    'menu items to be accessed when exploding group
    'form is: item1|item2|[item3]|[item4]|....[itemN]
    ' mandatory:    item1 is for OK command button
    '               item2 is for PRINT command button
    ' optional:     item3 is for OTHERS command button
    '               item4...itemN are the others commands available (10 commands must be set)
    
    uGroupExplodeMenuItems = stgVal
    FixGroupExplodeMenu
    PropertyChanged "GroupExplodeMenuItems"

End Property


Public Property Let CustomMenuItems(stgVal As String)
    uCustomMenuItems = stgVal
    FixCustomMenu
    PropertyChanged "CustomMenuItems"
End Property


Public Property Let InfoItems(stgVal As String)
Attribute InfoItems.VB_Description = "Determines the string values displayed when selection information is enabled (separated by |)."
    uInfoItems = stgVal
    PropertyChanged "InfoItems"
End Property
Public Property Get InfoItems() As String
    InfoItems = uInfoItems
End Property
Public Property Get MenuItems() As String
Attribute MenuItems.VB_Description = "Determines the string values displayed when popup menu is enabled (separated by |)."
    MenuItems = uMenuItems
End Property
Public Property Get GroupExplodeMenuItems() As String
    GroupExplodeMenuItems = uGroupExplodeMenuItems
End Property

Public Property Get CustomMenuItems() As String
    CustomMenuItems = uCustomMenuItems
End Property


Public Property Let ChartSubTitle(stgVal As String)
    If stgVal <> uChartSubTitle Then
        uChartSubTitle = stgVal
        DrawChart
        PropertyChanged "ChartSubTitle"
    End If
End Property

Public Property Get ChartSubTitle() As String
Attribute ChartSubTitle.VB_Description = "Determines the subtitle of the chart."
    ChartSubTitle = uChartSubTitle
End Property

Public Property Let SelectionInformation(blnVal As Boolean)
Attribute SelectionInformation.VB_Description = "Determines if the information box about the selected bar must be visible or hidden."
    If blnVal <> uDisplayDescript Then
        uDisplayDescript = blnVal
        DrawChart
        PropertyChanged "SelectionInformation"
    End If
End Property
Public Property Let GroupSegment(blnVal As Boolean)
    uGroupSegment = blnVal
    DrawChart
    PropertyChanged "GroupSegment"
End Property

Public Property Let GroupExplodeOnClick(blnVal As Boolean)
    If blnVal <> uGroupExplode Then
        uGroupExplode = blnVal
        PropertyChanged "GroupExplode"
    End If
End Property
Public Property Let GroupExplodeAllowCommands(blnVal As Boolean)
    If blnVal <> uGroupExplodeAllowCommands Then
        uGroupExplodeAllowCommands = blnVal
        PropertyChanged "GroupExplodeAllowCommands"
    End If
End Property



Public Property Get SelectionInformation() As Boolean
    SelectionInformation = uDisplayDescript
End Property

Public Property Let BackColor(lngVal As OLE_COLOR)
Attribute BackColor.VB_Description = "Returns/sets the color of the chart background."
    If lngVal <> UserControl.BackColor Then
        UserControl.BackColor = lngVal
        DrawChart
        PropertyChanged "BackColor"
    End If
End Property
Public Property Let GroupExplodeBackColor(lngVal As OLE_COLOR)
    If lngVal <> uGroupExplodeBackColor Then
        uGroupExplodeBackColor = lngVal
        PropertyChanged "GroupExplodeBackColor"
    End If
End Property
Public Property Let GroupExplodeForeColor(lngVal As OLE_COLOR)
    If lngVal <> uGroupExplodeForeColor Then
        uGroupExplodeForeColor = lngVal
        PropertyChanged "GroupExplodeForeColor"
    End If
End Property