xquadrant.ctl

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

    If uIntersectMinorY = 0 Then uIntersectMinorY = uIntersectMajorY / 5
    
    If uMinXValue < 0 And uMaxXValue < 0 Then
        uDataTypeX = DT_NEG
        uRangeX = (Abs(uMinXValue) - Abs(uMaxXValue))
    ElseIf uMinXValue >= 0 And uMaxXValue >= 0 Then
        uDataTypeX = DT_POS
        uRangeX = (Abs(uMaxXValue) - Abs(uMinXValue))
    Else
        uDataTypeX = DT_BOTH
        uRangeX = (Abs(uMaxXValue) + Abs(uMinXValue))
    End If

    If uRangeX = 0 Then uRangeX = 1
    If uIntersectMajorX = 0 Then uIntersectMajorX = uRangeX / 10
    If uIntersectMinorX = 0 Then uIntersectMinorX = uIntersectMajorX / 5

End Sub

Private Sub FixMenu()
    
    '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 FixMenu_error
    
    Dim varItems As Variant
    
    If uMenuItems = Empty Then
        uMenuItems = MENU_ITEMS
    End If
    varItems = Split(uMenuItems, "|")
    
    If varItems(0) <> Empty Then
        mnuMainSaveAs.Caption = CStr(varItems(0))
    Else
        mnuMainSaveAs.Caption = "&Save as..."
    End If
    
    If varItems(1) <> Empty Then
        mnuMainPrint.Caption = CStr(varItems(1))
    Else
        mnuMainPrint.Caption = "&Print"
    End If
    
    If varItems(2) <> Empty Then
        mnuMainCopy.Caption = CStr(varItems(2))
    Else
        mnuMainCopy.Caption = "&Copy"
    End If
    
    If varItems(3) <> Empty Then
        mnuMainSelectionInfo.Caption = CStr(varItems(3))
    Else
        mnuMainSelectionInfo.Caption = "Selection &information"
    End If
    
    If varItems(4) <> Empty Then
        mnuMainQuadrantInfo.Caption = CStr(varItems(4))
    Else
        mnuMainQuadrantInfo.Caption = "&Quadrant information"
    End If
    
    If varItems(5) <> Empty Then
        mnuMainViewLegend.Caption = CStr(varItems(5))
    Else
        mnuMainViewLegend.Caption = "&Legend"
    End If
    
    If varItems(6) <> Empty Then
        mnuLegendHide.Caption = CStr(varItems(6))
    Else
        mnuLegendHide.Caption = "&Hide"
    End If

    If uMenuType = xcButtonMenu Then
        picCommands.Visible = True
        picCommands.BackColor = UserControl.BackColor
        picCommands.Move 60, 60
        If lblInfo.Visible = False Then
            lblInfo.Move picCommands.Left + picCommands.ScaleWidth + 60, 60
        End If
    Else
        picCommands.Visible = False
        If lblInfo.Visible = False Then
            lblInfo.Move 60, 60
        End If
    End If
    If picInfoQuadrant.Visible = False Then
        picInfoQuadrant.Move lblInfo.Left, lblInfo.Top + lblInfo.Height + 60
    End If
    Exit Sub
    
FixMenu_error:
    uMenuItems = MENU_ITEMS
    Resume Next

End Sub

Private Sub FixQuadrantColors()
    
    'this kind of error trapping is useful in case the user
    'did not define any item in the colors string, so the default is used
    On Error GoTo FixQuadrantColors_error
    
    Dim varItems As Variant
    
    If uQuadrantColors = Empty Then
        uQuadrantColors = QUADRANT_COLORS
    End If
    varItems = Split(uQuadrantColors, "|")
    
    If varItems(0) <> Empty Then
        uQuadrantColor(0) = CLng(varItems(0))
    Else
        uQuadrantColor(0) = vbRed
    End If
    
    If varItems(1) <> Empty Then
        uQuadrantColor(1) = CLng(varItems(1))
    Else
        uQuadrantColor(1) = vbBlue
    End If
    
    If varItems(2) <> Empty Then
        uQuadrantColor(2) = CLng(varItems(2))
    Else
        uQuadrantColor(2) = vbGreen
    End If
    
    If varItems(3) <> Empty Then
        uQuadrantColor(3) = CLng(varItems(3))
    Else
        uQuadrantColor(3) = vbYellow
    End If
    
    Exit Sub
    
FixQuadrantColors_error:
    uQuadrantColors = QUADRANT_COLORS
    Resume Next

End Sub

Private Sub FixCustomMenu()
    
    On Error Resume Next
    
    Dim ctl As Control
    Dim intIdx As Integer
    Dim stgItem As String
    Dim varItems As Variant
    Dim intItemCnt As Integer
    
    For Each ctl In mnuMainCustomItems
        ctl.Visible = False
    Next
    If Trim(uCustomMenuItems) <> Empty Then
        varItems = Split(uCustomMenuItems, "|")
        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 Let ContentBorder(blnVal As Boolean)
    If blnVal <> uContentBorder Then
        uContentBorder = blnVal
        DrawChart
        PropertyChanged "ContentBorder"
    End If
End Property

Public Property Get ContentBorder() As Boolean
Attribute ContentBorder.VB_Description = "Returns/sets a value that determines if the border of the chart must be drawn."
    ContentBorder = uContentBorder
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 PrintChart()
    
    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 oChartItem As ChartItem
    
    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