競馬ソフトの作り方

艦車　A伊

自作競馬ソフト「オーケー馬２０２１」のプログラムをきれいにする過程を記述します。言語はVB6です。

■2021年6月21日

★6時44分　Private Sub Command54_Click()　ボタンクリックイベントの中に記述したプログラムをきれいにする。

Private Sub Command54_Click()
   MsgBox "start"
   start.Caption = "start / " & Format$(Now, "hhnnss")
   start.Refresh
   DoEvents
   
   Command54.Enabled = False
   DoEvents
   
   gTosu = CInt(tosu.Text)
   
   Dim fromPnt As Integer
   Dim ToPnt As Integer
   Dim PntIdx As Long
   Dim a As Boolean
   Dim phase As String
   
   fromPnt = CInt(txtCnd(0).Text)
   ToPnt = CInt(txtCnd(1).Text)
   
   'readUMA_Cmpi
   Call readUMA_Cmpi
   
   Call patF2ramEx                         '18 only
   
   For PntIdx = fromPnt To ToPnt
       
       gExist = False
       
       'make csv
       phase = "makeCSV"
       Call sleepRefresh(PntIdx, phase)
       Call makeCSV(PntIdx)
       
       If gExist = True Then
           'DB delete
           phase = "deleteDB"
           Call sleepRefresh(PntIdx, phase)
           Call deleteDB
           
           'DB import
           phase = "insertDB"
           Call sleepRefresh(PntIdx, phase)
           Call insertDB(PntIdx)
           
           phase = "compactDBplus"
           Call sleepRefresh(PntIdx, phase)
           Call compactDBplus
           
           'recipe
           phase = "recipeOutput"
           Call sleepRefresh(PntIdx, phase)
           Call recipeOutput(PntIdx)
           
           If gExist = True Then
               'bin
               phase = "txt2bin"
               Call sleepRefresh(PntIdx, phase)
               Call txt2bin(PntIdx)
               
               '7zip a
               phase = "SendToZIP"
               Call sleepRefresh(PntIdx, phase)
               a = SendToZIP(datCmpiFilename(gTosu, PntIdx) & ".bin", datCmpiFilename(gTosu, PntIdx) & ".zip")
           
               phase = "Kill"
               Call sleepRefresh(PntIdx, phase)
               Kill (datCmpiFilename(gTosu, PntIdx) & ".bin")
           End If
       Else
           Kill (datCmpiFilename(gTosu, PntIdx) & ".txt")
       End If
   Next PntIdx

   Command54.Enabled = True
   MsgBox "finish"
End Sub

上記のボタンクリックイベントの中身を別の関数にする。

Private Sub autoMake()
   MsgBox "start"
   start.Caption = "start / " & Format$(Now, "hhnnss")
   start.Refresh
   DoEvents
   
   Command54.Enabled = False
   DoEvents
   
   gTosu = CInt(tosu.Text)
   
   Dim fromPnt As Integer
   Dim ToPnt As Integer
   Dim PntIdx As Long
   Dim a As Boolean
   Dim phase As String
   
   fromPnt = CInt(txtCnd(0).Text)
   ToPnt = CInt(txtCnd(1).Text)
   
   'readUMA_Cmpi
   Call readUMA_Cmpi
   
   Call patF2ramEx                         '18 only
   
   For PntIdx = fromPnt To ToPnt
       
       gExist = False
       
       'make csv
       phase = "makeCSV"
       Call sleepRefresh(PntIdx, phase)
       Call makeCSV(PntIdx)
       
       If gExist = True Then
           'DB delete
           phase = "deleteDB"
           Call sleepRefresh(PntIdx, phase)
           Call deleteDB
           
           'DB import
           phase = "insertDB"
           Call sleepRefresh(PntIdx, phase)
           Call insertDB(PntIdx)
           
           phase = "compactDBplus"
           Call sleepRefresh(PntIdx, phase)
           Call compactDBplus
           
           'recipe
           phase = "recipeOutput"
           Call sleepRefresh(PntIdx, phase)
           Call recipeOutput(PntIdx)
           
           If gExist = True Then
               'bin
               phase = "txt2bin"
               Call sleepRefresh(PntIdx, phase)
               Call txt2bin(PntIdx)
               
               '7zip a
               phase = "SendToZIP"
               Call sleepRefresh(PntIdx, phase)
               a = SendToZIP(datCmpiFilename(gTosu, PntIdx) & ".bin", datCmpiFilename(gTosu, PntIdx) & ".zip")
           
               phase = "Kill"
               Call sleepRefresh(PntIdx, phase)
               Kill (datCmpiFilename(gTosu, PntIdx) & ".bin")
           End If
       Else
           Kill (datCmpiFilename(gTosu, PntIdx) & ".txt")
       End If
   Next PntIdx

   Command54.Enabled = True
   MsgBox "finish"
End Sub

きれいにする過程では、プログラムの間違いが発生することもありえるの。だから、プログラムを変更するたびに、同じ動作をするか、確認するテストを行うべし。

Private Sub Command54_Click()
   Call autoMake
End Sub

ボタンを押したら、関数が呼ばれる。つまり、画面のイベント処理とロジックが分離されたことになる。できるだけ細かく分ける。

    MsgBox "start"

"start"という文字列が書かれてる。プログラム中は、できるだけ、固有の文字列や数値は書かないようにする。たとえば、startひとつとっても、別の箇所のstartと同じ意味とは限らないからな。

Public Const GC_START_AUTOMAKE = "start"

とりあえず、定数にした。

    MsgBox GC_START_AUTOMAKE

こんな感じになる。

    MsgBox GC_START_AUTOMAKE
   start.Caption = GC_START_AUTOMAKE & GC_SLASH & Format$(Now, GC_TIMEFORMAT)

こんな感じ。でも、ちょっと、気になる点があるね。MsgBoxやstartラベルコントロールは画面関係だね。だから、これらは、ロジックには存在しない方が良いだろう。

Private Sub Command54_Click()
   MsgBox GC_START_AUTOMAKE
   start.Caption = GC_START_AUTOMAKE & GC_SLASH & Format$(Now, GC_TIMEFORMAT)
   start.Refresh
   DoEvents
   
   Command54.Enabled = False
   DoEvents
   
   Call autoMake
End Sub

こういう感じ。

    gTosu = CInt(tosu.Text)

tosu.Textも画面コントロールだよな。これもなんとかしないとね。馬の頭数を知りたいんだね。頭数情報は画面からの入力だから、関数に頭数を渡してあげればいいだろうね。

Private Sub Command54_Click()
   MsgBox GC_START_AUTOMAKE
   start.Caption = GC_START_AUTOMAKE & GC_SLASH & Format$(Now, GC_TIMEFORMAT)
   start.Refresh
   DoEvents
   
   Command54.Enabled = False
   DoEvents
   
   Call autoMake(CInt(tosu.Text))
End Sub

Private Sub autoMake(tosu As Integer)
   
   gTosu = tosu

これで、頭数が画面からロジックに渡された。画面の入力情報を数値型に変換して渡してる。これって、数値以外の文字が入力されたら、どうなるの？当然、エラーになるよね。なので、関数を呼ぶ前に、ガード処理が必要になる。

    If IsNumeric(tosu.Text) Then
       Call autoMake(CInt(tosu.Text))
   Else
       MsgBox "error!"
   End If

数値かどうかを判定して、数値なら、OK。数値以外なら、エラーにした。エラーの文字列も、何がエラーなのか、わかるようにしないとね。

    fromPnt = CInt(txtCnd(0).Text)
   ToPnt = CInt(txtCnd(1).Text)

こちらも引数で渡すことにする。

    If IsNumeric(tosu.Text) = False Then
       MsgBox GC_ERR_TOSU
       Exit Sub
   End If
   
   If IsNumeric(txtCnd(0).Text) = False Then
       MsgBox GC_ERR_PNT_FROM
       Exit Sub
   End If
   
   If IsNumeric(txtCnd(1).Text) = False Then
       MsgBox GC_ERR_PNT_STOP
       Exit Sub
   End If
   
   Call autoMake(CInt(tosu.Text), CInt(txtCnd(0).Text), CInt(txtCnd(1).Text))
End Sub

Private Sub autoMake(tosu As Integer, fromPnt As Integer, ToPnt As Integer)
   Dim PntIdx As Long
   Dim a As Boolean
   Dim phase As String
   
   gTosu = tosu

エラー判定は、別関数にした方がスッキリするね。そうしよう。

    If checkInputData(tosu.Text, txtCnd(0).Text, txtCnd(1).Text) = False Then
       Exit Sub
   End If
   
   Call autoMake(CInt(tosu.Text), CInt(txtCnd(0).Text), CInt(txtCnd(1).Text))
End Sub

Private Function checkInputData(tosu As String, fromPnt As String, ToPnt As String) As Boolean
   checkInputData = False
   
   If IsNumeric(tosu) = False Then
       MsgBox GC_ERR_TOSU
       Exit Function
   End If
   
   If IsNumeric(fromPnt) = False Then
       MsgBox GC_ERR_PNT_FROM
       Exit Function
   End If
   
   If IsNumeric(ToPnt) = False Then
       MsgBox GC_ERR_PNT_STOP
       Exit Function
   End If

       checkInputData = True
End Function

チェックするだけの関数ができた。役割がはっきりしているので、テストがしやすくなったよ。

Private Sub Command54_Click()
   Dim tosu As String
   Dim fromPnt As String
   Dim toPnt As String
   
   MsgBox GC_START_AUTOMAKE
   start.Caption = GC_START_AUTOMAKE & GC_SLASH & Format$(Now, GC_TIMEFORMAT)
   start.Refresh
   DoEvents
   
   Command54.Enabled = False
   DoEvents
   
   tosu = tosu.Text
   fromPnt = txtCnd(0).Text
   toPnt = txtCnd(1).Text
   
   If checkInputData(tosu, fromPnt, toPnt) = False Then
       Exit Sub
   End If
   
   Call autoMake(CInt(tosu), CInt(fromPnt), CInt(toPnt))
End Sub

テキストボックスが複数回、登場していたので、変数に入れるようにした。コントロール名の変更などに対応しやすくなるね。変数に入れる部分を関数化したら、もっとよくなる。画面入力情報を変数に入れることで、画面との関係が少なくなり、変更に強くなるはず。

    Call setInputData(tosu, fromPnt, toPnt)
   
   If checkInputData(tosu, fromPnt, toPnt) = False Then
       Exit Sub
   End If
   
   Call autoMake(CInt(tosu), CInt(fromPnt), CInt(toPnt))
End Sub

'画面情報を変数に入れる
Private Sub setInputData(ByRef tosu As String, ByRef fromPnt As String, ByRef toPnt As String)
   tosu = tosu.Text
   fromPnt = txtCnd(0).Text
   toPnt = txtCnd(1).Text
End Sub

こんな感じ。これで、画面のコントロールが変更になったり、別の言語になったりしても、画面情報を変数に入れる関数さえ変更すれば、対応できるね。やったね！では、次は、readUMA_Cmpi関数を見てみよう。

Private Sub readUMA_Cmpi()
   Dim Fn As Integer
   Dim src As String
   Dim lCnt As Long
   Dim data() As String
   Dim wk As String
   Dim idx As Long
   Dim idx2 As Long
   Dim items() As String
   
   src = App.Path & "\UMA_CMPI.txt"
   
   Fn = FreeFile
   Open src For Input As #Fn 
   
   '<<ファイル 読>>
   lCnt = 0
   Do Until EOF(Fn)
       Line Input #Fn , wk
       ReDim Preserve data(lCnt)
       data(lCnt) = wk
       lCnt = lCnt + 1
   Loop
   
   '<<ファイル 閉>>
   Close #Fn 
   
   ReDim umas(UBound(data))
   
   For idx = 0 To UBound(data)
       items = Split(data(idx), ",")
       For idx2 = 0 To UBound(items)
           umas(idx).dat(idx2) = Replace(items(idx2), """", "")
       Next idx2
   Next idx
End Sub

コンピ指数関連の情報が入ってるテキストファイルから情報を変数に入れる処理みたいだね。ここでは、構造体が使われている。どんな構造体かな？

Public umas() As UmaCmpi

なるほど、UmaCmpiという構造体か。

Type UmaCmpi
   dat(54) As String
End Type

なるほど、文字列情報を配列で５５個、持ってる、と。で、その内容は？

Public Enum umaD
   Year = 0
   Monthday
   JyoCd
   Kaiji
   Nichiji
   RaceNum
   C01
   C02
   C03
   C04
   C05
   C06
   C07
   C08
   C09
   C10
   C11
   C12
   C13
   C14
   C15
   C16
   C17
   C18
   U01
   U02
   U03
   U04
   U05
   U06
   U07
   U08
   U09
   U10
   U11
   U12
   U13
   U14
   U15
   U16
   U17
   U18
   HF01
   HF02
   HF03
   HF04
   HF05
   UF01
   UF02
   UF03
   UF04
   UF05
   JyokenCD5
   TrackCD
   TorokuTosu
End Enum

開催日付、場所などの基本情報に、C99がコンピ指数、U99が馬番、JyokenCD5は新馬戦、障害などの情報、TrackCDが芝、ダート、TorokuTosuが登録頭数だね。これらを一気に、読みこむ、と。データは、３６６３５個。約１０年分だよ。データを読みこむこと、データを任意の変数に格納することの２つのことをしている。分離した方がいいね。

■2021年6月23日

★18時40分

Private Sub readTextFile(filename As String, ByRef data() As String)
   Dim Fn As Integer
   Dim lCnt As Long
   Dim wk As String
   
   Fn = FreeFile
   Open filename For Input As #Fn 
   
   lCnt = 0
   Do Until EOF(Fn)
       Line Input #Fn , wk
       ReDim Preserve data(lCnt)
       data(lCnt) = wk
       lCnt = lCnt + 1
   Loop
   
   Close #Fn 
End Sub

Private Sub readUMA_Cmpi()
   Dim data() As String
   Dim idx As Long
   Dim idx2 As Long
   Dim items() As String
   
   Call readTextFile(App.Path & "\UMA_CMPI.txt", data)
   
   ReDim umas(UBound(data))
   
   For idx = 0 To UBound(data)
       items = Split(data(idx), ",")
       For idx2 = 0 To UBound(items)
           umas(idx).dat(idx2) = Replace(items(idx2), """", "")
       Next idx2
   Next idx
End Sub

分割したよ。それでは、次は、関数patF2ramExをきれいにしよう。

Private Sub patF2ramEx()
   Dim data() As String
   Dim wk As String
   Dim wk2 As String
   Dim lCnt(17) As Long
   Dim dat() As String
   Dim i As Integer
   Dim k As Integer
   Dim asci As Integer
   Dim su As Integer
   Dim cntsu As Long
   Dim patF As String
   
   ' 'A'=65 配列の添え字に置換する
   ' 抽出数毎にRAMを用意
   
   Select Case gTosu
   Case 5
   Case 6
   Case 7
   Case 8
       patF = "\pat8.txt"
       ReDim pat18(254)
   Case 9
   Case 10
   Case 11
   Case 12
   Case 13
   Case 14
   Case 15
   Case 16
       patF = "\pat16.txt"
       ReDim pat18(65534)
   Case 17
   Case 18
       patF = "\pat.txt"
       ReDim pat18(262142)
   End Select
   
   Fn = FreeFile
   Open App.Path & patF For Input As #Fn 
   
   Do Until EOF(Fn)
       Line Input #Fn , wk
       
       If wk <> "" Then
           dat = Split(wk, ",")
           
           wk2 = ""
           For i = 0 To UBound(dat)
               asci = Asc(dat(i)) - 65
               wk2 = wk2 & "," & CStr(asci)
           Next i
           
           wk2 = Mid$(wk2, 2)
           
           Select Case gTosu
           Case 5
               pat18(cntsu) = wk2
           Case 6
               pat18(cntsu) = wk2
           Case 7
               pat18(cntsu) = wk2
           Case 8
               pat18(cntsu) = wk2
           Case 9
               pat18(cntsu) = wk2
           Case 10
               pat18(cntsu) = wk2
           Case 11
               pat18(cntsu) = wk2
           Case 12
               pat18(cntsu) = wk2
           Case 13
               pat18(cntsu) = wk2
           Case 14
               pat18(cntsu) = wk2
           Case 15
               pat18(cntsu) = wk2
           Case 16
               pat18(cntsu) = wk2
           Case 17
               pat18(cntsu) = wk2
           Case 18
               pat18(cntsu) = wk2
           End Select
           cntsu = cntsu + 1
       End If
   Loop
   
   Close #Fn 
End Sub

ファイルを読み込む箇所と変数に入れる箇所がひとつになってる・・・。別々にした方がテストがしやすいね。そうしよう。

Private Sub patF2ramEx()
   Dim data() As String
   Dim wk2 As String
   Dim dat() As String
   Dim i As Integer
   Dim asci As Integer
   Dim cntsu As Long
   Dim patF As String
   Dim idx As Long
   
   ' 'A'=65 配列の添え字に置換する
   ' 抽出数毎にRAMを用意
   
   Select Case gTosu
   Case 5
   Case 6
   Case 7
   Case 8
       patF = "\pat8.txt"
       ReDim pat18(254)
   Case 9
   Case 10
   Case 11
   Case 12
   Case 13
   Case 14
   Case 15
   Case 16
       patF = "\pat16.txt"
       ReDim pat18(65534)
   Case 17
   Case 18
       patF = "\pat.txt"
       ReDim pat18(262142)
   End Select
   
   Call readTextFile(App.Path & patF, data)
   
   For idx = 0 To UBound(data)
       If data(idx) <> "" Then
           dat = Split(data(idx), ",")
           
           wk2 = ""
           For i = 0 To UBound(dat)
               asci = Asc(dat(i)) - 65
               wk2 = wk2 & "," & CStr(asci)
           Next i
           
           pat18(cntsu) = Mid$(wk2, 2)
           cntsu = cntsu + 1
       End If
   Next idx
   
End Sub

この記事が気に入ったらサポートをしてみませんか？