Forex Trading System- Visual Basic source code for forex traders

Option Explicit

Global Const MAX_QUOTES = 8000
Global Const MAX_CLOSES = MAX_QUOTES * 4
Global Const UP = 1
Global Const DOWN = -1
Global Const vbLightGray = &HC0C0C0
Global Const vbGray = &H808080
Global Const vbLightYellow = &HC0FFFF

Type QUOTE_TYPE
Date As String
Time As String
O As Double
H As Double
L As Double
C As Double
U As Double
D As Double
End Type
331
Global NumQuotes As Long
Global NumCloses As Long
Global NumColumns As Long
Global Pair$, StartDate$, EndDate$
Global BoxSize As Double, RevAmt As Double
Global Q(MAX_QUOTES) As QUOTE_TYPE
Global C(MAX_QUOTES) As Double
Global Column(MAX_CLOSES) As Integer

Public Function CalculateColumns(C#(), NumCloses&, BoxSize#, RevAmt#) As Integer
Dim i&, col&, start#, last#, direction%

On Error GoTo Err_CalculateColumns

' initialize the global column array

For i = 1 To NumCloses
Column(i) = 0
Next i
last = C(1)

' calculate first value of column array

For i = 2 To NumCloses
If C(i) - last >= RevAmt * BoxSize Then
Do
If last + BoxSize > C(i) Then
Exit Do
End If
last = last + BoxSize
Column(1) = Column(1) + 1
Loop
direction = UP
start = i + 1
Exit For
ElseIf last - C(i) >= RevAmt * BoxSize Then
Do
If last - BoxSize < C(i) Then
Exit Do
End If
last = last - BoxSize
Column(1) = Column(1) - 1
Loop
332
INNTRODU C
direction = DOWN
start = i + 1
Exit For
Else
' Do nothing if Q(i).C = Q(1).C
End If
Next i

' loop through remainder of closes filling the column array

col = 1
For i = start To NumCloses
If direction = UP Then
If C(i) - last >= BoxSize Then
Do
If last + BoxSize > C(i) Then
Exit Do
End If
last = last + BoxSize
Column(col) = Column(col) + 1
Loop
ElseIf last - C(i) >= RevAmt * BoxSize Then
col = col + 1
Do
If last - BoxSize < C(i) Then
Exit Do
End If
last = last - BoxSize
Column(col) = Column(col) - 1
Loop
direction = DOWN
End If
ElseIf direction = DOWN Then
If last - C(i) >= BoxSize Then
Do
If last - BoxSize < C(i) Then
Exit Do
End If
last = last - BoxSize
Column(col) = Column(col) - 1
Loop
ElseIf C(i) - last >= RevAmt * BoxSize Then
col = col + 1
Visual Basic Source Code (Point and Figure)
333
Do
If last + BoxSize > C(i) Then
Exit Do
End If
last = last + BoxSize
Column(col) = Column(col) + 1
Loop
direction = UP
End If
End If
Next i
CalculateColumns = col
Exit Function
Err_CalculateColumns:
MsgBox Err.Description
End Function

Public Sub PlotPafChart(obj As Object)
Dim Xinc# ' width of each graph paper square in twips
Dim Yinc# ' height of each graph paper square in twips
Dim Xmrg# ' left margin of plotting zone
Dim Ymrg# ' top margin of plotting zone
Dim PipFactor# ' converts prices to integers, ie, 10000 for EURUSD
Dim Fmt$ ' format string for PipFactor
Dim dnum# ' floating point loop index
Dim st$ ' local discard string
Dim i&, j& ' integer loop indexes
Dim max# ' maximum high
Dim start# ' first close in raw data
Dim last# ' last plotted X or Y
Dim x1#, x2# ' x-axis coordinates
Dim y1#, y2# ' y-axis coordinates
Dim HdrMrg# ' header margin

On Error GoTo Err_PlotPafChart

' Initialize variables ===============================

Xinc = 150
Yinc = Xinc
Xmrg = 5.5 * Xinc
Ymrg = 10 * Yinc
PipFactor = 100 '10000
334
INNTRODU C
' Plot background graph paper ========================

obj.Cls
For dnum = 0 To obj.Height Step Xinc
obj.Line (0, dnum)-(obj.Width, dnum), vbGray
Next dnum
For dnum = 0 To obj.Width Step Yinc
obj.Line (dnum, 0)-(dnum, obj.Height), vbGray
Next dnum

' Print two-line header ==============================

HdrMrg = 0.21
obj.Line (HdrMrg * obj.Width, 80)-((1# - HdrMrg) * obj.Width, 650), vbLightYellow, BF
For i = 0 To 12
obj.Line (0.21 * obj.Width + i, 100 - i)-(0.79 * obj.Width - i, 650 + i), vbBlack, B
Next i

obj.FontName = ''Times New Roman''
obj.ForeColor = vbBlack
obj.FontSize = 10
obj.FontBold = True
st = ''USDJPY December 2004''
obj.CurrentX = (obj.Width - obj.TextWidth(st)) / 2
obj.CurrentY = 150
obj.Print st

obj.FontSize = 9
st = ''P&F Chart Box Size = '' + CStr(BoxSize) + '' Rev Amt = ''
st = st + CStr(RevAmt) + '' Boxes''
obj.CurrentX = (obj.Width - obj.TextWidth(st)) / 2
obj.Print st

' Find maximum close ====================================

max = 0
For i = 1 To NumCloses
If C(i) > max Then max = C(i)
Next i
' Adjust max to be a multiple of boxsize units from C(1)
' This ensures Xs and Os land in center of squares

last = C(1)
Do
Visual Basic Source Code (Point and Figure)
335
last = last + BoxSize
Loop While last < max
max = last
Debug.Print max

' Print vertical scale ================

x1 = 1
y1 = Yinc * (Ymrg / Yinc - 3)
x2 = Xmrg
y2 = obj.Height - 2 * Yinc
obj.Line (x1, y1)-(x2, y2), vbWhite, BF
obj.FontSize = 8
obj.FontBold = True
i = -1
Do
i = i + 1
dnum = max - i * BoxSize
st = Format(dnum - 0.0001, ''##0.00'')
obj.CurrentX = (Xmrg - obj.TextWidth(st)) / 2
obj.CurrentY = Ymrg + (i - 3) * Yinc + 10
If obj.CurrentY > obj.Height - 3 * Yinc Then Exit Do
obj.Print st
Loop While obj.CurrentY <= 0.98 * obj.Height

' Plot Xs and Os columns =================

last = -4 + (max - C(1)) / BoxSize
For i = 1 To NumColumns
x1 = Xmrg + (i * Xinc)
If Column(i) > 0 Then
For j = 1 To Column(i)
y1 = Ymrg + (last - j + 0.45) * Yinc
PrintX obj, x1, y1, 0.3 * Xinc
Next j
Else
For j = -1 To Column(i) Step -1
y1 = Ymrg + (last - j + 0.45) * Yinc
PrintO obj, x1, y1, 0.3 * Xinc
Next j
End If
last = last - Column(i)
Next i
336
INNTRODU C
Exit Sub
Err_PlotPafChart:
MsgBox Err.Description
Resume
End Sub

Public Sub PrintX(obj As Object, cx#, cy#, side#)
Dim i%
cy = cy + 5
For i = 0 To 15
obj.Line (cx - 0.7 * side + i, cy - side)-(cx + 0.7 * side + i, cy + side), vbBlack
obj.Line (cx + 0.7 * side - i, cy - side)-(cx - 0.7 * side - i, cy + side), vbBlack
Next i
End Sub

Public Sub PrintO(obj As Object, cx#, cy#, radius#)
Dim i%
cy = cy + 5
For i = 0 To 15
obj.Circle (cx + i, cy), radius, vbBlack, , , 1.85
Next i
End Sub