xchart.ctl

chart图片,统计,网上下来的源代码

VERSION 5.00
Begin VB.UserControl XChart 
   Alignable       =   -1  'True
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   5580
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8400
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LockControls    =   -1  'True
   ScaleHeight     =   5580
   ScaleWidth      =   8400
   ToolboxBitmap   =   "XChart.ctx":0000
   Begin VB.PictureBox picToPrinterLegend 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   555
      Left            =   1650
      ScaleHeight     =   555
      ScaleWidth      =   1005
      TabIndex        =   2
      Top             =   2220
      Visible         =   0   'False
      Width           =   1005
   End
   Begin VB.PictureBox picToPrinter 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   555
      Left            =   1620
      ScaleHeight     =   555
      ScaleWidth      =   1005
      TabIndex        =   1
      Top             =   1560
      Visible         =   0   'False
      Width           =   1005
   End
   Begin VB.Label lblInfo 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   105
      TabIndex        =   0
      Top             =   480
      UseMnemonic     =   0   'False
      Visible         =   0   'False
      Width           =   1050
   End
   Begin VB.Menu mnuMain 
      Caption         =   "&Main"
      Visible         =   0   'False
      Begin VB.Menu mnuMainSaveAs 
         Caption         =   "Save As"
      End
      Begin VB.Menu mnuMainPrint 
         Caption         =   "Print"
      End
      Begin VB.Menu mnuMainCopy 
         Caption         =   "Copy"
      End
      Begin VB.Menu mnuSeparator1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMainSelectionInfo 
         Caption         =   "Selection information"
      End
      Begin VB.Menu mnuMainViewLegend 
         Caption         =   "Display Legend"
      End
      Begin VB.Menu mnuMainCustomItemsSeparator 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "1"
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "2"
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "3"
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "4"
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "5"
         Index           =   4
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "6"
         Index           =   5
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "7"
         Index           =   6
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMainCustomItems 
         Caption         =   "8"
         Index           =   7
         Visible         =   0   'False
      End
   End
   Begin VB.Menu mnuLegend 
      Caption         =   "&Legend"
      Begin VB.Menu mnuLegendHide 
         Caption         =   "Hide"
      End
   End
End
Attribute VB_Name = "XChart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Type PointAPI   'API Point structure
    X   As Long
    Y   As Long
End Type
Private Const PI    As Double = 3.14159265358979
Private Const RADS  As Double = PI / 180    '<Degrees> * RADS = radians
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long
Private uColumns()        As Double
'--------------------------------------------------------------------------------
Public Enum LegendPrintConstants            'the enumerated for legend printing
    legPrintNone = 0
    legPrintGraph
    legPrintText
End Enum
Private uLegendPrintMode As LegendPrintConstants
Public Enum PrinterFitConstants             'the enumerated for printing
    prtFitCentered = 0
    prtFitStretched
    prtFitTopLeft
    prtFitTopRight
    prtFitBottomLeft
    prtFitBottomRight
End Enum

Private uMeanOn           As Boolean      'marker indicating if the mean value must be displayed
Private uRangeY           As Integer      'the absolute range between Y-axis min. ad max. values
Private uDataType         As Integer      'indicates the data distribution in the Y axis
Private Const DT_BOTH = 0                 ' 0 = range(-Y0, +Y1)
Private Const DT_NEG = 1                  ' 1 = range(-Y0, -Y1)
Private Const DT_POS = 2
Private uMinYValue        As Double       'minimum y value
Private uLineColor        As Long         'the color of the line
Private uLineStyle        As Integer      'the line style
Private uBarColor         As Long         'the backcolor of the bars
Private uBarFillStyle     As Integer      'the bars fill style
Private uSelectedBarColor As Long         'the selected bar backcolor
Private uMajorGridColor   As Long         'the major intersect grid color
Private uMinorGridOn      As Boolean      'marker indicating display of minor grid
Private uMajorGridOn      As Boolean      'marker indicating display of major grid
Private uInfoBackColor    As Long         'the information box background color
Private uInfoForeColor    As Long         'the information box foreground color
Private uXAxisLabelColor  As Long         'the X axis label color
Private uYAxisLabelColor  As Long         'the Y axis label color
Private uXAxisItemsColor  As Long         'the X axis items color
Private uYAxisItemsColor  As Long         'the Y axis items color
Private uChartTitleColor  As Long         'the chart title color
Private uChartSubTitleColor As Long       'the chart subtitle color
Private uSaveAsCaption    As String       'the SaveAs dialog box caption
Private uInfoItems        As String       'the information items (to be displayed in the info box)
Private Const INFO_ITEMS = "Value|Description|Mean"
Public Enum ChartMenuConstants             'the enumerated for menu type
    xcPopUpMenu = 0
    xcButtonMenu
End Enum
Private uMenuItems        As String       'the menu's items.
Private Const MENU_ITEMS = "&Save as...|&Print|&Copy|Selection &information|&Legend|&Hide"
Private uCustomMenuItems  As String       'the custom menu's items.
Private Const CUSTOM_MENU_ITEMS = Empty
Private uLegendCaption    As String       'the legend's tooltip string
Private Const LEGEND_CAPTION = "Display legend"
Private Const XC_BAR = 1
Private Const XC_SYMBOL = 2
Private Const XC_LINE = 4
Private Const XC_OVAL = 8
Private Const XC_TRIANGLE = 16
Private Const XC_RHOMBUS = 32
Private Const XC_TRAPEZIUM = 64
Public Enum ChartTypeConstants            'the enumerated for chart type
    xcBar = XC_BAR
    xcSymbol = XC_SYMBOL
    xcLine = XC_LINE
    xcBarLine = XC_BAR + XC_LINE
    xcSymbolLine = XC_SYMBOL + XC_LINE
    xcOval = XC_OVAL
    xcOvalLine = XC_OVAL + XC_LINE
    xcTriangle = XC_TRIANGLE
    xcTriangleLine = XC_TRIANGLE + XC_LINE
    xcRhombus = XC_RHOMBUS
    xcRhombusLine = XC_RHOMBUS + XC_LINE
    xcTrapezium = XC_TRAPEZIUM
    xcTrapeziumLine = XC_TRAPEZIUM + XC_LINE
End Enum
Private uChartType        As ChartTypeConstants 'the chart type.
Private uBarWidthPercentage As Integer    'the column width (in percentage) just for bar type
Private uLineWidth        As Integer
Private Const IDX_SAVE = 0                'the command buttons' indexs
Private Const IDX_PRINT = 1
Private Const IDX_COPY = 2
Private Const IDX_INFO = 3
Private Const IDX_LEGEND = 4
Private uColWidth         As Single       'the calculated width of each column
Private uRowHeight        As Single       'the calculated height of each column
Private uTopMargin        As Single       '--------------------------------------
Private uBottomMargin     As Single       'margins used around the chart content
Private uLeftMargin       As Single       '
Private uRightMargin      As Single
Private uRightMarginOrg   As Single       '--------------------------------------
Private uContentBorder    As Boolean      'border around the chart content?
Private uSelectable       As Boolean      'marker indicating whether user can select a column
Private uHotTracking      As Boolean      'marker indicating use of hot tracking
Private uSelectedColumn   As Integer      'marker indicating the selected column
Private uOldSelection     As Long
Private uDisplayDescript  As Boolean      'display description when selectable
Private uChartTitle       As String       'chart title
Private uChartSubTitle    As String       'chart sub title
Private uAxisXOn          As Boolean      'marker indicating display of x axis
Private uAxisYOn          As Boolean      'marker indicating display of y axis
Private uColorBars        As Boolean      'marker indicating use of different coloured bars
Private uIntersectMajor   As Single       'major intersect value
Private uIntersectMinor   As Single       'minor intersect value
Private uMaxYValue        As Double       'maximum y value
Private uXAxisLabel       As String       'label to be displayed below the X-Axis
Private uYAxisLabel       As String       'label to be displayed left of the Y-Axis
Private cItems            As Collection   'collection of chart items
Private offsetX           As Long
Private offsetY           As Long
Private bLegendAdded      As Boolean
Private bLegendClicked    As Boolean
Private bDisplayLegend    As Boolean
Private bResize           As Boolean
Private bResizeLegend     As Boolean
Private bProcessingOver   As Boolean      'marker to speed up mouse over effects
Public Type ChartItem
    ItemID As String
    SelectedDescription As String
    LegendDescription As String
    XAxisDescription As String
    Value As Double
End Type
Public Event ItemClick(cItem As ChartItem)
Public Event MenuItemClick(intMenuItemIndex As Integer, stgMenuItemCaption As String)
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Function AddItem(cItem As ChartItem) As Boolean '5225522525
    Dim oChartItem As ChartItem
    cItems.Add cItem
    If uMeanOn = True Then
       cItems.Add oChartItem
   End If
End Function
Private Sub DrawTrapezium(dblData As Double, sngX1 As Single, sngX2 As Single, sngY1 As Single, sngY2 As Single)
    On Error Resume Next
    Dim lRet As Long
    Dim sngXTemp As Single
    Dim sngYTemp As Single
    Dim lngFillColor As Long
    Dim uaPts(3) As PointAPI
    Dim intScaleMode As Integer
    sngXTemp = (sngX2 - sngX1) / 4      'consider the 25% as X-offset
    '     (1)-----(2)
    '    /           \
    '   /             \
    ' (0)-------------(3)
    uaPts(0).X = sngX1 / Screen.TwipsPerPixelX
    uaPts(1).X = (sngX1 + sngXTemp) / Screen.TwipsPerPixelX
    uaPts(2).X = (sngX2 - sngXTemp) / Screen.TwipsPerPixelX
    uaPts(3).X = sngX2 / Screen.TwipsPerPixelX
    If dblData > 0 Then
        uaPts(0).Y = sngY2 / Screen.TwipsPerPixelY
        uaPts(1).Y = sngY1 / Screen.TwipsPerPixelY
        uaPts(2).Y = sngY1 / Screen.TwipsPerPixelY
        uaPts(3).Y = sngY2 / Screen.TwipsPerPixelY
    Else
        uaPts(0).Y = sngY1 / Screen.TwipsPerPixelY
        uaPts(1).Y = sngY2 / Screen.TwipsPerPixelY
        uaPts(2).Y = sngY2 / Screen.TwipsPerPixelY
        uaPts(3).Y = sngY1 / Screen.TwipsPerPixelY
    End If
    lRet = Polygon(UserControl.hDC, uaPts(0), 4)