frmclock.frm

小小收支薄是一个用VB写的程序

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
'Download by http://www.codefans.net

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