⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 xchart.vb

📁 chart图片,统计,网上下来的源代码
💻 VB
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
		cItems = New Collection
		ClearLegendItems()
		
		uSelectedColumn = -1
		DrawChart()
	End Sub
	
	Public Sub DrawChart() '3
		
		On Error Resume Next
		
		Dim x1 As Single
		Dim x2 As Single
		Dim y1 As Single
		Dim y2 As Single
		Dim xTemp As Single
		Dim yTemp As Single
		Dim xPrev As Single
		Dim yPrev As Single
		Dim sngRowHeight As Single
		Dim CurrentColor As Short
		Dim iCols As Short
		Dim X As Short
		Dim oChartItem As ChartItem
		Dim sngColWidth As Single
		Dim xMiddle As Single
		Dim varLabel As Object
		Dim intIdx As Short
		
		If uAutoRedraw = False Then Exit Sub
		
		FixData()
		
		
		iCols = cItems.Count()
		
		With lblInfo
			.ForeColor = System.Drawing.ColorTranslator.FromOle(uInfoForeColor)
			.BackColor = System.Drawing.ColorTranslator.FromOle(uInfoBackColor)
			.Visible = IIf((uDisplayDescript And uSelectedColumn > -1), True, False)
		End With
		mnuMainSelectionInfo.Checked = uDisplayDescript
		
		If Not bResize Then ClearLegendItems()
		
		Dim perScreen As Short
		Dim scrollValue As Short
		With Me
			uRowHeight = ((VB6.PixelsToTwipsY(VB6.PixelsToTwipsY(.ClientRectangle.Height)) - (uTopMargin + uBottomMargin)) / uRangeY)
			If iCols Then
				uColWidth = ((VB6.PixelsToTwipsX(.ClientRectangle.Width) - (uLeftMargin + uRightMargin)) / iCols)
			End If
			
			'UPGRADE_ISSUE: UserControl 方法 UserControl.Cls 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			.Cls()
			If uPicture Is Nothing Then
			Else
				
			End If
			
			If iCols Then ReDim uColumns(iCols - 1, 1)
			
			On Error Resume Next
			
			
			.ForeColor = System.Drawing.ColorTranslator.FromOle(uChartTitleColor)
			'UPGRADE_ISSUE: UserControl 方法 UserControl.TextWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentX 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			.CurrentX = xMiddle - (.TextWidth(uChartTitle) / 2)
			'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentY 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			.CurrentY = 0
			.Font = VB6.FontChangeBold(.Font, True)
			'UPGRADE_ISSUE: UserControl 方法 UserControl.Print 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			MyBase.Print(uChartTitle)
			.Font = VB6.FontChangeBold(.Font, False)
			
			.ForeColor = System.Drawing.ColorTranslator.FromOle(uChartSubTitleColor)
			.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints - 2)
			'UPGRADE_ISSUE: UserControl 方法 UserControl.TextWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentX 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			.CurrentX = xMiddle - (.TextWidth(uChartSubTitle) / 2)
			'UPGRADE_ISSUE: UserControl 方法 UserControl.Print 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			MyBase.Print(uChartSubTitle)
			.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints + 2)
			
			If uAxisYOn Then
				.ForeColor = System.Drawing.ColorTranslator.FromOle(uYAxisItemsColor)
				For X = uMinYValue To uMaxYValue
					x1 = uLeftMargin + (2 * VB6.TwipsPerPixelX)
					x2 = VB6.PixelsToTwipsX(.ClientRectangle.Width) - uRightMargin
					y1 = (VB6.PixelsToTwipsY(VB6.PixelsToTwipsY(.ClientRectangle.Height)) - uBottomMargin)
					If uDataType = DT_NEG Then
						y1 = y1 + ((System.Math.Abs(X) - System.Math.Abs(uMinYValue)) * uRowHeight)
					Else
						y1 = y1 - ((X - uMinYValue) * uRowHeight)
					End If
					'UPGRADE_WARNING: Mod 有新行为。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"”
					If (X = uMinYValue) Or (X = uMaxYValue) Or ((X Mod uIntersectMajor) = 0) Then
						If uMajorGridOn Then
							'UPGRADE_ISSUE: UserControl 方法 UserControl.Line 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
							MyBase.Line (x1, y1) - (x2, y1), uMajorGridColor
						End If
						.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints - 2)
						'UPGRADE_ISSUE: UserControl 方法 UserControl.TextWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentX 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.CurrentX = uLeftMargin - .TextWidth(X) - (5 * VB6.TwipsPerPixelX)
						'UPGRADE_ISSUE: UserControl 方法 UserControl.TextHeight 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentY 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.CurrentY = y1 - (.TextHeight("0") / 2)
						'UPGRADE_ISSUE: UserControl 方法 UserControl.Print 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						MyBase.Print(X)
						.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints + 2)
						'UPGRADE_WARNING: Mod 有新行为。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"”
					ElseIf ((uMaxYValue - X) Mod uIntersectMinor = 0) Then 
						If uMinorGridOn Then
						End If
					End If
				Next X
			End If
			
			On Error GoTo 0
			If uContentBorder Then
				'UPGRADE_ISSUE: UserControl 方法 UserControl.Line 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
				MyBase.Line (uLeftMargin, uTopMargin) - (VB6.PixelsToTwipsX(.ClientRectangle.Width) - uRightMargin, VB6.PixelsToTwipsY(VB6.PixelsToTwipsY(.ClientRectangle.Height)) - uBottomMargin), uMajorGridColor, B
			End If
			
			For X = 0 To cItems.Count() - 1
				'UPGRADE_WARNING: 未能解析对象 cItems() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
				'UPGRADE_WARNING: 未能解析对象 oChartItem 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
				oChartItem = cItems.Item(X + 1)
				x1 = (X * uColWidth) + uLeftMargin + (2 * VB6.TwipsPerPixelX) 'increment by 2 pixs.
				x2 = x1 + uColWidth - (2 * VB6.TwipsPerPixelX) 'decrement by 2 pixs.
				If uDataType = DT_POS Then
					sngRowHeight = uRowHeight * (oChartItem.Value - uMinYValue)
					y2 = VB6.PixelsToTwipsY(VB6.PixelsToTwipsY(.ClientRectangle.Height)) - uBottomMargin
					y1 = y2 - sngRowHeight
				ElseIf uDataType = DT_NEG Then 
					sngRowHeight = uRowHeight * (System.Math.Abs(CDbl(oChartItem.Value)) - System.Math.Abs(uMaxYValue))
					y1 = uTopMargin
					y2 = y1 + sngRowHeight
				Else
					sngRowHeight = (-CDbl(oChartItem.Value) * uRowHeight)
					y1 = VB6.PixelsToTwipsY(VB6.PixelsToTwipsY(.ClientRectangle.Height)) - uBottomMargin
					y1 = y1 - uRowHeight * System.Math.Abs(uMinYValue)
					y2 = y1 + sngRowHeight
				End If
				sngRowHeight = System.Math.Abs(sngRowHeight)
				' If y2 < y1 Then Call Swap(y1, y2)
				
				uColumns(X, 0) = y1
				uColumns(X, 1) = y2
				
				If ((uChartType And XC_BAR) = XC_BAR) Or (uChartType And XC_OVAL) = XC_OVAL Or (uChartType And XC_RHOMBUS) = XC_RHOMBUS Or (uChartType And XC_TRAPEZIUM) = XC_TRAPEZIUM Or (uChartType And XC_TRIANGLE) = XC_TRIANGLE Then
					
					sngColWidth = uColWidth * uBarWidthPercentage / 100
					xTemp = x1 + ((uColWidth - sngColWidth) / 2)
					x2 = x2 - ((uColWidth - sngColWidth) / 2)
					'UPGRADE_ISSUE: UserControl 属性 UserControl.DrawWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
					.DrawWidth = uLineWidth
					'UPGRADE_ISSUE: UserControl 属性 UserControl.FillStyle 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
					.FillStyle = uBarFillStyle
					If X = uSelectedColumn And uSelectable Then
						'UPGRADE_ISSUE: UserControl 属性 UserControl.FillColor 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.FillColor = uSelectedBarColor
						If (uChartType And XC_OVAL) = XC_OVAL Then
							'  Call DrawOval(xTemp, x2, y1, y2, sngColWidth, sngRowHeight, uBarColor)
						ElseIf (uChartType And XC_BAR) = XC_BAR Then 
							'   Call DrawRectangle(oChartItem.Value, xTemp, x2, y1, y2, uBarColor, (uMeanOn = True) And (X = cItems.Count - 1))
						ElseIf (uChartType And XC_TRIANGLE) = XC_TRIANGLE Then 
							'  Call DrawTriangle(oChartItem.Value, xTemp, x2, y1, y2)
						ElseIf (uChartType And XC_TRAPEZIUM) = XC_TRAPEZIUM Then 
							Call DrawTrapezium(oChartItem.Value, xTemp, x2, y1, y2)
						ElseIf (uChartType And XC_RHOMBUS) = XC_RHOMBUS Then 
							' Call DrawRhombus(oChartItem.Value, xTemp, x2, y1, y2)
						End If
						'UPGRADE_ISSUE: UserControl 属性 UserControl.DrawWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.DrawWidth = 1
						'UPGRADE_ISSUE: 常量 vbFSTransparent 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"”
						'UPGRADE_ISSUE: UserControl 属性 UserControl.FillStyle 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.FillStyle = vbFSTransparent
						
						
					Else
						If (uMeanOn = True) And (X = cItems.Count() - 1) Then
							'UPGRADE_ISSUE: UserControl 属性 UserControl.FillColor 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
							.FillColor = uMeanColor
						Else
							'UPGRADE_ISSUE: UserControl 属性 UserControl.FillColor 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
							.FillColor = IIf(uColorBars, QBColor(CurrentColor), uBarColor)
						End If
						'UPGRADE_ISSUE: UserControl 属性 UserControl.FillStyle 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.FillStyle = uBarFillStyle
						'UPGRADE_ISSUE: UserControl 属性 UserControl.DrawWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.DrawWidth = uLineWidth
						If (uChartType And XC_OVAL) = XC_OVAL Then
							' Call DrawOval(xTemp, x2, y1, y2, sngColWidth, sngRowHeight, uSelectedBarColor)
						ElseIf (uChartType And XC_BAR) = XC_BAR Then 
						ElseIf (uChartType And XC_TRIANGLE) = XC_TRIANGLE Then 
							'   Call DrawTriangle(oChartItem.Value, xTemp, x2, y1, y2)
						ElseIf (uChartType And XC_TRAPEZIUM) = XC_TRAPEZIUM Then 
							Call DrawTrapezium(oChartItem.Value, xTemp, x2, y1, y2)
						ElseIf (uChartType And XC_RHOMBUS) = XC_RHOMBUS Then 
							'  Call DrawRhombus(oChartItem.Value, xTemp, x2, y1, y2)
						End If
						'UPGRADE_ISSUE: UserControl 属性 UserControl.DrawWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.DrawWidth = 1
						'UPGRADE_ISSUE: 常量 vbFSTransparent 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"”
						'UPGRADE_ISSUE: UserControl 属性 UserControl.FillStyle 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
						.FillStyle = vbFSTransparent
					End If
				End If
				If (uChartType And XC_SYMBOL) = XC_SYMBOL Then
					If uDataType = DT_NEG Then
						yTemp = y2
					ElseIf uDataType = DT_POS Then 
						yTemp = y1
					Else
						yTemp = IIf((oChartItem.Value > 0), y1, y2)
					End If
					
					'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentX 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
					.CurrentX = xTemp
					'UPGRADE_ISSUE: UserControl 属性 UserControl.CurrentY 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
					.CurrentY = yTemp
					.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints + 2)
					.Font = VB6.FontChangeSize(.Font, .Font.SizeInPoints - 2)
				End If
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -