?? frmclock.frm
字號:
VERSION 5.00
Begin VB.Form Frmpic
BorderStyle = 1 'Fixed Single
Caption = "小小收支薄-折線式圖示"
ClientHeight = 6675
ClientLeft = 45
ClientTop = 330
ClientWidth = 8790
DrawMode = 2 'Blackness
FillColor = &H00FFFFFF&
ForeColor = &H00400000&
Icon = "frmclock.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6675
ScaleWidth = 8790
StartUpPosition = 2 'CenterScreen
Begin VB.CheckBox Check1
Caption = "Check1"
Height = 270
Index = 0
Left = 7665
TabIndex = 2
Top = 60
Width = 1080
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 540
Left = 6225
TabIndex = 1
Top = 5985
Width = 1215
Begin VB.CheckBox Check2
Caption = "顯示數值"
Height = 270
Left = 90
TabIndex = 3
Top = 195
Value = 1 'Checked
Width = 1080
End
End
Begin VB.CommandButton Compic
BackColor = &H80000012&
Caption = "作圖"
Height = 420
Left = 570
TabIndex = 0
Top = 6090
Width = 1215
End
Begin VB.Label Label3
Caption = "X軸單位：月---Y軸單位：元"
Height = 195
Left = 2865
TabIndex = 6
Top = 6345
Width = 2475
End
Begin VB.Label Label2
Caption = "Label2"
BeginProperty Font
Name = "幼圓"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 345
Left = 2370
TabIndex = 5
Top = 5790
Width = 3585
End
Begin VB.Label Label1
Caption = "圖例"
BeginProperty Font
Name = "宋體"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 7830
TabIndex = 4
Top = 150
Width = 765
End
Begin VB.Line Line1
Index = 0
X1 = 7650
X2 = 8700
Y1 = 315
Y2 = 315
End
End
Attribute VB_Name = "Frmpic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim db As Database
Dim re As Recordset
Dim a1(11, 14) As Single, es(14) As Single, max(14) As Single
Private Sub Compic_Click()
Dim n As Integer, m As Integer
Dim i As Integer, j As Integer
Dim mas As Single
Cls
Compic.Caption = "刷新"
Line (0, 5500)-(7500, 5500), RGB(255, 255, 255) 'X軸
Line (0, 5500)-(7500, 5500), RGB(0, 0, 0)
Line (450, 0)-(450, 5500), RGB(255, 255, 255) 'Y軸
Line (450, 0)-(450, 5500), RGB(0, 0, 0) 'Y軸
For i = 1 To 12
CurrentX = 450 + 600 * (i - 1) '每間隔460緹作一個月的點
CurrentY = 5600
Print CStr(i)
Next i
re.MoveLast
m = Month(re.Fields(0))
re.MoveFirst '到有結算的頭一個月
n = Month(re.Fields(0))
mas = 0 '所選取字段中的最大值
For i = 1 To 14
If Check1(i).Value = 1 And max(i) > 0 Then
If max(i) > mas Then mas = max(i) '得到所選取字段中的最大值
End If
Next i
If mas = 0 Then Exit Sub
For i = 0 To 9
CurrentX = 100
CurrentY = (5500 / 10) * i
'5500緹分10份,每份為MAS的 1/10
Print Format((10 - i) * mas / 10, "######.##")
Next i
For i = 0 To 9
CurrentY = (5500 / 10) * i
Line (0, CurrentY)-(7500, CurrentY), RGB(255, 255, 255) 'X軸
Line (0, CurrentY)-(7500, CurrentY), RGB(0, 0, 0) 'X軸
Next i
For i = 1 To 11
CurrentX = 450 + i * 600
Line (CurrentX, 0)-(CurrentX, 5500), RGB(255, 255, 255) 'Y軸
Line (CurrentX, 0)-(CurrentX, 5500), RGB(0, 0, 0) 'Y軸
Next i
For j = 1 To 14
If Check1(j).Value = 1 Then
For i = n - 1 To m - 2
'(5500 * a1(i, j)/ mas 得到根據MAS調整比率的正確的Y軸值,用5500減是因為表單Y軸從上往下遞增.
'DrawWidth = (Int(j / 5) + 1) * 2.5
Line (450 + i * 600, 5500 - (5500 * a1(i, j)) / mas)-(450 + (i + 1) * 600, 5500 - (5500 * a1(i + 1, j)) / mas), Check1(j).ForeColor
Line (450 + i * 600, 5500 - (5500 * a1(i, j)) / mas)-(450 + (i + 1) * 600, 5500 - (5500 * a1(i + 1, j)) / mas), Not Check1(j).ForeColor
If Check2.Value = 1 Then
CurrentX = 450 + i * 600
CurrentY = 5500 - (5500 * a1(i, j)) / mas
Print a1(i, j)
End If
Next i
If Check2.Value = 1 Then
CurrentX = 450 + i * 600
CurrentY = 5500 - (5500 * a1(i, j)) / mas
Print a1(i, j)
End If
End If
Next j
DrawWidth = 1
End Sub
Private Sub Form_Load()
Set db = OpenDatabase(App.Path + "\zb.mdb")
Set re = db.OpenRecordset("select * from yzj where year(年月)='" + frmxb.myyear + "' order by 年月")
Dim i As Integer
Dim j As Integer
Dim remax As Recordset
For i = 1 To 14
Set remax = db.OpenRecordset("select max(" + re.Fields(i).Name + ") from yzj")
max(i) = remax.Fields(0) '取得每個字段的最大值
Next i
re.MoveFirst
re.MoveLast
i = re.RecordCount
Label2.Caption = Str(year(re.Fields(0))) + "年1--12月折線圖"
es(1) = RGB(0, 0, 0)
es(2) = RGB(0, 0, 255)
es(3) = RGB(0, 255, 0)
es(4) = RGB(0, 255, 255)
es(5) = RGB(255, 0, 0)
es(6) = RGB(255, 0, 255)
es(7) = RGB(255, 255, 0)
es(8) = RGB(255, 255, 255)
es(9) = RGB(255, 125, 125)
es(10) = RGB(125, 0, 0)
es(11) = RGB(0, 125, 0)
es(12) = RGB(0, 0, 125)
es(13) = RGB(255, 0, 125)
es(14) = RGB(125, 155, 0)
For i = 0 To 11
For j = 0 To 14
a1(i, j) = 0
Next j
Next i
Dim lastm As Byte, frism As Byte
re.MoveLast
lastm = Month(re.Fields(0))
re.MoveFirst
frism = Month(re.Fields(0))
For i = frism - 1 To lastm - 1
For j = 1 To 14
a1(i, j) = re.Fields(j)
Next j
re.MoveNext
Next i
For j = 1 To 14
Load Check1(j)
Load Line1(j)
Check1(j).Caption = re.Fields(j).Name
Check1(j).Visible = True
Check1(j).Left = Check1(0).Left
Check1(j).Top = 400 * j + 65
Line1(j).X1 = Line1(0).X1
Line1(j).X2 = Line1(0).X2
Line1(j).Y1 = Line1(0).Y1 + 400 * j + 65
Line1(j).Y2 = Line1(j).Y1
Line1(j).Visible = True
'Line1(j).BorderWidth = (Int(j / 5) + 1) * 1.5
'Line1(j).BorderStyle = Int(j / 5) + 1
Line1(j).BorderColor = es(j)
Check1(j).ForeColor = es(j)
Next j
Line1(0).Visible = False
Check1(0).Visible = False
'Me.ScaleMode = 6
Me.ScaleLeft = 0
Me.ScaleTop = 0
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -