frmdiagram.frm

采用vb编写的利用循环神经网络来预测股票走势的源程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmDiagram 
   Caption         =   "Create time series data from a diagram"
   ClientHeight    =   8070
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   8190
   LinkTopic       =   "Form1"
   ScaleHeight     =   8070
   ScaleWidth      =   8190
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdSaveData 
      Caption         =   "Save"
      Height          =   375
      Left            =   5520
      TabIndex        =   15
      Top             =   1320
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "Data Coords"
      Height          =   975
      Left            =   1680
      TabIndex        =   10
      Top             =   720
      Width           =   3615
      Begin VB.TextBox txtTimeInterval 
         Height          =   285
         Left            =   2520
         TabIndex        =   16
         Text            =   "1"
         Top             =   240
         Width           =   975
      End
      Begin VB.TextBox txtGraphY 
         Height          =   285
         Left            =   360
         TabIndex        =   12
         Text            =   "0"
         Top             =   600
         Width           =   975
      End
      Begin VB.TextBox txtGraphX 
         Height          =   285
         Left            =   360
         TabIndex        =   11
         Text            =   "0"
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label5 
         Caption         =   "Time Interval:"
         Height          =   255
         Left            =   1440
         TabIndex        =   17
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "Y:"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   600
         Width           =   255
      End
      Begin VB.Label Label3 
         Caption         =   "X:"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Width           =   255
      End
   End
   Begin VB.Frame fraMouseCoords 
      Caption         =   "Mouse Coords"
      Height          =   975
      Left            =   120
      TabIndex        =   5
      Top             =   720
      Width           =   1455
      Begin VB.TextBox txtX 
         Height          =   285
         Left            =   360
         TabIndex        =   7
         Text            =   "0"
         Top             =   240
         Width           =   975
      End
      Begin VB.TextBox txtY 
         Height          =   285
         Left            =   360
         TabIndex        =   6
         Text            =   "0"
         Top             =   600
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "X:"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "Y:"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   600
         Width           =   255
      End
   End
   Begin VB.TextBox txtTestData 
      Height          =   285
      Left            =   120
      TabIndex        =   3
      Top             =   360
      Width           =   5175
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "Delete last point"
      Height          =   375
      Left            =   5520
      TabIndex        =   2
      Top             =   840
      Width           =   1455
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "Clear All"
      Height          =   375
      Left            =   5520
      TabIndex        =   1
      Top             =   360
      Width           =   1455
   End
   Begin VB.PictureBox picDiagram 
      Height          =   6015
      Left            =   120
      ScaleHeight     =   5955
      ScaleWidth      =   7875
      TabIndex        =   0
      Top             =   1920
      Width           =   7935
   End
   Begin MSComDlg.CommonDialog Dialog 
      Left            =   480
      Top             =   2520
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "Data set filename"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1335
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Begin VB.Menu mnuOpenDiagram 
         Caption         =   "Open Diagram"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "Save"
      End
      Begin VB.Menu mnuClose 
         Caption         =   "Close"
      End
   End
End
Attribute VB_Name = "frmDiagram"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim noOfPoints As Integer
Dim GraphPoint(3000, 4) As Single
Dim p(3000) As Single

Dim mouse_x As Single
Dim mouse_y As Single
Dim SelectedPoint As Integer




Private Sub cmdClear_Click()
  Dim i As Integer
  noOfPoints = 0
  Call showSeries(picDiagram)
  For i = 0 To 3000
    GraphPoint(i, 3) = 0
    GraphPoint(i, 4) = 0
  Next
End Sub

Private Sub cmdDelete_Click()
  noOfPoints = noOfPoints - 1
  If (noOfPoints < 0) Then
    noOfPoints = 0
  End If
  Call showSeries(picDiagram)
End Sub

Private Sub cmdSaveData_Click()
  Call saveSeries(App.Path & "\" & txtTestData, CSng(txtTimeInterval))
End Sub

Private Sub Form_Load()
  picDiagram.ScaleWidth = 1000
  picDiagram.ScaleHeight = 1000
  Call cmdClear_Click
End Sub

Private Sub mnuClose_Click()
  Unload frmDiagram
End Sub

Private Sub mnuOpenDiagram_Click()

  Dialog.Filter = "JPEG Files|*.JPG|GIF Files|*.GIF|Bitmaps|*.BMP"
  Dialog.InitDir = App.Path
  Dialog.FilterIndex = 1
  Dialog.ShowOpen
  If (Dialog.filename <> "") Then
    picDiagram.Picture = LoadPicture(Dialog.filename)
  End If
  
End Sub

Public Sub showSeries(canvas As PictureBox)
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim c As Long
  Dim scalex As Single
  Dim scaley As Single
  Dim prev_x As Single
  Dim prev_y As Single
  
  scalex = canvas.ScaleWidth / width
  scaley = canvas.ScaleHeight / height
  
  canvas.Cls
  canvas.FillStyle = 0
  canvas.FillColor = RGB(0, 255, 0)
  c = RGB(0, 255, 0)
  canvas.ForeColor = c
  For i = 0 To noOfPoints - 1
    x = GraphPoint(i, 0)
    y = GraphPoint(i, 1)
    If (i > 0) Then
      canvas.Line (x, y)-(prev_x, prev_y), c
    End If
    If (i <> SelectedPoint) Then
      canvas.Circle (x, y), 3, RGB(0, 255, 0)
      Else
      canvas.Circle (x, y), 3, RGB(255, 0, 0)
    End If
    prev_x = x
    prev_y = y
  Next
  txtGraphX = GraphPoint(SelectedPoint, 2)
  txtGraphY = GraphPoint(SelectedPoint, 3)
  
End Sub


Private Sub mnuSave_Click()
  Call saveSeries(App.Path & "\" & txtTestData, CSng(txtTimeInterval))
End Sub

Private Sub picDiagram_Click()
  On Error GoTo picDiagram_Click_err
  
  Dim i As Integer
  Dim Dist As Single
  Dim minDist As Single
  Dim dx As Single
  Dim dy As Single
  
  GraphPoint(SelectedPoint, 2) = CSng(txtGraphX)
  GraphPoint(SelectedPoint, 3) = CSng(txtGraphY)
  
  SelectedPoint = 0
  minDist = 9999
  For i = 0 To noOfPoints - 1
    dx = mouse_x - GraphPoint(i, 0)
    dy = mouse_y - GraphPoint(i, 1)
    Dist = Sqr((dx * dx) + (dy * dy))
    If (Dist < minDist) Then
      minDist = Dist
      SelectedPoint = i
    End If
  Next
  Call showSeries(picDiagram)
  
picDiagram_Click_exit:
  Exit Sub
picDiagram_Click_err:
  MsgBox "frmDiagram/picDiagram_Click/" & Err & "/" & Error$(Err)
  Resume picDiagram_Click_exit
End Sub



Private Sub picDiagram_DblClick()
  Dim storePoint As Boolean

  storePoint = False
  If (noOfPoints > 0) Then
    If (mouse_x > GraphPoint(noOfPoints - 1, 0)) Then
      storePoint = True
    End If
    Else
    storePoint = True
  End If
  
  If (storePoint) Then
    GraphPoint(noOfPoints, 0) = mouse_x
    GraphPoint(noOfPoints, 1) = mouse_y
    SelectedPoint = noOfPoints
    noOfPoints = noOfPoints + 1
    Call showSeries(picDiagram)
  End If
End Sub


Private Sub picDiagram_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  mouse_x = x
  mouse_y = y
  txtX = x
  txtY = y
End Sub




Private Sub txtGraphX_KeyPress(KeyAscii As Integer)
  If (KeyAscii = 13) Then
    GraphPoint(SelectedPoint, 2) = CSng(txtGraphX)
  End If
End Sub



Private Sub txtGraphY_KeyPress(KeyAscii As Integer)
  If (KeyAscii = 13) Then
    GraphPoint(SelectedPoint, 3) = CSng(txtGraphY)
  End If
End Sub



Private Function Calibrate() As Boolean
  Dim i As Integer
  Dim j As Integer
  Dim x(4) As Single
  Dim y(4) As Single
  Dim dx As Single
  Dim dy As Single
  Dim scale_x As Single
  Dim scale_y As Single
  
  Calibrate = False
  j = 0
  i = 0
  While (i < noOfPoints) And (j < 2)
    If (GraphPoint(i, 2) <> 0) Or (GraphPoint(i, 3) <> 0) Then
      x(j) = GraphPoint(i, 0)
      y(j) = GraphPoint(i, 1)
      x(j + 2) = GraphPoint(i, 2)
      y(j + 2) = GraphPoint(i, 3)
      j = j + 1
    End If
    i = i + 1
  Wend
   
  If (j = 2) Then
    Calibrate = True
    dx = x(3) - x(2)
    dy = y(3) - y(2)
    If ((x(1) - x(0)) <> 0) Then
      scale_x = dx / (x(1) - x(0))
    End If
    If ((y(1) - y(0)) <> 0) Then
      scale_y = dy / (y(1) - y(0))
    End If
    
    If (scale_x <> 0) And (scale_y <> 0) Then
      For i = 0 To noOfPoints - 1
        If (GraphPoint(i, 2) = 0) And (GraphPoint(i, 3) = 0) Then
          dx = GraphPoint(i, 0) - x(0)
          dy = GraphPoint(i, 1) - y(0)
          GraphPoint(i, 2) = (dx * scale_x) + x(2)
          GraphPoint(i, 3) = (dy * scale_y) + y(2)
        End If
      Next
    End If
  End If
  
End Function



Private Function getPointValue(t As Single) As Single
  Dim i As Integer
  Dim dx As Single
  Dim dy As Single
  Dim Dist As Single
  Dim y As Single
  Dim ang As Single

  getPointValue = 0
  i = 0
  While (i < noOfPoints) And (GraphPoint(i, 2) < t)
    i = i + 1
  Wend

  If (i < noOfPoints) Then
    If (i > 0) Then
      dx = GraphPoint(i, 2) - GraphPoint(i - 1, 2)
      dy = GraphPoint(i, 3) - GraphPoint(i - 1, 3)
      Dist = Sqr((dx * dx) + (dy * dy))
      If (Dist > 0) Then
        ang = Acos(dx / Dist)
        If (dy < 0) Then
          ang = (2 * 3.1415927) - ang
        End If
      End If
      getPointValue = GraphPoint(i - 1, 3) + ((t - GraphPoint(i - 1, 2)) * Tan(ang))
      Else
      getPointValue = GraphPoint(i, 3)
    End If
  End If

End Function



Private Sub saveSeries(filename As String, timeStep As Single)
  Dim t As Single
  Dim i As Integer
  Dim FileNumber As Integer
  
  If (filename <> "") Then
    If (noOfPoints > 0) Then
      If (Calibrate()) Then
  
        FileNumber = FreeFile
        Open filename For Output As #FileNumber
        
        For t = GraphPoint(0, 2) To GraphPoint(noOfPoints - 1, 2) Step timeStep
          Print #FileNumber, t & " , " & getPointValue(t)
        Next
        
        'For i = 0 To noOfPoints - 1
        '  Print #fileNumber, GraphPoint(i, 2) & " " & GraphPoint(i, 3)
        'Next
        Close #FileNumber
  
        Else
        MsgBox "You must specify at least two sets of data coordinates in order to calibrate the graph", , ""
      End If
      
      Else
      MsgBox "There are no points to be saved!", , ""
    End If
    Else
    MsgBox "Please enter a filename", , ""
    txtTestData.SetFocus
  End If
  
End Sub