「馬吉」を移植する場合に、プログラムの内容を変更した部分について御説明します。
2021年の4月に記載内容の見直しを始めましたが、「馬吉」のオープンソース版を参考にして、過去10年間以上に亘って数多くのプログラムを作成しましたが、「馬吉」のオープンソース版の出来の悪さには驚くばかりです。
「馬吉」にはオープンソース版以外に、元々にJRA-VANが公開しているソフトと2種類あるのですが、両者は全く別のプログラムと考えて差支えありません。ここでは元々のプログラムを「本家」と呼ぶとして、オープンソース版は「分家」と呼ぶことにします。
本家のプログラムは、動作が非常に速い事とバグが分家のプログラムと比較すると少ないです。量でいうなら、バグは分家の半分以下でしょうし、手抜きしている部分も分家程はありません。
ただ、残念な事に本家でも競馬を全く知らない人達がプログラムを作成したらしく、「配当番号」を「馬番」と勘違いしたり、競走馬をソートする場合に年齢の多い順から並べたり、競走馬のデータでは「過去の成績」よりも「血統」を重視していたりと、競馬の馬券を買う人から見ると、ピント外れな部分がかなり多いです。
その影響によるからか、このソフトには馬券を購入するための配慮が全く備わっておりません。レースの記録をするだけのソフトなど、競馬ソフトとして役には立ちません。
残念ながら、本家のプログラムのソースは公開されておりませんので、ここでは分家のプログラムについてのみ記載する事に致します。
私のプログラムの技術レベルは、小学校4年生程度と自己評価をしております。このレベルは右も左も分らない幼稚園レベルからようやく卒業できた程度で、幼稚園の園児が作成するプログラムには評価が出来ますが、プロの仲間入りをするにはまだまだの段階です。
「馬吉」オープンソース版(以降は「馬吉」とのみ記載します)は、プログラムの内容から推測して、4、5人で作成したと思われますが、プログラムを作成できる人は3人程度で、残りの人はサポートがやっとのレベルだろうと推察されます。
プログラムを作成する人の中にも、幼稚園レベルの方がいるようで、プロのプログラマーなら絶対に書かないようなソースを作成する人がおります。その典型的な例として、以下のようなソースを取り上げてみました。
' ' 機能: タブのリサイズイベント ' ' 備考: なし ' Private Sub Tab_Resize() On Error GoTo ErrorHandler Dim i As Integer For i = 0 To 4 With paneTab(i) .Top = mstTab.TabHeight + 60 .Left = 60 .width = Bigger(1, mstTab.width - .Left * 2) .Height = Bigger(1, (mstTab.Height - .Top) - (.Top - mstTab.TabHeight)) End With ' fraTab(mstTab.Index) Select Case i Case 0, 3, 4 ' 過去成績, 条件別成績タブ意外は、グリッドを最大に With flexTab(i) .width = Bigger(1, paneTab(i).width - .Left) .Height = Bigger(1, paneTab(i).Height - .Top) End With ' flexTab(i) Case 1 ' 過去成績タブ With flexTab(i) .Top = lblFix.Height .width = Bigger(1, paneTab(i).width - .Left) .Height = Bigger(1, paneTab(i).Height - .Top) lblFix.Top = 0 lblFix.Left = 0 End With Case 2 ' 条件別成績タブ Call ScrollBarManage flexTab(2).Height = 2100 flexTab(2).width = 6650 flexTab(5).Height = 3400 flexTab(5).width = 6650 flexTab(6).Height = 2100 flexTab(6).width = 6650 flexTab(2).Top = 0 flexTab(2).Left = 0 flexTab(5).Top = 0 flexTab(5).Left = flexTab(2).width + 300 flexTab(6).Top = flexTab(2).Height + 300 flexTab(6).Left = 0 With picIPane .width = Bigger(MINIMUMWIDTH, flexTab(5).Left + flexTab(5).width + 200) .Height = Bigger(MINIMUMHEIGHT, flexTab(6).Top + flexTab(6).Height) .width = Bigger(.width, paneTab(2).width - .Left) .Height = Bigger(.Height, paneTab(2).Height - .Top) End With End Select Next i Exit Sub ErrorHandler: gApp.ErrLog End Sub
これはJRA-VANが公開している「馬吉」のオープンソース版の「ctlVUM」の363行目からの内容ですが、小学校4年生レベルの私でも呆れるソースの書き方です。
私はプログラミングの授業を受けた事はありませんが、こんなソースを書いたら教官に怒られるだろうと思います。昨日からプログラムを学び始めた人でも、こん発想で無駄の多いプログラムは書かないでしょう。
私はまともに動かなくて、たまたま見つけただけなのですが、こんな内容が溢れているのですから、「馬吉」のオープンソース版は恐ろしいです。
このソースのどこがまずいのかを判断できない超初心者の方のために、簡単に御説明を致します。
まず、最初に眼につくのは、Select Caseの使い方でしょう。Select Caseと言うのはコードコンバーターのようなコードと実際の名前の変換に使用するのに適しており、if文の代わりに使用したりします。
このソースのように、使用目的が全く意味を成さない用途(何となく使っただけ)には使ってはいけません。ソースの視認性を損ねるだけでなく、使用するメリットがありません。
次に、ループの中にflexTabの位置情報や大きさの記載を行っておりますが、これを5回も行う事になります。こんな無駄な事はプロのプログラマーなら絶対にやりません。素人の方でも(見直せば無駄な処理だと)気がつくでしょう。
特にVB6はプログラムの作成が容易な反面、ブラックボックスの部分が多いので、予想ができない動作をする場合があります。
もし、このような記載をしても、コンパイラの最適化処理で問題が出ないだろうと考えておられるのならセンスを疑われます。いつか必ず痛い目に会います。
次に、このプログラムではpicIPaneと言うピクチャーボックスを作成しておりますが、ピクチャーボックスはpaneTab(2)が既に存在しており、ピクチャーボックスの上に更にピクチャーボックスを作成しております。
どう見廻しても、ピクチャーボックスを2段重ねする必要性は無く、無駄な存在と言えます。私のレベルから見ると、このソースは超初心者が作成しているプログラムにしか見えません。
こんな事を言うと、「お前は何様のつもりだ」と批判を受けるのですが、そのような方には、そのままお返しさせていただきます。確かに(私は)小学校4年生程度のレベルで申し上げておりますが、それでもそれなりの判断なら出来ます。
「馬吉」のデータベースの変更改造に伴って、その他の多くの部分にも変更を加えました。
まず、真っ先に変更を行ったのはレジストリの使用です。
レジストリは安易にいじられない点では便利な事もありますが、一般的にはインストールを行った多くのソフトがレジストリにゴミを残していきます。
特に期限付きの体験版のソフトなどは、アンインストールを行ってもレジストリには情報を残したままにしますので、これらのソフトがレジストリを肥大化させ、OSの動作を不安定にさせる事が珍しくありません。
「馬吉」の公開版もINIファイルが存在するにも関わらずレジストリを使用しており、しかもこの内容を消去する手段を持っておりません。
正式版をインストールしてからアンインストールを行えば公開版のレジストリの内容も消去されるのかも判りませんが、そのような確かな情報がある訳ではありません。
それならば、最初からレジストリを使用しないようなプログラム構成にすれば良い事です。
元々UmakichiDB.ini と言うファイルを使用してバージョン情報などをそれに記載しておりますので、そのファイルに今までレジストリに記録していた内容をそのまま記録させれば済む事です。
せいぜい数十行のファイルをレジストリからINIファイルに移した所で、動作が遅くなるなどの支障が出る事は考えられません。
勿論、INIファイルに移した事で、内容を安易に書き換えられる危険性はありますが、その場合でも動作に致命的な影響を与えないようにソフトで対処すれば済む事です。
レジストリのデータの読み込みと書き込みはクラスモジュールの clsApp に記載してあります。
例えばデータベースの保管ファルダをレジストリから読み出す箇所は以下のようになっております。
' ' 機能: レジストリから、データベース保管フォルダパスの値を取り出す ' ' 備考: 初期値のままの場合、App.Path\DB を返す ' Public Property Get R_DBPath() As String Dim strPath As String If mblnDBPath = False Then strPath = LoadRegSub("Database", "Path", App.Path & "\DB") mstrDBPath = strPath mblnDBPath = True Else strPath = mstrDBPath End If R_DBPath = strPath End Property ' ' 機能: レジストリに、データベース保管フォルダパスの値を保存する ' ' 備考: なし ' Public Property Let R_DBPath(RHS As String) WriteRegSub "Database", "Path", RHS mblnDBPath = False End Property
特にレジストリに記載しなければならない内容でもありませんので、以下のように書き換えました。
' ' 機能: iniファイルから、データベース保管フォルダパスの値を取り出す ' ' 備考: 初期値のままの場合、App.Path\DB を返す ' Public Property Get R_DBPath() As String Dim strPath As String If ReadINI("Database", "Path") = vbNullString Then strPath = App.Path & "\DB" Call WriteINI("Database", "Path", strPath) mstrDBPath = strPath mblnDBPath = True Else strPath = ReadINI("Database", "Path") End If R_DBPath = strPath End Property ' ' 機能: iniファイルに、データベース保管フォルダパスの値を保存する ' ' 備考: なし ' Public Property Let R_DBPath(RHS As String) Call WriteINI("Database", "Path", RHS) mblnDBPath = False End Property
API を使用したINIファイルの読み込みと書き込みなのですが、「馬吉」にも同じ読み込みと書き込みのコード(GetIniData、SetIniData)があるですが、これを使用した場合はバッファ領域を多くとるためかスタック領域が不足してます。と言うエラーが出て動作しませんでしたので、自分が使い慣れているプログラムに変更しました。
これは私のアドインなどのダウンロードソフトで提供しているものと全く同じなので、ここでは内容の説明は省きます。
これを使用した場合は、スタック領域が不足と言うエラーは出ません。
神経質な人はiniファイルの記載内容もチェックするべきだろうと思われるかも知れませんが、私の考え方は個々の内容に不備があっても最後の段階で引っかかれば良いと考えております。
そうしないとエラー処理だけでプログラムが溢れてしまいます。
このクラスモジュールを見て気になったのは、INIファイル名を直接記載している部分が多かった事です。
恐らく10以上はあるだろうと思います。
このようにしている場合は、ファイル名を変更した場合などは、全ての記載場所の変更を行わなければなりませんので非効率的であるばかりでなく、ミスが発生し易くなります。
通常のプロのプログラマーは、このような書き方はしないものですが、この部分はデータの型の記載を誤って書いていたり、解説内容が間違えていたりと素人ぽい感じがしました。
時間に追われて作成したのかも知れません。
私のプログラムの場合は、サブルーチンの呼び出しにINIのファイル名を記載しませんので問題ありません。
この変更によって、プログラムがレジストリを使用する事は一切なくなりました。
この変更によって何より助かったのは、従来のアクセスを使用したデータべース(「馬吉」本来の動作)との比較が楽に出来るようになった事です。
その前までは、レジストリが共用状態になっておりましたので、データベースが存在しないとか色々とトラブルに遭遇しておりました。
スプラッシュの用のフォームが、直接レジストリを呼び出して背景色を得ておりましたが、そこは固定色にしました。
見えるか見えないかも判らない時間で表示されるフォームの背景色などはどうでも良い事です。
そう言えば、このスプラッシュフォームは、アニメーションを行って表示するようにプログラムされておりましたが、私の時代遅れになりつつあるパソコンでも表示される時間は0.5秒以下でアニメーション以前の状態で表示しております。
単なる飾りだけの存在ならば、起動時のスプラッシュフォームの表示は止めるつもりです。
「馬吉」ではエラーハンドラーの書き方が3種類あります。
On Error GoTo ErrorHandlerと言う書き方とOn Error GoTo errH とOn Error GoTo EH 言う書き方です。
プログラマーの好みでしょうから、3種類あると言う事は少なくとも3人の人間が、このプログラムに関わったと言う事でしょう。
どうでも良いような事なのですが、移植を行う場合にはエラーの確認は重要ですから、この部分をコメントアウトしたり解除する事は度々行います。
3種類もあるのでは、エラーハンドラーの検索や置換を行う場合に3回行わなくてはなりません。
この部分は真っ先に統一すべきだと思います。
On Error GoTo ErrorHandler の書き方が多いようですから、そちらに統一した方が良いと思います。
「馬吉」のプログラムには膨大なクラスモジュールがあります。
クラスモジュール化を行うメリットは大きいと思うのですが、個人でプログラムを作成する場合はクラスモジュールを増やすとプログラムの見通しが極端に悪くなります。
良い悪いは別にしてクラスモジュールを統合させる事にしました。
真っ先に行ったのは、clsCodeConverter と clsStringConverter の統合です。
どちらも似たような処理を行っているのですが、なぜか2つに分けられています。
そのためどちらに変換コードが書いてあるのかが不明で、やたら迷う事になります。
2つに分けなければならない理由はあったのでしょうが、深く考えないで統合する事にします。
クラスモジュールで統合するよりも標準モジュールにした統合の方が処理が速くなるような気がするのですが、この比較は時間があった時にやってみる事にします。
変更は clsStringConverter の内容を clsCodeConverter にコピペするだけです。(どちらに統合しても良いでしょうが。)
統合は30秒ぐらいで終わりました。
後は、今まで clsStringConverter を呼んでいた所を clsCodeConverter に変更するだけです。
これも検索して置換すれば良いだけですから、特に手間はかかりません。
余りにも単純に変更処理が終わったので、何かとんでもない問題が待ち受けているような嫌な予感がしました。
幸い、今の所は一つにまとめた事による異常とかは起きていないようです。
【ご注意】
変更は、mSC の記載を mCC にするだけですが、一部のプログラムは mSC ではなくて gSC や sc を使用しています。
私の作成したデータベースを「馬吉」にも使えるようにするにはもう一つ大きな問題点があります。
それは、JRA-VANから提供されるデータはコード化されているデータが多いのですが、私のデータベースに登録する場合は、コード化されている部分を復元してから登録しています。
例えば、競馬場を表すJyoCD の01は札幌競馬場を表しているのですが、私のデータベース内にはJyoCDは01の登録ではなくて札幌と記録されています。
このように復元した内容をデータベースに登録する事で、復元のための処理が必要ありませんので、その分高速に表示できる利点があります。
ただ、「馬吉」のように JyoCD を01 のコードのままでデータベースに保管して、表示箇所によって使い分けている場合は面倒な事になります。
例えば、表示を札幌としたり札幌競馬場としたりSAPPOROと表示するような具合です。
この程度だけなら、私のデータベースで記載されている札幌をコードと考えて変換するだけなので問題は無いのですが、プログラムの中ではJyoCDのが01から10の場合はとか、数値として判断している部分が多々ありますので、これを探し出して変更するのは大変面倒な作業となるのです。
これを解決するためには次のような方法が考えられます。
(1)データベースに記録する内容は復元しないでコードのままとする。
この方法なら、一般的なデータベースソフトとも共通ですから、移植性は良くなりますが折角の高速表示は失われてしまいます。
私のソフトがデータベース作成ソフトなら躊躇なくそうしますが、単なる競馬予想ソフトですから表示の高速性は失いたくありません。
(2)コードと復元したものと2通りをデータベースに記録する。
この方法ならどちらも使えてベストのように思えますが、本来は1つで良いものを2通りも記録するのですから、データベースは肥大化して結局はアクセス速度の低下に繋がります。
無駄なデータはできるだけ記録するべきではないでしょう。
(3)プログラム内で復元データをコード化させて対処する。
「馬吉」のプログラムの内容に合わせて再度コード化させて処理するようにしておけば問題は発生しませんが、あきらかに無駄な処理ですっきりしません。
ただでさえ遅い「馬吉」ですから、無駄な処理は極力避けたいものです。
色々と対策を考えましたが、コードでの使用箇所が極端に多い場合は復元しないでコード化のままでデータベースに記録させる事にしました。
この場合は、無駄ですが復元したデータも一緒に記録させる事にしました。
その他の所では「馬吉」のプログラムの書き直しで対処する事にしました。
おかげで膨大な箇所の変更が必要で、今もって「馬吉」としての完璧な動作を行っておりません。
半分意地(やけくそ)になって作業をやっております。
「馬吉」では独特のコードの書き方をしております。
例えば以下のような書き方です。
' 発走時間 str = "" If rs("HassoTime") <> "0000" Then str = str & " 発走 " & mCC.HHNN2(rs("HassoTime")) & " " Else str = str & " 発走 " End If mstrLabels(10) = str str = "" ' 競走条件 str = str & rs("SyubetuMei") & " " & rs("JyokenCD5") str = str & " " str = str & rs("KigoCD") str = str & " " str = str & rs("JyuryoCD") mstrLabels(3) = str
変数を必ずクリアしてから代入している事と、直接変数に代入しないことと、コードをやたら長くすることです。
これにどんなメリットがあるのか私には判りませんが、私なら以下のように書きます。
' 発走時間 If rs("HassoTime") <> "0000" Then mstrLabels(10) = " 発走 " & mCC.HHNN2(rs("HassoTime")) & " " Else mstrLabels(10) = " 発走 " End If ' 競走条件 mstrLabels(3) = rs("SyubetuMei") & " " & rs("JyokenCD5") & " " & rs("KigoCD") & " " & rs("JyuryoCD")
この書き方で動作がおかしくなるとも思えませんし、コードが見にくいとも思えないからです。
気分的かも知れませんが、この方が処理速度も向上するのではないかと思えるからです。
メモリーの使い方として、変数領域を大きく確保してから値を代入すると言うテクニックがあるようですが、それとも異なるようです。
このようなコードを書く理由は不明ですが、できるだけ自己流に書き直したいと思います。
推定ですが、このようなコードになっているのは、プログラムの変換ツールを使用している感じがします。
昔のコンパイラなどを使うと、このようなコードを吐き出しますから。
今回はデータベースを SQLite にして別プログラムにしております。
従って JRA-VAN からのデータベースへのデータの取り込み関係のプログラムは必要がなくなりました。
「馬吉」では、データベースの処理関係は、clsImport** と言うクラスモジュールで行っておりますので、それを全て削除しました。
この結果、29個のクラスモジュールが必要なくなりましたので、プログラムの見通しはとても良くなってきました。
その他に不要になったフォームや標準モジュール、クラスモジュールを記載します。
(1)frmConfigFirst
(2)frmDBMaintenance
(3)frmDBUpdate
(4)basReg
(5)basSetDataFromByte
(6)clsCreateMDB
(7)clsStringConverter
(8)
インストール関係を別プログラムで行いまうので、標準モジュールの JVLink_Stluct に記載の SetData 関係のコードも削除するする事ができます。
一見モジュール全体を削除できそうに思えるのですが、ここでは構造体を宣言しておりますので、これを移動しないとエラーになります。
又、票数データをデータベースに登録しないで別ファイルにする場合は、削除できるかどうかを検討する必要があります。
老婆心ながら、不要なフォームやモジュールでもいきなり削除をしてしまうと他のプログラムには呼び出しが記載してありますので、コンパイル時や動作中にエラーが発生します。
削除する前に呼び出しをコメントアウトするなりして、動作に支障がない事を十分確認してから削除してください。
又、削除などの大幅な変更をする場合は、削除前のプログラムをバックアップしておく事が大切です。
予期しないエラーが発生して手がつけられなくなった時に、以前の状態に戻す事ができます。
クラスモジュールの clsIViewerState や clsVSNothing も削除できそうなのですが、履歴動作でエラーが出ましたので現在は残しております。
動作を理解できれば、内容を変更するなどして削除できる項目は更に増えると思います。
検索用のKey取得に使用しているクラスモジュールの clsKey*** も13個もありますので、これも変更を加えたいのですが当面はそのままの状態にしています。
これだけでも数多くのフォームやモジュールを削除できましたので、プログラムの見通しは随分と良くなりました。
変更がだんだんと楽になってくるのは、気分が良いものです。
いよいよ、もつれていた糸がふりほどけてきたようです。
「馬吉」では出馬表を表示させるのにデータベースに独自のデータを作成しています。
データベース名は、subRAKaiSel.mdb と言う名前になっています。
JRA-VAN からのデータの入力時にも最後の段階で、このデータを構築しています。
データの構築は数秒で終了するのですが、画面に大きくプログレスバーが出てきたりして目立ちます。
それだけなら何とか我慢ができるのですが、過去の年度の出馬表を表示する場合もこの処理を行っているのです。
1回行えば次はキャッシュデータを使うようになってるので、繰り返したりはしないのですが、あまり気持ちの良いものではありません。
普通の人は、過去の年度の出馬表を見る事などはめったに無いでしょうから気にならないとは思いますが、私は駄目でした。
移植して最初の頃は「馬吉」の通りにしていたのですが、かったるくて「エクセル競馬予想 馬ちゃん」方式に変更しました。
この方式は、JRA-VAN のスケジュールデータに1R〜12Rの項目を追加して、スケジュールを眺めるだけでなくそこからレースを選択できるようにしてあります。
ほとんどの競馬関係のソフトは「馬吉」のように、開催日を最初に選択してからその日のレース内容の画面を表示させてレースを選択するようになっておりますから、目的のレースを表示させるのに2ステップが必要です。
私の方式では1ステップで目的のレースが選択出来ますし、年度で区切らなくても過去の全てのレースを画面上に表示させることができます。
データの構築もデータの取り込み時に自動的に行います。
自分としてはかなり気に入っている方式なので、「馬吉」への採用も躊躇はありませんでした。
表示は特に年度毎に分ける必要はなかったのですが、「馬吉」に合わせて年度毎にしました。
2010年の出馬表でも2000年の出馬表でも瞬時(1秒前後)に表示されますのでとても快適になりました。
「馬吉」は起動時にデータベースが存在しているかどうかを確認しています。
データベースが無ければ動作しないのですから、このチェックを行う事は当たり前の事なのですが、データベースが存在しない場合にデータベースを作成するまでそのルーチンから抜け出せないのには驚きました。
普通ならデータベースが無い場合でも、取りあえずは終了させたい時もある訳ですからプログラムの終了は選択肢の一つには必ず入るべきものでしょう。
今回は特にデータベースを別なものに変える作業をしておりましたので、この無限ループに嵌ったような処理にはあきれると共に苛立ちを感じてしまいました。
真っ先にこの部分は、データベースが無い場合でも終了は選択肢の一つにはいるように修正しました。
この処理は、起動時だけではなくてデータベースフォルダの新規作成や変更時にも行われますので、その部分も書き直す必要があります。
起動時のチェックは、データベースマネージャー(clsDatabaseMgr)のConnectで行っておりますし、データベースの変更や新規作成は、フォームモジュール(frmConfig)内でおこなっております。
変更するコード内容は、データベースがあるかどうかを調べる際に存在しない場合にも終了出来るようにするだけの単純なものです。
「馬吉」には画面の配色を変更する機能があります。
なかなか便利な機能だなと、あらかじめセットされている画面構成にしてみるとデザインセンスの無い私が見ても何だこれはと思うような画面構成です。
一言で言うと目立つ配色をやってみただけの感じで、少なくとも私の感覚ではディフォルト以外は使用する気になれませんでした。
ディフォルトでも、私の安物のディスプレイでは、見づらい画面配色になってしまう部分があります。
配色を選べるカスタマイズと言うのもありますが、選択できる色数も少なくてカラーパレットを表示してみたかっただけのような感じです。
だいたいバックカラーとフォアカラーを変更する程度では、気休め程度ですから本来はフレックスグリッド(FlexGrid)内の配置や配色まで踏み込んで行うべきでしょう。
画面の配色は軽く考えられがちですが、長時間見るだけに非常に重要なものです。
飽きのこない、目も疲れない自然色の配色が好ましいと考えられます。
この配色を見てプログラムを作成した人は、このプログラムは長時間使用したことが無いだろうと感じました。
画面の配色はデザイン的センスが求められますので、私のような人間にはなかなか改良が難しいのですが、時間をかけてじっくりと取り組むべき所でしょう。
売り物のソフトならプログラマーが作成するものではなくて、デザインの専門家が担当して作成する部分です。
当面は配色の関係で、文字が見難い部分だけを色を変えたり、色相を変えて対処したいと思っています。
「馬吉」を使ってみると処理の遅い部分がある事に気が付きます。
特にSQLite を使用している場合は、それが顕著に現れます。
アクセス(Access)よりも高速な筈の SQlite がなぜ遅いのかですが、「馬吉」はIndex の有効な利用やメモリーへの取り込みを積極的に行っているようで結構処理は速いです。
しかし、それでも遅く感じる処理もあります。
例えば、出馬表を表示する場合でも基本情報、血統、過去5走、マイニング、条件別成績、持ちタイム、成績などの項目がありますが、持ちタイムの表示には時間が掛かります。
考えて見れば持ちタイムの表示が遅くなるのは当たり前で、全レース結果の中から同じ馬の同じ距離のレースの競馬場を区別しながら、しかも多くの持ちタイムがある場合にはタイムを比較して、馬場の状態も考慮に入れたりしながら出走馬全ての持ちタイムをピックアップするのですから、速い処理などは出来る筈がありません。
至れり尽くせりのソフトであるターゲットでさえ、個々の馬の持ちタイムは出馬表から見る事は出来ません。(厳密には持ちタイムの定義が難しいですが)
もし、これが「馬吉」の目玉とするのであれば、余りにも処理時間を必要とするので、やり方(表示方法)を考える必要がありそうです。
なぜ、そんな事を考えるのかと言うと処理が遅いので処理途中に別の作業に移る場合も多く、プログラムでそのような場合でも問題が発生しないように十分考慮する必要があるからです。
本来なら、処理途中であるならば別の作業には移れないようにするべきですが、それだと出馬表を表示するだけでも時間が掛かって使い勝手が悪いので、一部の表示関係の処理が終わらない状態でも表示させているようです。
処理時間を意識している典型的なのが過去5走の表示で、表示が一瞬で終わるなら過去10走でも15走でも良いでしょうが、表示に時間が掛かるものだから、わざわざ1走前から選択できるようにしています。
はっきり言って、こんな逃げ腰の方法では無くて少なくとも5走前ぐらいの表示なら一瞬で表示するようにプログラムすべきだろうと思います。
ソフトの動作の安定性を考慮するためにも、遅い処理の対策を考えなければなりません。
発想を原点に戻して、出馬表の表示にそもそも持ちタイムの表示は不可欠なのかどうかを考える必要があるでしょう。
そう考えた場合には、出馬表を見たいと思った時に持ちタイムの比較まで見たいと思う人は少ない筈です。
競馬歴の長い人なら、単純な持ちタイムの比較は競馬予想には余り意味が無い事を知っているからです。
持ちタイムの表示が不要だとは思いませんが、余り意味の無いデータを表示させるために延々と時間の掛かる処理を毎回行う必要があるのかと言う事です。
このような処理は、常時表示の枠から外して選択項目で表示させるべきではないでしょうか。
今回はたまたま持ちタイムの表示でしたが、表示内容を全体的に見直す事によって、「馬吉」はもっとサクサクした動作をするようになると思います。
見たい内容は一瞬で表示され、ちょっと細かな内容の表示は使う人もそれを意識して使用するようなソフトの構成にする事が、使い勝手の良いソフトであると思います。
アクセスの度に、プログレスバーが表示されるようなソフトには別れを告げる(改良する)ようにすべきだと私は思っているのですが間違っておりますでしょうか。
持ちタイムの表示の遅さに再度触れますが、「馬吉」の場合も、持ちタイムの表示は遅くて、2000年からのデータを登録しているのですが、ジャパンカップの出馬表を表示する場合に持ちタイムのタブが使用できる(Enable=True)になるまで10秒程度掛かります。
これは、パソコンの電源を投入直後のメモリーにキャッシュが無い状態ですから一番悪い条件の時です。
10秒待たなければ持ちタイムの確認は出来ませんが、他の部分(基本データや成績データなど)は1,2秒で使用が可能ですから、ストレスはさほど感じません。
SQLite で同様の事をやると何と4分(240秒)近く掛かります。
中央のプログレスバーもトロトロと時々引っかかるような動きをします。
データ量も変わらないのに、この遅さは一体どこにあるのでしょうか。
ここで、持ちタイムについて簡単に説明します。
「馬吉」が行っている持ちタイムは、競走馬が過去に走った全レースの中から、同じ競馬場の同距離と異なる競馬場の同距離の中から、最も早く走ったレースを1つだけ取り上げます。
その時の天候とか馬場状態も一緒に表示しますが、走破タイムが少ないものだけをピックアップしています。
ですから、10歳馬でも過去のもっとも速く走れた時期のタイムが表示されますし、ダートの場合は破走タイムの良くなる重馬場のデータが表示されます。
こんなデータで良いのかどうかはさておいて、全出走馬の過去の全レースの中から、競馬場も考慮しながら同じ距離を比較するのですから、データベースを参照する回数は膨大なものになります。
「馬吉」の場合は。適切なインデックスが作成されておりますので、10秒と言う短い時間で表示されるのだろうと思います。
一方、SQLite は、インデックスが作用していないらしく、データの参照に時間が掛かっていると考えられます。
取りあえず、SQLite も「馬吉」程度の速さを得るためには、どうしたら良いのかかを考えて見る事にしたいと思います。
ちょっと問題がありそうなデータの比較方法については、その後で考える事にいたしましょう。
以下が、「馬吉」の該当部分のプログラムです。
' ' 機能: 持ちタイムグリッドを作る ' ' 備考: なし ' Private Sub DirectMakeData_MochiTime() Const rowOffset As Long = 2 '' データ行オフセット Dim gd As clsGridData Dim strSQL As String Dim lngCP As Long Dim cUA As ADODB.Connection Dim cUB As ADODB.Connection Dim cRA As ADODB.Connection Dim UA As ADODB.Recordset Dim UB As ADODB.Recordset Dim UM As ADODB.Recordset Dim AV As ADODB.Recordset Dim rUA As ADODB.Recordset Dim rUB As ADODB.Recordset Dim rRA As ADODB.Recordset Dim strMinTime As String Dim strYear As String Dim strMonthDay As String Dim strJyoCD As String Dim strKaiji As String Dim strNichiji As String Dim strRaceNum As String Dim strUmaban As String Dim str2MinTime As String Dim str2Year As String Dim str2MonthDay As String Dim str2JyoCD As String Dim str2Kaiji As String Dim str2Nichiji As String Dim str2RaceNum As String Dim str2Umaban As String Dim i As Long Set gd = New clsGridData Set UA = mRS_UMA_RACE_A Set UB = mRS_UMA_RACE_B Set UM = mRS_UMA Set AV = mRS_TORIKESI_JYOGAI Set cUA = New ADODB.Connection Set cUB = New ADODB.Connection Set cRA = New ADODB.Connection Set rUA = New ADODB.Recordset Set rUB = New ADODB.Recordset Set rRA = New ADODB.Recordset cUA.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=" & gApp.R_DBPath & "\subUMA_RACE_A.mdb" cUB.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=" & gApp.R_DBPath & "\subUMA_RACE_B.mdb" cRA.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=" & gApp.R_DBPath & "\subRACE.mdb" rUB.CursorLocation = adUseServer rUB.Open "UMA_RACE_B", cUB, adOpenKeyset, adLockReadOnly, adCmdTableDirect rUB.Index = "PrimaryKey" rRA.CursorLocation = adUseServer rRA.Open "RACE", cRA, adOpenKeyset, adLockReadOnly, adCmdTableDirect rRA.Index = "PrimaryKey" With gd .Rows = 28 + 2 ' 2段ヘッダ .Cols = 3 + (8 * 2) ' 1行目 カラムヘッダ登録 lngCP = 0 .SetItemMatrix 0, lngCP, "枠", "枠番", ">-" .SetItemMatrix 0, lngCP, "番", "馬番", ">-" .SetItemMatrix 0, lngCP, "馬名", , "<-" For i = 0 To 7 .SetItemMatrix 0, lngCP, mCC.KIBJ3(mBuf_RA.id.JyoCD) & " " & mCC.TRCK4(mBuf_RA.TrackCD) & " " & val(mBuf_RA.KYORI) & "m", , "<-" ' 中山 芝 1200m Next i For i = 0 To 7 .SetItemMatrix 0, lngCP, mCC.TRCK4(mBuf_RA.TrackCD) & " " & val(mBuf_RA.KYORI) & "m", , "<-" ' 1200m Next i lngCP = 0 .SetItemMatrix 1, lngCP, "枠", "枠番", ">-" .SetItemMatrix 1, lngCP, "番", "馬番", ">-" .SetItemMatrix 1, lngCP, "馬名", , "<-" For i = 0 To 1 .SetItemMatrix 1, lngCP, "タイム", , ">-" .SetItemMatrix 1, lngCP, "後3F", "後3ハロン", ">-" .SetItemMatrix 1, lngCP, "年月日", , ">-" .SetItemMatrix 1, lngCP, "回場日", , ">-" .SetItemMatrix 1, lngCP, "着", "着順", ">-" .SetItemMatrix 1, lngCP, "異", "異常", "<-" .SetItemMatrix 1, lngCP, "馬場", "馬場状態", "<-" .SetItemMatrix 1, lngCP, "負担", "負担重量", ">-" Next i End With 'gd ' 出走馬ループ i = 0 UA.MoveFirst Do While Not UA.EOF strMinTime = "99999" strYear = "" strMonthDay = "" strJyoCD = "" strKaiji = "" strNichiji = "" strRaceNum = "" strUmaban = "" str2MinTime = "99999" str2Year = "" str2MonthDay = "" str2JyoCD = "" str2Kaiji = "" str2Nichiji = "" str2RaceNum = "" str2Umaban = "" If UA("KettoNum") <> "0000000000" Then 'KettoNumが初期値でないなら rUA.Open "SELECT * FROM UMA_RACE_A WHERE KettoNum='" & UA("KettoNum") & "'", cUA, adOpenKeyset, adLockReadOnly, adCmdText ' 過去レースループ Do While Not rUA.EOF ' バックグラウンド DoEvents If mblnCancelFetching Then Exit Sub End If SafeSeek UM, Array("KettoNum"), Array(UA("KettoNum").value) ' 過去のみ If rUA("Year") & rUA("MonthDay") < (mKey.Year & mKey.MonthDay) Then SafeSeek rRA, Array("Year", "MonthDay", "JyoCD", "Kaiji", "Nichiji", "RaceNum"), _ Array(rUA("Year").value, rUA("MonthDay").value, rUA("JyoCD").value, rUA("Kaiji").value, rUA("Nichiji").value, rUA("RaceNum").value) ' レース情報が存在する場合のみ If Not rRA.EOF Then ' このレースと同じ距離 同じ(芝・ダート・障害)のみ If rRA("Kyori") = mBuf_RA.KYORI And MochiTimeSubSameTrackCD(rRA("TrackCD").value, mBuf_RA.TrackCD) Then SafeSeek rUB, Array("B_Year", "B_MonthDay", "B_JyoCD", "B_RaceNum", "B_Umaban", "B_KettoNum"), _ Array(rUA("Year").value, rUA("MonthDay").value, rUA("JyoCD").value, rUA("RaceNum").value, rUA("Umaban").value, rUA("KettoNum").value) ' 0秒でない場合のみ If rUB("Time") <> 0 Then ' より早いタイムならば If rUB("Time") <= strMinTime Then strMinTime = rUB("Time") strYear = rUA("Year") strMonthDay = rUA("MonthDay") strJyoCD = rUA("JyoCD") strKaiji = rUA("Kaiji") strNichiji = rUA("Nichiji") strRaceNum = rUA("RaceNum") strUmaban = rUA("Umaban") End If ' 場所が同じ場合 If rUA("JyoCD") = mBuf_RA.id.JyoCD Then ' より早いタイムならば If rUB("Time") <= str2MinTime Then str2MinTime = rUB("Time") str2Year = rUA("Year") str2MonthDay = rUA("MonthDay") str2JyoCD = rUA("JyoCD") str2Kaiji = rUA("Kaiji") str2Nichiji = rUA("Nichiji") str2RaceNum = rUA("RaceNum") str2Umaban = rUA("Umaban") End If End If End If ' 0秒でない場合のみ End If ' このレースと同じ距離のみ End If ' レース情報が存在する場合のみ End If ' 過去のみ rUA.MoveNext Loop ' 過去レースループ rUA.Close SafeSeek UB, Array("B_Year", "B_MonthDay", "B_JyoCD", "B_RaceNum", "B_Umaban", "B_KettoNum"), _ Array(UA("Year").value, UA("MonthDay").value, UA("JyoCD").value, UA("RaceNum").value, UA("Umaban").value, UA("KettoNum").value) SafeSeek UM, Array("KettoNum"), Array(UA("KettoNum").value) SafeSeek AV, Array("Year", "MonthDay", "JyoCD", "Kaiji", "Nichiji", "RaceNum", "Umaban"), _ Array(UA("Year").value, UA("MonthDay").value, UA("JyoCD").value, UA("Kaiji").value, UA("Nichiji").value, UA("RaceNum").value, UA("Umaban").value) lngCP = 0 With gd .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(UA("Wakuban"), 2), , ">^", , , gApp.GetWakubanColor(val(UA("Wakuban"))), Contrast(gApp.GetWakubanColor(val(UA("Wakuban")))) .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(UA("Umaban"), 2), , ">^" Call BameiAV(AV, UA, UB, UM, gd, i + rowOffset, lngCP) End With ' 場所&芝&距離 持ちタイム If str2Year <> "" Then strSQL = "SELECT * FROM UMA_RACE_A " strSQL = strSQL & " WHERE [Year]='" & str2Year & "'" strSQL = strSQL & " AND [MonthDay]='" & str2MonthDay & "'" strSQL = strSQL & " AND [JyoCD]='" & str2JyoCD & "'" strSQL = strSQL & " AND [Kaiji]='" & str2Kaiji & "'" strSQL = strSQL & " AND [Nichiji]='" & str2Nichiji & "'" strSQL = strSQL & " AND [RaceNum]='" & str2RaceNum & "'" strSQL = strSQL & " AND [Umaban]='" & str2Umaban & "'" strSQL = strSQL & " AND [KettoNum]='" & UA("KettoNum") & "'" rUA.Open strSQL, cUA, adOpenKeyset, adLockReadOnly, adCmdText rUB.Seek Array(rUA("Year"), rUA("MonthDay"), rUA("JyoCD"), rUA("RaceNum"), rUA("Umaban"), rUA("KettoNum")) rRA.Seek Array(rUA("Year"), rUA("MonthDay"), rUA("JyoCD"), rUA("Kaiji"), rUA("Nichiji"), rUA("RaceNum")) With gd .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Time"), "@:@@.@"), , ">^" .SetItemMatrix i + rowOffset, lngCP, IIf(rUB("HaronTimeL3") = "999", "", mSC.SSSs(rUB("HaronTimeL3"))), , ">^" .SetItemMatrix i + rowOffset, lngCP, mSC.YMD3(rUA("Year") & rUA("MonthDay")), Trim$(rRA("Hondai")) & mCC.GRAD3(rRA("GradeCD")), ">^", "RA", rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum") .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(rUA("Kaiji"), 2) & mCC.KIBJ3(rUA("JyoCD")) & mSC.FitSpaceNum(rUA("Nichiji"), 2), , ">^", "RA", rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum") .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(rUB("KakuteiJyuni"), 2), , ">^", , , gApp.GetChakujyunColor(rUB("KakuteiJyuni")) .SetItemMatrix i + rowOffset, lngCP, mCC.IJKB2(rUB("IJyoCD")), , "<^" .SetItemMatrix i + rowOffset, lngCP, mSC.BabaGrid(rRA), , "<^" .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Futan") / 10, "#0.0"), , ">^" End With ' gd rUA.Close Else lngCP = 11 End If ' 距離&芝 持ちタイム If strYear <> "" Then strSQL = "SELECT * FROM UMA_RACE_A " strSQL = strSQL & " WHERE [Year]='" & strYear & "'" strSQL = strSQL & " AND [MonthDay]='" & strMonthDay & "'" strSQL = strSQL & " AND [JyoCD]='" & strJyoCD & "'" strSQL = strSQL & " AND [Kaiji]='" & strKaiji & "'" strSQL = strSQL & " AND [Nichiji]='" & strNichiji & "'" strSQL = strSQL & " AND [RaceNum]='" & strRaceNum & "'" strSQL = strSQL & " AND [Umaban]='" & strUmaban & "'" strSQL = strSQL & " AND [KettoNum]='" & UA("KettoNum") & "'" rUA.Open strSQL, cUA, adOpenKeyset, adLockReadOnly, adCmdText rUB.Seek Array(rUA("Year"), rUA("MonthDay"), rUA("JyoCD"), rUA("RaceNum"), rUA("Umaban"), rUA("KettoNum")) rRA.Seek Array(rUA("Year"), rUA("MonthDay"), rUA("JyoCD"), rUA("Kaiji"), rUA("Nichiji"), rUA("RaceNum")) With gd .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Time"), "@:@@.@"), , ">^" .SetItemMatrix i + rowOffset, lngCP, IIf(rUB("HaronTimeL3") = "999", "", mSC.SSSs(rUB("HaronTimeL3"))), , ">^" .SetItemMatrix i + rowOffset, lngCP, mSC.YMD3(rUA("Year") & rUA("MonthDay")), Trim$(rRA("Hondai")) & mCC.GRAD3(rRA("GradeCD")), ">^", "RA", rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum") .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(rUA("Kaiji"), 2) & mCC.KIBJ3(rUA("JyoCD")) & mSC.FitSpaceNum(rUA("Nichiji"), 2), , ">^", "RA", rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum") .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(rUB("KakuteiJyuni"), 2), , ">^", , , gApp.GetChakujyunColor(rUB("KakuteiJyuni")) .SetItemMatrix i + rowOffset, lngCP, mCC.IJKB2(rUB("IJyoCD")), , "<^" .SetItemMatrix i + rowOffset, lngCP, mSC.BabaGrid(rRA), , "<^" .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Futan") / 10, "#0.0"), , ">^" End With ' gd rUA.Close End If Else '血統番号が初期値の時は馬名まで表示 SafeSeek UB, Array("B_Year", "B_MonthDay", "B_JyoCD", "B_RaceNum", "B_Umaban", "B_KettoNum"), _ Array(UA("Year").value, UA("MonthDay").value, UA("JyoCD").value, UA("RaceNum").value, UA("Umaban").value, UA("KettoNum").value) SafeSeek UM, Array("KettoNum"), Array(UA("KettoNum").value) SafeSeek AV, Array("Year", "MonthDay", "JyoCD", "Kaiji", "Nichiji", "RaceNum", "Umaban"), _ Array(UA("Year").value, UA("MonthDay").value, UA("JyoCD").value, UA("Kaiji").value, UA("Nichiji").value, UA("RaceNum").value, UA("Umaban").value) lngCP = 0 With gd .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(UA("Wakuban"), 2), , ">^", , , gApp.GetWakubanColor(val(UA("Wakuban"))), Contrast(gApp.GetWakubanColor(val(UA("Wakuban")))) .SetItemMatrix i + rowOffset, lngCP, mSC.FitSpaceNum(UA("Umaban"), 2), , ">^" Call BameiAV(AV, UA, UB, UM, gd, i + rowOffset, lngCP) End With End If UA.MoveNext i = i + 1 If gd.Rows <= i + rowOffset Then gd.Rows = gd.Rows + 10 End If Loop ' 出走馬ループ gd.Rows = i + rowOffset RaiseEvent FetchedMotiTIme(gd) End Sub
この部分は、力を入れて作成したのか、スピードの追及のためかデータベースのプロバイダの記載まであります。
このようにしているのは、恐らくここだけだろうと思います。
SQLite で作成した場合は、アクセスのプロバイダ名では動作しませんので、当然変更しております。
問題なのは、rUB.Index = "PrimaryKey" の部分で、SQLite はこのコードを理解出来ません。(多分)
それと、「馬吉」が独自に作成している SafeSeek コマンドも SQLite では使えません。
それでそこの部分はプログラムを書き直す必要があります。
「馬吉」では便利な SafeSeek を多用しているので、移植にとんでもなく時間が掛かる事になってしまいました。
使えないコマンドはコメントアウトしてあるのですが、ほとんどがインデックスに関係するものです。
コメントアウトするとインデックス機能が働かないので、検索に膨大な時間が必要とする結果になっている事は容易に想像できます。
持ちタイムの検索に4分も必要とするのではひどすぎるので、色々とプログラムを変更してみました。
試行錯誤した結果、現在(2009年12月12日)では、なんとか15秒まで短縮する事ができました。
以下がそのプログラムです。
馬吉の書き方に沿っていますが、レコードセットのオープンとクローズのメモリーの解放とかには多少気を使っております。
Set rRA = Nothing がその部分で、当たり前ですがレコードセットをクローズした時にメモリーも同時に解放してやらないと、どんどんメモリーが消費してしまいます。
' ' 機能: 持ちタイムグリッドを作る ' ' 備考: なし ' Private Sub DirectMakeData_MochiTime() Const rowOffset As Long = 2 Dim gd As clsGridData Dim strSQL As String Dim lngCP As Long Dim cUA As ADODB.Connection Dim UA As ADODB.Recordset Dim UM As ADODB.Recordset Dim rUA As ADODB.Recordset Dim rUB As ADODB.Recordset Dim rRA As ADODB.Recordset Dim strMinTime As String Dim strKeyCord As String Dim strYear As String Dim strMonthDay As String Dim strJyoCD As String Dim strKaiji As String Dim strNichiji As String Dim strRaceNum As String Dim strUmaban As String Dim str2MinTime As String Dim str2KeyCord As String Dim str2Year As String Dim str2MonthDay As String Dim str2JyoCD As String Dim str2Kaiji As String Dim str2Nichiji As String Dim str2RaceNum As String Dim str2Umaban As String Dim i As Long Dim j As Long Dim StrikeFlag As Boolean Set gd = New clsGridData Set UA = mRS_UMA_RACE Set UM = mRS_UMA Set cUA = New ADODB.Connection cUA.Open "Driver=SQLite3 ODBC Driver;" & _ "Database=" & gApp.R_DBPath & "\Umachan.db" & ";" & _ "StepAPI=0;SyncPragma=NORMAL;NoTXN=0;Timeout=;ShortNames=0;LongNames=0;NoCreat=0;NoWCHAR=1;LoadExt=;" With gd .Rows = 28 + 2 ' 2段ヘッダ .Cols = 3 + (8 * 2) ' 1行目 カラムヘッダ登録 lngCP = 0 .SetItemMatrix 0, lngCP, "枠", "枠番", ">-" .SetItemMatrix 0, lngCP, "番", "馬番", ">-" .SetItemMatrix 0, lngCP, "馬名", , "<-" For i = 0 To 7 .SetItemMatrix 0, lngCP, mCC.KIBJ3(mBuf_RA.id.JyoCD) & " " & mCC.TRCK4(mBuf_RA.TrackCD) & " " & val(mBuf_RA.KYORI) & "m", , "<-" ' 中山 芝 1200m Next i For i = 0 To 7 .SetItemMatrix 0, lngCP, mCC.TRCK4(mBuf_RA.TrackCD) & " " & val(mBuf_RA.KYORI) & "m", , "<-" ' 1200m Next i lngCP = 0 .SetItemMatrix 1, lngCP, "枠", "枠番", ">-" .SetItemMatrix 1, lngCP, "番", "馬番", ">-" .SetItemMatrix 1, lngCP, "馬名", , "<-" For i = 0 To 1 .SetItemMatrix 1, lngCP, "タイム", , ">-" .SetItemMatrix 1, lngCP, "上り3F", "後3ハロン", ">-" .SetItemMatrix 1, lngCP, "年月日", , ">-" .SetItemMatrix 1, lngCP, "回場日", , ">-" .SetItemMatrix 1, lngCP, "着", "着順", ">-" .SetItemMatrix 1, lngCP, "異", "異常", "<-" .SetItemMatrix 1, lngCP, "馬場", "馬場状態", "<-" .SetItemMatrix 1, lngCP, "負担", "負担重量", ">-" Next i End With 'gd ' 出走馬ループ i = 0 UA.MoveFirst Do While Not UA.EOF j = 0 strMinTime = "99999" strKeyCord = "" strYear = "" strMonthDay = "" strJyoCD = "" strKaiji = "" strNichiji = "" strRaceNum = "" strUmaban = "" str2MinTime = "99999" str2KeyCord = "" str2Year = "" str2MonthDay = "" str2JyoCD = "" str2Kaiji = "" str2Nichiji = "" str2RaceNum = "" str2Umaban = "" If Not IsNull(UA("KettoNum")) Then Set rUA = New ADODB.Recordset rUA.Open "SELECT * FROM UMA_RACE WHERE KettoNum='" & UA("KettoNum") & "' ORDER BY KeyCord DESC", cUA, adOpenKeyset, adLockReadOnly, adCmdText ' 過去レースループ Do While Not rUA.EOF DoEvents: If mblnCancelFetching Then Exit Sub '過去走は20走前までとする 'j = j + 1: If j > 20 Then Exit Do 'Set UM = New ADODB.Recordset 'UM.Open "UMA WHERE KettoNum =" & UA("KettoNum"), mCN_UMA, adOpenKeyset, adLockReadOnly, adCmdTableDirect ' 過去のみ 'If Left$(rUA("KeyCord"), 8) < (mKey.Year & mKey.MonthDay) Then If rUA("Year") & rUA("MonthDay") < (mKey.Year & mKey.MonthDay) Then Set rRA = New ADODB.Recordset rRA.Open "RACE WHERE [KeyCord] = '" & rUA("KeyCord") & "'", cUA, adOpenKeyset, adLockReadOnly, adCmdTableDirect ' レース情報が存在する場合のみ If Not rRA.EOF Then If rRA("Kyori") = mBuf_RA.KYORI And MochiTimeSubSameTrackCD(rRA("TrackCD").value, mBuf_RA.TrackCD) Then If rUA("Time") <> 0 Then If rUA("Time") <= strMinTime Then strMinTime = rUA("Time") strKeyCord = (rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum")) strYear = rUA("Year") strMonthDay = rUA("MonthDay") strJyoCD = rUA("JyoCD") strKaiji = rUA("Kaiji") strNichiji = rUA("Nichiji") strRaceNum = rUA("RaceNum") strUmaban = rUA("Umaban") End If ' 場所が同じ場合 If rUA("JyoCD") = mBuf_RA.id.JyoCD Then If rUA("Time") <= str2MinTime Then str2MinTime = rUA("Time") str2KeyCord = (rUA("Year") & rUA("MonthDay") & rUA("JyoCD") & rUA("Kaiji") & rUA("Nichiji") & rUA("RaceNum")) str2Year = rUA("Year") str2MonthDay = rUA("MonthDay") str2JyoCD = rUA("JyoCD") str2Kaiji = rUA("Kaiji") str2Nichiji = rUA("Nichiji") str2RaceNum = rUA("RaceNum") str2Umaban = rUA("Umaban") End If End If End If ' 0秒でない場合のみ End If ' このレースと同じ距離のみ End If ' レース情報が存在する場合のみ rRA.Close Set rRA = Nothing End If ' 過去のみ rUA.MoveNext Loop ' 過去レースループ lngCP = 0 With gd .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(UA("Wakuban"), 2), , ">^", , , gApp.GetWakubanColor(val(UA("Wakuban"))), Contrast(gApp.GetWakubanColor(val(UA("Wakuban")))) .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(UA("Umaban"), 2), , ">^" StrikeFlag = (UA("IjyoCD") >= "1" And UA("IjyoCD") <= "3") .SetItemMatrix i + rowOffset, lngCP, UA("Bamei"), mCC.IJKB1(UA("IJyoCD")), "<-", "UM", UA("KettoNum"), , , StrikeFlag End With ' 場所&芝&距離 持ちタイム If str2Year <> "" Then Set rUB = New ADODB.Recordset strSQL = "SELECT * FROM UMA_RACE " strSQL = strSQL & " WHERE [KeyCord]='" & str2KeyCord & "'" strSQL = strSQL & " AND [Umaban]='" & str2Umaban & "'" strSQL = strSQL & " AND [KettoNum]='" & UA("KettoNum") & "'" rUB.Open strSQL, cUA, adOpenKeyset, adLockReadOnly, adCmdText Set rRA = New ADODB.Recordset rRA.Open "RACE WHERE [KeyCord] = '" & rUB("KeyCord") & "'", cUA, adOpenKeyset, adLockReadOnly, adCmdTableDirect With gd .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Time"), "@:@@.@"), , ">^" .SetItemMatrix i + rowOffset, lngCP, IIf(rUB("HaronTimeL3") = "999", "", mCC.SSSs(rUB("HaronTimeL3"))), , ">^" .SetItemMatrix i + rowOffset, lngCP, mCC.YMD3(rUB("Year") & rUB("MonthDay")), Trim$(rRA("Hondai")) & mCC.GRAD3(rRA("GradeCD")), ">^", "RA", rUB("KeyCord") .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(rUB("Kaiji"), 2) & mCC.KIBJ3(rUB("JyoCD")) & mCC.FitSpaceNum(rUB("Nichiji"), 2), , ">^", "RA", rUB("KeyCord") .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(rUB("KakuteiJyuni"), 2), , ">^", , , gApp.GetChakujyunColor(rUB("KakuteiJyuni")) .SetItemMatrix i + rowOffset, lngCP, mCC.IJKB2(rUB("IJyoCD")), , "<^" .SetItemMatrix i + rowOffset, lngCP, mCC.BabaGrid(rRA), , "<^" .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Futan") / 10, "#0.0"), , ">^" End With ' gd rRA.Close Set rRA = Nothing rUB.Close Set rUB = Nothing Else lngCP = 11 End If ' 距離&芝 持ちタイム If strYear <> "" Then Set rUB = New ADODB.Recordset strSQL = "SELECT * FROM UMA_RACE " strSQL = strSQL & " WHERE [KeyCord]='" & strKeyCord & "'" strSQL = strSQL & " AND [Umaban]='" & strUmaban & "'" strSQL = strSQL & " AND [KettoNum]='" & UA("KettoNum") & "'" rUB.Open strSQL, cUA, adOpenKeyset, adLockReadOnly, adCmdText Set rRA = New ADODB.Recordset rRA.Open "RACE WHERE [KeyCord] = '" & rUB("KeyCord") & "'", cUA, adOpenKeyset, adLockReadOnly, adCmdTableDirect With gd .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Time"), "@:@@.@"), , ">^" .SetItemMatrix i + rowOffset, lngCP, IIf(rUB("HaronTimeL3") = "999", "", mCC.SSSs(rUB("HaronTimeL3"))), , ">^" .SetItemMatrix i + rowOffset, lngCP, mCC.YMD3(rUB("Year") & rUB("MonthDay")), rRA("Hondai") & mCC.GRAD3(rRA("GradeCD")), ">^", "RA", rUB("KeyCord") .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(rUB("Kaiji"), 2) & mCC.KIBJ3(rUB("JyoCD")) & mCC.FitSpaceNum(rUB("Nichiji"), 2), , ">^", "RA", rUB("KeyCord") .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(rUB("KakuteiJyuni"), 2), , ">^", , , gApp.GetChakujyunColor(rUB("KakuteiJyuni")) .SetItemMatrix i + rowOffset, lngCP, mCC.IJKB2(rUB("IJyoCD")), , "<^" .SetItemMatrix i + rowOffset, lngCP, mCC.BabaGrid(rRA), , "<^" .SetItemMatrix i + rowOffset, lngCP, Format$(rUB("Futan") / 10, "#0.0"), , ">^" End With rRA.Close Set rRA = Nothing rUB.Close Set rUB = Nothing End If rUA.Close Set rUA = Nothing Else lngCP = 0 With gd .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(UA("Wakuban"), 2), , ">^", , , gApp.GetWakubanColor(val(UA("Wakuban"))), Contrast(gApp.GetWakubanColor(val(UA("Wakuban")))) .SetItemMatrix i + rowOffset, lngCP, mCC.FitSpaceNum(UA("Umaban"), 2), , ">^" StrikeFlag = (UA("IjyoCD") >= "1" And UA("IjyoCD") <= "3") .SetItemMatrix i + rowOffset, lngCP, UA("Bamei"), mCC.IJKB1(UA("IJyoCD")), "<-", "UM", UA("KettoNum"), , , StrikeFlag End With End If UA.MoveNext i = i + 1 If gd.Rows <= i + rowOffset Then gd.Rows = gd.Rows + 10 End If Loop ' 出走馬ループ gd.Rows = i + rowOffset RaiseEvent FetchedMotiTIme(gd) End Sub
「馬吉」でもそうなのですが、オープンしたレコードセットのファイルに中身があるかどうかのチェックをしておりませんし、直したい所がまだまだあります。
取りあえず「馬吉」並に動くといった感じです。
過去走も持ちタイムは20レース前までにしようと思って、出来るようにはしてありますが、全レースを対象にした場合でも15秒で完了しましたから、随分と速くなりました。
持ちタイムが参照できるようにならなくても、他の部分は動作が可能ですから、ストレスを感じる事はありません。
表示内容の確認と更なる機能アップとスピードアップを目指します。
「馬吉」では最上部のタイトルバーに処理を行っている内容が表示されます。
同様の表示は中段にも表示されますので、はっきり言ってタイトルバーの表示は不要なものです。
タイトルバーには、プログラム名やバージョンの表示だけにするのが一般的ですので止めるべきではないでしょうか。
これを止めるには、フォームモジュール(frmBrowser)のTitleChangeの Me.Caption = strTitle & " : " & cAppName をコメントアウトします。
中段にも余計な表示をする部分があります。 例えば騎手データを表示させている場合に、下段に騎手名とフリガナが表示されているにも関わらず、中段にも「騎手」の表示の後に騎手名が追加で表示されるのです。
ちょっと理解に苦しむのですが、プログラマーには変人が多いので、そのような仕様になっているのでしょう。
これを止めるには、ユーザーコントロールの Update にある、履歴用文字列追加の記載の「mstrTitle = mstrTitle & " " & mData.Labels(1)」をコメントアウトするだけです。
元々の「mstrTitle」はユーザーコントロールの初期設定で行っておりますので、任意の表示が出来ますが、これを「騎手情報」などと変更してもメリットは無いでしょう。
騎手だけでなく、馬主や調教師等、もろもろ存在しますので、修正する箇所が多くて大変です。表示に違和感を感じなければ、そのままでも良いと思います。
私の環境だけの問題かも知れませんが、枠番の8枠の色がピンクではなくてオレンジ色に見えて7枠と区別がつきません。
これを変更するには、クラスモジュール(clsApp)のGetWakubanColorのCase8をGetWakubanColor = RGB(255, 128, 255) にします。
「馬吉」の公開版だけのようですが、フレックスグリッド(FlexGrid)のタブに表示される日本語が完全に表示されなくて右側が欠けてしまいます。
日本語を使わなければ正常に表示されるようなので文字コードの関係なのかと思って、文字コードで記入しようかとも思ったりしたのですが面倒そうなので諦めました。
その代わり、表示する日本語の文字列の後にダミーのスペースを入れる事で文字が欠ける事なく表示されましたのでそのようにしております。
VB6の仕様なのか、設定の問題なのかは不明です。
「馬吉」はひらがなでも検索する事ができます。
ひらがなでもと書いたのは、データベースに登録されているのは大文字のカタカナと小文字のカタカナ、及び英語表記だけですから基本的にはひらがなでは検索できないのです。
これが検索できると言う事は、プログラムで文字列の変換を行っていると言う事なのです。
残念ながら、SQLite のデータベースの使用では、「馬吉」のプログラムコードのままではひらがなの検索は出来ませんでした。
以下は騎手検索で’よこやま’と入力した場合のプログラムが作成するSQL構文です。
SELECT * FROM KISYU WHERE [KisyuName] LIKE '[ょよョヨョヨ]%こ%[ゃやャヤャヤ]%ま%' OR [KisyuNameKana] LIKE '[ょよョヨョヨ]%こ%[ゃやャヤャヤ]%ま%' OR [KisyuRyakusyo] LIKE '[ょよョヨョヨ]%こ%[ゃやャヤャヤ]%ま%' OR [KisyuNameEng] LIKE '[ょよョヨョヨ]%こ%[ゃやャヤャヤ]%ま%' ORDER BY [KisyuNameKana]
私も始めて知ったのですが、正規表現とかを利用しているようです。
SQLite が検索出来ないのは、LIKE構文の[ょよョヨョヨ]% の部分です。
これは仕様なのか、他のやり方があるのかまでは調べませんでしたが、嵌りどころにも書いたように3種類もの検索を同時に行っているのは無駄があると考えて書き直す事にしました。
そうしないと、インデックスが作成されていないと馬名の検索に数分を要したにがい経験があるからです。
変更方法は、入力された文字列が英文なのかカナの大文字なのか、カナの小文字なのか、それとも漢字なのかを判断して、それに適したSQL構文を作成すると言うものです。
これなら同時に3種類で検索する必要もありませんので無駄がありませんし、検索速度の点でも有利でしょう。
ついでに、ひらがな入力も判断してひらがなをカタカナに変換して検索を行う事にします。
これならひらがなでも検索が出来るようになります。
「馬吉」のようにウオッカをゥォッカでも検索できるようにはなりませんが、不便さを感じる事はないでしょう。
VBには、strconv と言う便利な関数がありますから、ひらがなからカタカナへの変換や大文字から小文字の変換は容易です。
文字コードの判定も簡単にできますのでプログラムの作成に悩む事は無いと思います。
こんな事で悩むようなら「馬吉」の改造はとても無理です。
蛇足ですが、「馬吉」は文字列の判定を以下のようにしております。(一部抜粋)
For i = 0 To Len(str) - 1
c = Mid$(str, i + 1, 1)
If (c >= "a" And c <= "z") Or (c >= "A" And c <= "Z") Then
' アルファベットの場合
'out = out & "[" & StrConv(c, vbProperCase) & StrConv(c, vbLowerCase) & "]"
Else
(省略)
end if
next
プログラマーが10人いれば10人がこのような書き方をするでしょうし、これなら評価点も100点だと思います。
私はこのように書きました。
' アルファベットの場合
If Left$(str, 1) Like "[a-z]" Or Left$(str, 1) Like "[A-Z]" Then
(省略)
' ひらがなの場合
ElseIf Left$(str, 1) Like "[あ-ん]" Then
str = StrConv(str, vbKatakana)
(以下省略)
end if
いかにも素人っぽい書き方で(事実素人ですが)、これで評価を受けても0点ではないでしょうが、10点ぐらいしか貰えないでしょう。
なぜなら、頭の一文字だけで判定するのは手抜かりだと思われる事と、Like などと普段使わないコードを使用しているからです。
使用例の少ないコードは危険な場合があるので安心ではないと思われるからです。
しかし、私はこんな書き方の方が好きです。
頭1文字が英語なら残りの文字も全て英語だろうと思うのは自然だと思いますし、実際にも英語とかなとカタカナを混在して検索する人などは変人を通り越して’きちがい’ぐらいだと思います。
そんな事をする人は、まともに検索する事が出来ないだけの話です。
最近は’きちがい’も放送禁止用語とかで、’精神障害者’と呼ばなければならないそうですが。
私に言わせれば、’きちがい’も’精神障害者’もなんら違いを感じないのですが、正統派(と呼ばれている)でなければ受け入れられない世の中になってしまっているのでしょう。
なんでも右へならえなら安心だろうと考えるのは、過去の判例ばかり気にして判決するヘボ裁判官と大差ありません。
「馬吉」では、データベースのコネクションを得るために、クラスもジュールのclsAppに問い合わせをしています。
例えばレースデータのコネクションの場合の問い合わせは gApp.GetCN_RACE なのですが、gApp の記載は以下のようになっています。
' ' 機能: コネクションを得る−RACE ' ' 備考: なし ' Public Function GetCN_RACE() As ADODB.Connection Set GetCN_RACE = mDM.GetCN(34) End Function
何とそこから、クラスモジュールのデータベースマネージャー(clsDatabaseMgr)を呼び出しているのです。
回り道をする理由は何もありませんので、直接データベースマネージャーを呼び出す事にしました。
変更箇所の多い割りには、動作スピードが変わるなどのメリットは感じられませんが、プログラムの見通しはかなり良くなります。
今回は、SQLiteを使用しておりますので、コネクションの記載は今までのアクセスで行っていたように50通りも必要ありませんから尚更です。
gApp に記載してあったコネクションは全て削除する事が出来ました。
やり方は、各クラスのジュールのトップに以下のようにデータベースマネージャーを追加します。
Private mDM As clsDatabaseMgr
クラスの初期化イベントにSet mDM = New clsDatabaseMgr と書いて使える状態にします。
(勿論、モジュール別に宣言しても構いません。)
それから、Set mCN_RACE = gApp.GetCN_RACE と記載している部分を Set mCN_RACE = mDM.GetCN(34) と変更するだけです。
クラスの終了イベントに、Set mDm = Nothing と記載してメモリーの解放を行っておけば万全でしょう。
「馬吉」を終了させようとすると必ず出てくるメッセージです。
うざいメッセージの典型的なものでしょう。
終了させたいから終了ボタンを押したのであって、そんな時にいちいち確認されなければならない理由はどこにもありません。
終了させるつもりがなくて終了してしまったのなら、再起動させれば良いだけの話です。
意図しない終了をしたからと言って、重要なファイルが失われる事もありませんので、このメッセージは余計なお世話そのものと言えるでしょう。
ちなみに、人気ソフトのターゲットでもこのメッセージは出ますが、出ないように設定する事が出来ます。
最近、アメリカの裁判制度を真似て一般市民を陪審員にする裁判がはじまりました。
これが良かったかどうかの結論は出ておりませんが、発端はアメリカの真似をしていれば間違いない、あるいはアメリカは先進国だから真似をすべきだとのアメリカかぶれした人間が考えた事でしょう。
以前の総理もアメリカには似たようね感覚を持っていて変人と呼ばれておりました(変人と呼ばれたのは極端なアメリカ好きだったからとは言えませんが)、確かにアメリカは先進国かも知れません。
明治時代は特にアメリカやイギリス、ドイツに学ぶべき事が多かったのは確かです。
しかし、無駄な大量生産による大量消費(大量破棄)が果たして地球の資源を守る点から見ると必ずしも適しているかどうかはかなり疑問ですし、広大なアメリカには必要な巨大なダムが日本では不要ではないだろうかと最近は見直されてきています。
裁判の陪審員については、世間ずれした裁判官を何とかしたいと思う人か、裁判制度(司法)を快く思っていない政治家の策謀で導入されたのでしょうが、選出された一般市民ほど迷惑なものはなく、愚策の典型的なものと私は思っています。
一般市民を導入したにしては、今の裁判官の権限は否定しておりませんので一般市民も権限は中途半端で、単なるアドバイザー的なお飾りになっています。
一旦始めたものを急に止める事もできないでしょうから、愚策であっても延々とこの制度は続く事になるのでしょう。
「馬吉」を終了しますか。のようなメッセージは、アメリカ人にとっては必要なのでしょうが、日本人にとっては無用なものです。
明治時代から相当の期間が過ぎておりますので、もうそろそろ人真似をしないで一人立ちしても良さそうな気がします。
いつまでも成長できない(アメリカナイズされた)もどかしさを「馬吉」のプログラマーにも感じてしまいます。
この表示を止めるには、frmBrowser の mnuFileSub_Click の該当部分をコメントアウトするだけです。
調教師を検索した時に、その調教師の成績のタブと調教師の管理する馬のタブがあります。
調教師の選択時には、調教師の成績が最初に表示されるのですが、調教師の管理馬のタブはデータを取得しないと表示できない(Enable=False)ようになっております。
管理馬のデータの取得に SQLite は時間が掛かる(10秒以上)ので調べてみると、調教師と馬主にリンクできるかどうかを調べるためだけに毎回レコードセットを開いたり閉じたりしているためだと判明しました。
本来のアクセスでもこんなに時間が掛かるものなのかと調べてみると、1,2秒程度で検索が終了します。
恐ろしく速いです。
10万頭以上の競走馬のデータから、特定の調教師と馬主を調べるのに1,2秒で終了するのはかなり速いのではないでしょうか。
SQLite は、大変優れたデータベースだと思うのですが、インデックスの作成の遅さには閉口してしまいます。
アクセスの場合は、10万頭のインデックスの作成でも、遅いと感じた事は1度もなかったのですが、SQLite は無限ループに入ってしまったかと感じるほどインデックスの作成に時間が掛かります。
インデックスによる検索時間でも SQLite はアクセスに負けているような気がしています。
2つのデータベースを使用してみて始めて認識できたのですが、マイクロソフトアクセスはインデックス関係に関しては秀逸であると思いました。
MySQLも使用したことがありますが、インデックスで感じる事は何もありませんでしたので、アクセスと同様に秀逸なのかも知れません。
SQLite を使用して特に感じるのは、検索中は大量のメモリーを消費するらしく、OS(Windoes Xp)の動作にも多大な影響を与えます。
動作中はタスクマネージャーを開くのさえ儘ならなくなってしまいます。
【後記】
インデックスの作成は MySQL は速いような事を書きましたが、同じデータで調べてみました。
そしたら遅いのなんのって、SQLite よりも遅く、インデックスの削除だけでも数十分、作成にも数十分から数時間掛かりました。
私の環境はデータベースも常時3つ(SQLSERVER,MySQL,FireBird)稼動していますし、その他もろもろのソフトも動いていて劣悪な環境なのですが、それにしても遅いと思いました。
インデックス作成に関して MySQL が優れていると言ったのは訂正させていただきます。
今回の件に関しては、リンク接続が可能かどうかを調べるのに、わざわざ調教師や馬主のレコードセットを開いて確認するのではなく、馬(UMA)データの中に、すでに調教師コードと馬主コードは記録されているのですから、そのデータが存在しているかどうか(NULLかどうか)でリンクが可能かどうかは十分に確認できます。
アクセスの場合でも、そのような方法も取れる筈ですが、今でも検索は速いので必要はないでしょう。
当然ですが、この変更によって管理馬の表示は一瞬の間に終了します。
これなら、アクセスよりも明らかに速いです。
尚、「馬吉」は管理馬を年齢の多い順にソートしておりますが、ターゲットのように若い順からの方にした方が良いと思います。
なぜなら、「馬吉」では全年齢の馬を表示しますので、馬齢24歳の馬とかが先頭に表示されるからです。
競馬を知っている人がプログラムを組んだのであれば、こんな仕様には決してしません。
競馬をやったことが無い人が作成したと感じる極め付けは、レコードの斤量の部分を重量と表示している点です。
競馬をやっている人でも、斤量を負担と呼ぶ人は稀におりますが、斤量を重量と呼ぶ人はおりません。
「馬吉」は起動時に通常のメニュー画面の他にメニューパレット(MenuPalette)と呼ばれる小型のリモコン状のメニューフォームも開かれます。
私の感覚では有用な存在と言うよりは、顔の周りを蝿が飛んでいるような感じで、うざい存在だなと思ってはいたのですが、いつでも消せる(閉じれる)のでそのままにしておりました。
その内に何とかしましょうと言う事です。
「馬吉」の解析も進んで順調に動くようになってくると、このうざい存在を何とかするべき時期が来たと思いました。
メニューパレットを表示させるかどうかは、「馬吉」のオリジナルでは、レジストリの [MenuPalette]、[Visible] をFalse にすれば表示されないようになっているようです。
私の改造版では、レジストリの使用を止めて、UmakichiDB.ini ファイルにその項目がありますから、そこをFalse にして、メニュパレットを表示させる時に、True だったら表示をして False だったら表示させないようにしました。
その関係を記載しているプログラムは、クラスモジュールの clsApp だけですから、変更は簡単でした。
で、やってみると Visible を False に設定しても True に書き換えられてしまうのです。
どこで書き換えているのか調べた所、Start の直後でした。
' 操作パレットの作成
'Me.R_MenuVisible = True
If ReadINI("MenuPalette", "Visible") = "True" Then
mPallet.Show
Else
mPallet.Hide
End If
Me.R_MenuVisible = True で「馬吉」はメニューパレットを強制表示させておりました。
早速、この部分は上記のようにコメントアウトして、その下にUmakichiDB.iniファイルの設定内容によって表示のオン、オフができるようにしました。
Trueを文字列として扱っているなど、人には薦められないコードですが、動くので良しとしましょう。
Hide も UnLoad にすべきかも知れません。
顔の周りの蝿が居なくなって、私には快適な環境になったのですが、メニューパレットが無いと不便だと感じる人も世間には多いのでしょうね。
「馬吉」のデータベースの切断の記載は以下のようになっております。
' ' 機能: 切断する ' ' 備考: なし ' Public Function Disconnect() As Boolean On Error GoTo Errorhandler Exit Function Errorhandler: Disconnect = False End Function
何の処理も行っておりません。
通常なら、cn.close の記載を記入するはずなのですが、なぜ無いのでしょうか。
この記載はクラスモジュールの clsDatabaseMgr に記載してあるのですが、標準モジュールの basMain に以下の記載がありあmす。
' ' 機能: コネクションを開放する ' ' 備考: なし ' Public Sub freecn(cn As ADODB.Connection) If Not cn Is Nothing Then Do While cn.State And adStateExecuting Call cn.Cancel gApp.Log "freecn Cancel" Loop Do While cn.State And adStateOpen cn.Close gApp.Log "freers Close" Loop Set cn = Nothing Else gApp.Log "freecn Nothing" End If End Sub
こちらで処理を行っているのでしょうか。
どちらも、プログラム上から呼ばれておりますから、紛らわしいです。
SQLite の場合は、コネクションの接続と開放には厳格な感じがしますので、適切に行わないとデータベースが開くまでにえらい時間が掛かったりします。
Call cn.Cancelもcn.Closeもループになっていて、動作が今ひとつ理解できません。
単純にクローズさせる事は出来ないのでしょうか。
私は「馬吉」を使ってはおりませんので、「馬吉」に関しては超初心者と言う事になります。
でも、考え方によっては超初心者の方がベテランの人が当たり前と思っている事や気にならない事でも、良いか悪いかは別ににして気になる場合があります。
JRA-VANの提供のせいもあるのかも知れませんが、「馬吉」の利用者の数は相当なものです。
人気ランキングでも常に20以内には入っておりますので、私のソフトなど足元にも及びません。
予想ソフトではありませんが、これだけに人気があると言う事は、使い勝手も良いのでしょうし内容も素晴らしいのだと思います。
今回取り上げるプログレスバーがうざい点も、普通の人には全く気にならない点かも知れません。
でも、私はうざいと思ったので敢えて取り上げる事にしました。
「馬吉」では処理を切り替える時に、画面の中央にプログレスバーが表示され、処理中ですのコメントが出ます。
いかにもプログラムが動いている感じがして使っている人の中には快感を覚える人も居るのかも知れませんが、私のプログラム感覚では邪魔な存在です。
なぜ邪魔かと言うと、画面が切り替わる時に以下の状態になります。
現在見ている画面→処理中の画面→切り替わった画面
処理中の画面の表示時間は通常は短いので、画面のちらつきのように思える場合もあります。
なぜ、現在見ている画面→切り替わった画面のようにしないのでしょうか。
プログラム制作の初心者ならいざ知らず、プロのプログラマーがこのような構成にしている意味が私には理解できません。
もし、処理に時間が掛かる場合があるので、処理中である事を表示したいと言うのであれば、下部にはステータスバーがありますので、そこにプログレスバーを表示すれば良いでしょう。
ステータスバーは元々そのような用途のためにあるものですし、多くのソフトはそのようになっています。
このようにする事で、画面の無駄なちらつきも抑えられますし、目の健康のためにも良いでしょう。
「馬吉」の処理の大部分がそのようになっていますので、変更するには手間が掛かりそうですが、私は変更したいと思います。
うざいと思ったプログレスバーをステータスバーに納めるために調べてみました。
今まではユーザーコントロールの各々に持たせていたのだろうと思っていたのですが、そうではありませんでした。
確かにユーザーコントロールにありましたが、独立しており ctlPane の名前です。
待ち状態を示すプログレスバーの表示もタイマーで1回づつ全ての部分を記入させています。
直ぐには思いつきませんが、簡単にシフトさせる事は出来ないのでしょうか。
丁寧と言うべきか無駄と言うべきか、私のプログラムの作成感覚とは違うようです。
プログラムも長いのでプログレスバーの表示形式も色々と変える事ができるのかと思って見ましたが、単なる待ち時間の表示にしか使えないようです。
プログレスバーの表示がトロッ、トロッと動く場合があるので何とかしたいと思っていました。
これをプログラムからどのように呼び出して表示しているのでしょうか。
それとステータスバーで表示させる場合は、ステータスバーの表示形式がどうなっているのかも調べなければなりません。
変えてやる!と意気込んだまでは良いのですが、面倒くさいですね。
ステータスバーは既に作成されており名前は staStatusBar になっています。
驚いた事にステータスバーの使われ方を見ると、staStatusBar.Panels(1).Text = "読み込み中..." 等という内容があちらこちらにあります。
なんじゃ待ち時間の表示に使っているじゃんとおもったのですが、それでは何で中央に変更したのでしょうか。
(1)ステータスバーでプログレスさせるのに致命的な欠陥が見つかった。
(2)ソフト会社の馬鹿な上司がステータスバーでは見難いとか言って中央に表示するように変更させた。
どちらかかでしょう。
2のような気が・・・・。
「馬吉」のステータスバーの設定は自動設定になっていて全領域が一つの表示だけに使われています。
ステータスバー全部をプログレスバーにしても面白くないので、領域を2つに分ける事にします。
1つをプログレスバーの表示、もう1つを動作状態の表示(例えばデータ取り込み中・・・)にします。
最初に自動設定を解除します。
ステータスバーをクリックして、プロパティのパネルのサイズ自動設定を 0(sbrNoAutoSize)にすれば自動設定は解除されます。
後はインンデックスを追加して2つの領域を適当な長さにすれば完成です。
領域を1つから2つに増やしましたので、コンパイル時にエラーがでますので、2つの領域のどちらに表示させるのかのインデックス番号を入れます。
例えば2番目に表示するのであれば、staStatusBar(1).Panels(2).Text = "読み込み中..." のように変更します。
プログレスバーの表示も今までのようにタイマーで単純にバーをループさせるのではなくてデータ量がわかっている場合は、進行状態を表示させる方が良さそうです。
本来のプログレスバーはそのはずなのですから。
私は以下のようなコードにしました。
見やすいようにプログレスバーの動きの部分だけを記載します。
S_MaxData = Val(rs4.RecordCount) frmBrowser.StatusBar1(1).Panels(1) = "□□□□□□□□□□□□□□□□□□□□□□□□" Do Until rs4.EOF If S_Datasu Mod (Int(S_MaxData / 20) + 1) = 0 Then mlngPos = mlngPos + 1 strOut = vbNullString For j = 0 To 19 If j < mlngPos Then strOut = strOut & "■" Else strOut = strOut & "□" End If Next frmBrowser.StatusBar1(1).Panels(1) = strOut End If rs4.MoveNext Loop frmBrowser.StatusBar1(1).Panels(1) = "■■■■■■■■■■■■■■■■■■■■"
私が他のソフトで使っているのをコピペしたので、このままで動くかどうか不明ですが、考え方は判ると思います。
「馬吉」のやり方よりは増しではないかと自分では思っているのですが、あんまり変わりないでしょうか。
これでも結構苦労して考えたつもりなんですが。(笑)
ここでは最初の表示はいらないのですが、実際には途中にソフトの処理時間が入りますので必要だと思っています。
うざい処理中と言う画面の表示はどこが行っているかと言うと、タイマー(tmrUpdateTrigger_Timer)が行っています。
これをカットして、ステータスバーにプログレスバーの表示を行うようにすれば完成です。
と思ったらそう単純ではありませんでした。
flexTabがpaneTabに乗っているのです。
flexTabをpaneTabから切り離してpaneTabを削除してみたらエラーが出るわでるわ。
プログレスバーをステータスバーに表示させる事はできますが、画面の切り替わりを瞬時に行う事はこのプログラムの構成では無理なような気がしてきました。
折角のアイディアも水の泡となりそうです。
これならば、レース選択画面と出馬表画面をタブ切り替えにして一体化させた方が使い易いのではないかと思いました。
このアイディアをもう少し掘り下げてみます。
【追記】
どうやらうざい中央表示のプログレスバーを排除する事ができました。
代わりにステータスバーバーにプログレスバーの表示を行っています。
従来のように処理時間が不明な場合の表示方式(3ブロックが流れる)と通常のプログレスバーの方式と両方を出来るようにしました。
前者の方は「馬吉」で使用しておりますのでそのまま流用し、後者は以下のようにしました。
最初に空白の"□□□□□□□□□□□□□□□□□□□□□□□□"を表示。
カウントが進む度に頭(左側)に"■”を取り付けてleft$で必要な長さ(所定の長さ)に切り取ります。
これを繰り返していけば通常のプログレスバーの表示になります。
変数も必要としないし、処理も単純でなかなかよかのようです。
文字色を変更するのがステータスバーでは大変なので、黒色のプログレスバーになります。
プログレスバーは青だと決めつけている人は不満でしょうが、私はそこまでこだわる気がありません。
「馬吉」の公開版だけだと思うのですが、特別登録馬を表示させた時の基本画面で馬の性別は表示されますが馬齢が表示されません。
プログラムを見ると馬毎レース(UMA_RACE)から呼び込むようになっていましたが、特別登録馬は馬毎レースには登録されておりませんのでそこからは取り込めません。
どうやって表示させようか考えましたが、「馬吉」のプログラムを調べて見ると生年月日から年齢を算出するコードが書かれておりました。
ストリングコンバーター(clsStringConverter)の age です。
私のプログラムではストリングコンバーターはコードコンバーターと合併させましたのでコードコンバーター内にあります。
プログラムの内容は以下の通りになっています。
' ' 機能: 馬年齢を返す ' ' 備考: なし ' Public Function Age(ARG1 As String, ARG2 As String) As String Dim lngTmp As Long If val(ARG1) = 0 Or val(ARG2) = 0 Then Age = "" gApp.Log "Age :引き数に0があります(馬齢を表示できません)" Else lngTmp = Left$(ARG1, 4) - Left$(ARG2, 4) If lngTmp >= 0 Then Age = Right$(" " & lngTmp, 2) Else Age = "" gApp.Log "Age :年齢がマイナスです" End If End If End Function
年月日を入れると年の部分を取り出して年齢を算出するようです。
単に引き算をするだけなので、わざわざサブルーチン化する必要があったのかは言わない事にします。
馬の生年月日と今日の年月日を入れれば、現時点での馬の年齢が算出できます。
プログラムでは、現在の年月日を入れるのではなくて、データの作成年月日を入れておりました。
そうする事で、データの作成時点での馬の年齢を計算できると言う訳です。
馬の生年月日が不明の場合は、馬の血統番号の頭4桁が生年になっておりますから、そこから計算する事もできます。
これで、特別登録馬に馬齢も記入する事ができました。
移植したプログラムのレコード(RECORD)の表示をまともに行わないので調べて見ました。
プログラムの内容は正常に動けば極端に動作が遅いとかで無ければ見直す事はしません。
見直すのは面倒だし、下手にいじると動かなくなったり、内容が変わってしまう場合があるからです。
ですから、移植したとは言っても「馬吉」のプログラムの内容を把握している訳ではありません。
嵌った所は良く覚えておりますが。(笑)
レコード関係の処理はクラスモジュールの clsDataRCSel や clsDataRC が行っているのですが、それだけでは無いようです。
clsRCSearch と言うクラスモジュールがあって、このモジュールがレコードの存在やレコードの表示の順番を制御しています。
以下に最新のレコードデータを求める「馬吉」のプログラムの内容を記載します。
' 機能: レコードのキーを返す ' ' 備考: 引き数 opt -true:現在のキーがあれば現在のキーを返す ' -false:現在のキーがあっても前回のキーを返す ' Private Function GetPreviousRecordKey(opt As Boolean) As clsKeyRC On Error GoTo ErrorHandler Dim newKey As clsKeyRC Dim rs As New ADODB.Recordset Set rs = New ADODB.Recordset Call OpenTableDirect(rs, mCn, "Record") ' 末端に移動 If Not rs.EOF Then rs.MoveLast End If ' 未来分は読み飛ばす Do While Not rs.BOF If opt Then If rs("RecInfoKubun") & rs("Year") & rs("MonthDay") & rs("JyoCD") & _ rs("Kaiji") & rs("Nichiji") & rs("RaceNum") & rs("TokuNum_SyubetuCD") & _ rs("Kyori") & rs("TrackCD") <= mKey.str Then Exit Do End If Else If rs("RecInfoKubun") & rs("Year") & rs("MonthDay") & rs("JyoCD") & _ rs("Kaiji") & rs("Nichiji") & rs("RaceNum") & rs("TokuNum_SyubetuCD") & _ rs("Kyori") & rs("TrackCD") < mKey.str Then Exit Do End If End If rs.MovePrevious Loop ' 同条件の最も近い過去のレコードを探す Do While Not rs.BOF If mKey.RecInfoKubun = "1" Then If SameRecord(rs) Then Exit Do End If ElseIf mKey.RecInfoKubun = "2" Then If Mid$(rs("TokuNum_SyubetuCD"), 1, 4) _ = Mid$(mKey.TokuNum_SyubetuCD, 1, 4) _ And rs("RecInfoKubun") = mKey.RecInfoKubun Then Exit Do End If End If rs.MovePrevious Loop If rs.BOF Then Set GetPreviousRecordKey = Nothing Exit Function End If Set newKey = New clsKeyRC Call newKey.SetFromRS(rs) Set GetPreviousRecordKey = newKey Exit Function ErrorHandler: gApp.Log "RCSearch::PreviousRecordKey Error" gApp.ErrLog Resume Next End Function
まず一旦は全てのレコードを開きます。
次に最新のレコードを求めるためにレコードの最後に移動させます。
最後が最も新しい記録になっているからです。
次の未来分は読み飛ばすと言うのは、検索する時期より新しくレコード記録があった場合を読み飛ばす事を言っています。
最後から最初の部分に戻りながら目的のレコード部分を検索しています。
それだけではまだまだアバウトですから、そこから同じ競馬場の同じ距離の同じトラック(芝かダート)かで更に選別します。
該当するものがあれば、そこから抜け出しますが無ければデータの最初の部分(BOF)になります。
移植したプログラムがまともに動かなかったのは、数多くの原因があったで説明は省略させていただきます。
ここでは SameRecord(rs) のサブルーチンを呼び出している部分に注目していただきたいと思います。
これは以下のようになっております。
' ' 機能: キーとレコードセットを比較 ' ' 備考: なし ' Private Function SameRecord(rs As ADODB.Recordset) As Boolean If rs("RecInfoKubun") = mKey.RecInfoKubun _ And rs("JyoCD") = mKey.JyoCD _ And rs("Kyori") = mKey.KYORI _ And rs("TrackCD") = mKey.TrackCD _ And SyubetuType(rs("Year"), Mid$(rs("TokuNum_SyubetuCD"), 5, 2)) _ = SyubetuType(mKey.Year, Mid$(mKey.TokuNum_SyubetuCD, 5, 2)) Then SameRecord = True Else SameRecord = False End If End Function ' ' 機能: 種別タイプを返す ' ' 備考: なし ' Private Function SyubetuType(ByVal Y As Long, SyubetuCD As String) As Long Select Case SyubetuCD Case "11" SyubetuType = 1 Case "12" To "14" SyubetuType = 2 Case "18" To "19" SyubetuType = 3 Case Else SyubetuType = 0 End Select End Function
この部分で同じ競馬場の同じ距離の同じトラックを選別しています。
このプログラムに記載の SyubetuType とはいったい何を意味しているのでしょうか。
実はこれは競走馬の年齢を表しており、SyubetuCD が11はサラブレッド系2歳、12はサラブレッド系3歳、13はサラブレッド系3歳以上、14はサラブレッド系4歳以上を表しています。
18と19は障害競走で、3歳以上と4歳以上を区別しています。
その他はアラブ系とかですが、今は関係ないでしょう。
JRAのレコードの体系が、2歳の馬と3歳以上の2系統になっているために、このように区別しています。
SyubetuType の数字は、プログラマーが適当に作成したものだと思っています。
私は以下のようにプログラムを組み直しました。
' 機能: レコードのキーを返す ' ' 備考: 引き数 opt -true:現在のキーがあれば現在のキーを返す ' -false:現在のキーがあっても前回のキーを返す ' Private Function GetPreviousRecordKey(opt As Boolean) As clsKeyRC 'On Error GoTo ErrorHandler Dim newKey As clsKeyRC Dim strSQL As String Dim rs As New ADODB.Recordset Set rs = New ADODB.Recordset If mKey.RecInfoKubun = "2" Then strSQL = "RECORD WHERE RecInfoKubun = '2' AND TokuNum = '" & mKey.TokuNum & "' AND JyoCD = '" & mKey.JyoCD & "' AND Kyori = '" & mKey.KYORI & "' AND SyubetuCD = '" & mKey.SyubetuCD & "' AND TrackCD = '" & mKey.TrackCD & "' ORDER BY KeyCord DESC" ElseIf mKey.RecInfoKubun = "1" Then If mKey.SyubetuCD = "12" Or mKey.SyubetuCD = "13" Or mKey.SyubetuCD = "14" Then strSQL = "RECORD WHERE RecInfoKubun = '1' AND JyoCD = '" & mKey.JyoCD & "' AND Kyori = '" & mKey.KYORI & "' AND (SyubetuCD = '12' OR SyubetuCD = '13' OR SyubetuCD = '14') AND TrackCD = '" & mKey.TrackCD & "' ORDER BY KeyCord DESC" ElseIf mKey.SyubetuCD = "18" Or mKey.SyubetuCD = "19" Then strSQL = "RECORD WHERE RecInfoKubun = '1' AND JyoCD = '" & mKey.JyoCD & "' AND Kyori = '" & mKey.KYORI & "' AND (SyubetuCD = '18' OR SyubetuCD = '19') AND TrackCD = '" & mKey.TrackCD & "' ORDER BY KeyCord DESC" Else strSQL = "RECORD WHERE RecInfoKubun = '1' AND JyoCD = '" & mKey.JyoCD & "' AND Kyori = '" & mKey.KYORI & "' AND SyubetuCD = '" & mKey.SyubetuCD & "' AND TrackCD = '" & mKey.TrackCD & "' ORDER BY KeyCord DESC" End If Else Exit Function End If rs.Open strSQL, mCn, adOpenKeyset, adLockReadOnly, adCmdTableDirect ' 未来分は読み飛ばす Do Until rs.EOF If opt Then If (rs("Year") & rs("MonthDay")) <= (mKey.Year & mKey.MonthDay) Then Exit Do End If Else If (rs("Year") & rs("MonthDay")) < (mKey.Year & mKey.MonthDay) Then Exit Do End If End If rs.MoveNext Loop If rs.EOF Then Set GetPreviousRecordKey = Nothing Exit Function End If Set newKey = New clsKeyRC Call newKey.SetFromRS(rs) Set GetPreviousRecordKey = newKey Exit Function ErrorHandler: gApp.Log "RCSearch::PreviousRecordKey Error" gApp.ErrLog Resume Next End Function
変更したのは、データベースから読み込む段階でフィルターを掛けた事とソートを行う事で最初に新しいデータが来るようにしたことです。
' 未来分は読み飛ばす の部分は年月日だけの比較にしたので処理の意味が判り易いと思います。
エラー処理をコメントアウトにしているのは、まだテスト段階だからです。
まだ十分にテストした訳ではありませんが、私のプログラムでも「馬吉」と同じ結果が出るようです。
尚、蛇足ですが公開版にはレコードを表示した場合に馬の性齢欄に馬の性だけしか表示されません。
馬齢は記録の年と馬の誕生年から簡単に求められますので、馬の性と馬齢を一緒に表示するようにすべきでしょう。
移植中に気が付いたのですが、ユーザーコントロール(ctlVRA)のリサイズイベントには、無駄な部分があるのではないだろうか。
For〜Next で回してしる部分があるのだが、回さなくても良い部分がかなり含まれているようである。
1回で済む所を6回も同じ処理をさせている。
即座に変更した。
「馬吉」の移植も完了間近になって動作をさせていると、使い勝手の悪い部分が目についてきます。
JRA-VAN の人気ソフトでは、常に人気の上位を占めておりますが、私はこのソフトを使い続けようと思う気持ちにはなれません。
最大の不満点は出馬表関係で、競馬は通常一日に3開催地で行われるのですが、この選択にやたら時間が掛かります。
同じ会場でも、レースを選択してから表示が完了するまでに、かなりの時間が掛かるのです。
そして、その時に画面の中央に読み込み中などとプログレスバーが現れて、気が散ってしまうのです。
1日に1〜2レース程度しか馬券を買わない人はこれでも構わないのでしょうが、私のように全てのレースに目を通して、儲かりそうなレースを探す人にとっては、この操作性の悪さは耐える事ができません。
私のパソコンが遅いのだろうと言われそうですが、これでも2,3年前ならトップクラスの性能でしたし、現在でも平均的なパソコン以上の性能はあると思っております。
仮に超高性能なパソコンで「馬吉」を動作させたとしても、表示時間は数倍の速さになるでしょうが、画面のちらつきが多くて耐えられないでしょう。
そこで、出馬表関係のプログラムの大幅な変更を行う事にしました。
変更部分は以下の通りです。
(1)タブの内容の変更
「馬吉」のオリジナルでは、出馬表を選択した場合にレース内容が表示されるフレックスグリッドのタブには以下の内容が含まれております。
基本情報、血統、過去5走、マイニング、条件別成績、持ちタイム、成績
この中で、マイニングは不要なので削除
持ちタイムは処理に時間が掛かるのと重要性が低いので削除
過去5走は必要性は感じるが、現在の状態では使い勝手と視認性が悪いので削除
条件別成績も必要性は感じるが使い勝手が悪いので削除
血統も必要性は感じるが使い勝手が悪いので削除
以下の部分を追加、変更しました。
基本情報のタブの表示内容をレースの開催地名を表示するように変更しました。
最大3開催地分が必要ですから、タブは3個用意しました。
レース内容の表示に時間が掛かり過ぎるために、出馬表の選択時にレース内容の先読みを行わせました。
通常は1日に12レースが行われますので、最大36レース分の先読みを行う必要があります。
この先読みの効果は絶大で、1日に開催されるどこの会場のどのレースでも、瞬きする程度の時間でレース内容が表示されます。
うざい読み込み中などと言う表示をする必要は全くなくなりました。
ちなみに、人気ソフトのターゲットでの表示を調べてみましたら、初めてのレース内容の読み込みでは1秒前後、メモリーキャッシュがある状態で0.2〜0.3秒必要でした。
メモリーキャッシュがある状態でも、画面のちらつきは明らかに感じられましたので、先読み処理をしている場合の方が遥かに高速表示が出来ます。
恐らく、0.1秒以内で表示が切り替わりますので、画面のちらつきをほとんど感じません。
自分で言うのも何ですが、この使い勝手の良さは、素晴らしいの一言です。
「馬吉」の改造が面倒なのは、似たような処理をあちらこちらで行っているためです。
動作の変更を行おうとしても、どのモジュールで処理を行っているのかが判りません。
場合によっては、あちこちで変更してしていますから、最終的に変更している箇所を探さなければなりません。
かと言って、むやみにいじると異常動作をしたりしますので注意深く行わなければなりません。
クラスモジュールの clsPointer を削除しようと思ったのは、マウスの動作を制御している部分を探していた時です。
このクラスモジュールは、マウスのポインターを砂時計にするのかデフォルトにするのかの処理しか行っておりません。
そこで、このクラスモジュールを呼んでいる所を探した所2か所ありましたが、1か所(ctlVHCSel)は使われておりませんでしたので、残りの1か所(ChangeViewer)にはクラスモジュールを呼ばないで、直接ポインターの制御プログラムを記入しました。
この程度の変更で何かがどうにかなるような変化はありませんが、少しでもプログラムを見易くしたいと言う思いから変更しました。
だいぶ以前から気にはなっていたのですが、スプラッシュウィンドウの表示時間がやけに短い。
「馬吉」のスプラッシュウィンドウには、表示の待ち時間を考慮してアニメーションまで用意されているのですが、それを眺めている時間もないほど開いたと思ったら直ぐに閉じてしまう。
私のパソコンは高速なんだなあ・・ぐらいにしか感じていなかったのだが、スプラッシュウィンドウの表示中に重い動作を組み込んでも起動時に砂時計の表示期間が長くなるだけで画面の表示は一瞬なので調べてみました。
すると、このウィンドウの表示のコマンドがプログラムに組み込まれておりません。
一応、フォームのロードプログラムの中に Me.Show を組み込んだら、0.5秒程度の表示時間だったのが、数秒の表示時間に拡大しました。
これで、つまらないアニメーションも楽しむ事が出来るようになった。
「馬吉」のスプラッシュウィンドウは飾りに近いものだが、私の場合はスプラッシュウィンドウの中でパソコンの日付を確認したり、必要なファイルがあるかどうかだとか、データベースに接続して次の競馬の開催日を調べたりしている。
それだけではつまらないので、どうせ飾りに近いものなら奇抜なファームを表示させる事にした。
本当はアニメーションでもやりたいのだが、データベースに接続してりしているので、空き時間がなくてできないからである。
そこで、いわゆる変形ウィンドウにして目を引こうと思ったのである。
フォームの角を丸くしたりするのが一般的なのだが、フォームに画像を取り込んでそれを表示させる事にした。
画像の背景を透過にすれば、どんな形のフォームでも出来る事になる。
サイトでフォームの透過をキーにして調べて見ると簡単に見つかった。
最初はフォームにピクチャーボックスを入れて、そこに画像を取り込んでピクチャーボックスの背景を透過にする事を考えたのだが、それよりもフォームに直接画像を取り込んで方が簡単である。
しかも、取り込む画像をgif形式にして、その画像を透過処理しておれば、その画像の形がフォームの形になる。
gif形式が出来るからpng形式も出来るだろうとおもったのだが、VB6 では駄目なようである。
別に変形フォームを作る事が目的ではないので、つでにbmp 形式の画像ファイルも取り込めるようにしておいた。
以下が今回使用したプログラムコードである。
他の処理用のコードも書いてあるので、不要な部分もある。
他のサイトの解説の通りをコピーさせていただいたもので、私は何も考える必要はありませんでした。
Option Explicit Private Declare Function SetWindowLongW Lib "user32" (ByVal hWnd As Long, ByVal Index As Long, ByVal NewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal Key As Long, ByVal Alpha As Byte, ByVal Flag As Long) As Long Private Const GWL_EXSTYLE As Long = -20& Private Const WS_EX_LAYERED As Long = &H80000 Private Const LWA_COLORKEY As Long = 1& Private Const LWA_ALPHA As Long = 2& Private Sub Form_Load() On Error GoTo ErrorHandler Dim rs2 As ADODB.Recordset Dim NextRaceDate As String Dim status As Long Dim hizuke As String Dim cfso As Scripting.FileSystemObject Set cfso = New Scripting.FileSystemObject Me.lblVersion.Caption = " Ver 1.00 " If cfso.FileExists(App.Path & "\Umachan.bmp") Then Me.Picture = LoadPicture(App.Path & "\Umachan.bmp") AutoRedraw = True BackColor = vbCyan Label1.ForeColor = vbYellow SetWindowLongW hWnd, GWL_EXSTYLE, WS_EX_LAYERED SetLayeredWindowAttributes hWnd, vbCyan, 0&, LWA_COLORKEY ElseIf cfso.FileExists(App.Path & "\Umachan.gif") Then Me.Picture = LoadPicture(App.Path & "\Umachan.gif") AutoRedraw = True BackColor = vbCyan Label1.ForeColor = vbYellow SetWindowLongW hWnd, GWL_EXSTYLE, WS_EX_LAYERED SetLayeredWindowAttributes hWnd, vbCyan, 0&, LWA_COLORKEY End If Me.Show DoEvents 以下省略
Umachan.bmp か Umachan.gif が存在していれば、それをスプラッシュウィンドウにコピーするだけである。
フォルダ内からコピーするようにしたのは、使用者が自分のお気に入りの画像を設定できるようにするためである。
たかだか1〜2秒の間だけの表示だが、短いだけにえげつない画像でも表示させる事ができる。
遊び心としては、面白いのではないだろうか。
作成する画像データは320ドット×320ドットでフォーム画面一杯に収まる状態にしてあります。
画像ファイルが存在しない場合には、従来の味気ない画面が表示される。
移植版のプログラムでは買い目の設定とIPTの投票機能も組み込む事にしました。
買い目の設定は私が普段慣れているターゲットの方式を取る事にしました。
新しいフォームを表示して、その中に1〜18頭までの番号のラベルがあって、投票方式を単勝とか複勝とか馬連と選んで設定する方式です。
IPTの投票機能はエクセルでも既に使用しておりますので、それを移植するだけです。
IPATの投票方式はこまめに探せばサイト上にはIPATの方式を解明しておられる方が居て色々解説が載っております。
買い目の操作盤を作って買い目の入力をしている時に、馬番と馬名の表示が離れている点が気になりました。
「馬吉」では間にブリンカーの装着の有無と馬記号の表示が入るだけですが、私の移植版はその他に予想印を4種類入れておりますので間が4cm程度は空きます。
それでも目で追っていけない事は無いのですが、やはり空き過ぎだと思いました。
フレックスグリッドの枠線の色を濃くするとか、バックカラーの色を1段毎に変えるとかのやり方もありますが、私はそれは増々見にくくなるように思います。
バックカラーは一定にしてグリッド線の色もバックカラーと同じにしているターゲットのようなやり方がむしろ見易い場合があります。
グリッド線の色は存在しているのは判るが、目立たないように淡い色にして馬番と馬名は隣接させる事にしました。
予想印は最善列に持っていったので、レイアウトに違和感が生じないように先頭列に番号を入れました。
番号は馬番と同じなのですが、これを固定列にする事でレイアウトはすっきりしました。
馬番と馬名は馬券の投票には重要ですから、これが隣接しているのは見やすいですし、投票の入力ミスも防げると思います。
「馬吉」には競走結果を表示する項目の中に異常と言う名前の項目があります。
ご存じの通り、異常と言う項目はレースで発走除外になったり、レース中で競走を中止した馬がいた場合にそれを示す内容が記載されています。
競馬をやったことのある人がプログラムを組むのであれば、このような事は頻繁に発生するものではない事を知っていますので、わざわざ項目を設けて表示したりはしないのですが、多分競馬をやらない人がプログラムを組んだのだろうと私は考えています。
異常の表示は必ず行わなけれなりませんが、項目まで設ける必要はありません。
異常が発生した場合は、私は着順の表示欄に表示させるようにしました。
他の人が作成したプログラムでも特定の項目の中に一緒に表示させるのが一般的です。
このように変更する事で、レース結果の表示欄もすっきりして見易くなりました。
「馬吉」では出馬表の開催年度選択を表示した場合に、ちょうど開催時期の位置で表示が止まるようになっています。
レースの開催予定は12月まであるのですが、例えば現在が3月なら3月の開催レースが表示される訳です。
これは当たり前の機能と言うべきものなのですが、例えば去年のレースの内容を表示してから今年の開催選択に移ると表示が12月になってしまいます。
なぜなのかと調べて見ると、この処理はユーザーコントロール(ctlVRAKaiSel)の mData_FetchComplete で行っており、年度や場所を変更した場合には、その変更した時の行を選ぶようになっています。
しかもこの処理は、わざわざクラスモジュール(clsVSYearJyo)を作成して変更の有無をチェックしている程ですから、余程の理由があるのだと思われます。
しかし、私にはそこまでしなければならない理由が判りませんでした。
なにか不都合が起きる場合があるのを、私は見落としているのかも知れませんが、変更して見る事にしました。
変更は以下のようにコメントアウトするだけです。
' 行の移動
'If mViewerState.IsNoTouch Then
For i = 0 To .Rows - 1
If flexTab.HasKey(i, 4) Then Exit For
Next i
'Else
'i = IIf(mViewerState.row > 0, mViewerState.row, 1)
'End If
以前はelseの部分で処理されていたのが常にリンクのある部分で表示が止まるようになります。
この方が当然快適です。
そのうちにあっと驚くような事態が起きて、慌てて元に戻すようになるかも知れません。
「馬吉」ではレースの開催選択を行う場合にタブダイアログ(SSTab)を使用しております。
タブダイアログを使用していても選択できるのは1つだけですから、わざわざタブダイアログを使用する必要性はありません。
恐らくは、当初の計画では開催選択と同時にレース内容や結果も表示するつもりだったのでしょうが、止めたのだと思います。
実は、私も開催選択のタブの中にレース選択や結果を入れて動かしてみたことがあるのですが、時折プログラムの画面が乱れて落ちるのです。
OSの動作もおかしくなる状況で、推定ですがメモリーの使用限界に達した場合にこうなるのだと思います。
この現象を食い止めるために、色々やってはみたのですが、私の技術レベルでは無理でした。
開催選択だけを独立させた場合には、めったに落ちませんので以後開催選択は独立させて動作させております。
それでタブダイアログは不要なのですが、あっても格別邪魔になる訳ではありませんでしたので、そのままにしておりました。
下手にいじるとトラブルに巻き込まれる場合もないとは言えないからです。
改造が進んでくると、不要なものを残したままにしておくのはいかがなものか(国会答弁的表現)と感じましたので削除する事にしました。
「馬吉」でも残したままにしておりますので、妙なトラブルが起きなければ良いがと思って心配しておりましたが、あっさりと削除は完了しました。
これを行ってどんなメリットがあるのかと言われそうですが、デザイン的にもリソースの消費についても格別なメリットは無いと思います。
しいて理由を挙げれば、素人プログラマーの良心に従っただけと言えます。
「馬吉」の改造版では、出馬表の馬名をクリックした時にその馬の過去走を表示する事が出来る。
オリジナル版でもこの機能はあったのだが、画面が変わったり色々な内容を同時に表示したりするので、時間も掛かる点も気になったので、馬の過去走だけを同じ画面の下方に表示させるように変更した。
こんな機能はごく当たり前の機能でターゲットなどにも当然あるのだが、ターゲットの場合は別ウィンドウで開くようになっているのと表示が瞬時とはいかないので、メモリーキャッシュがある場合でも、0.2〜0.3秒程度が掛かる。
ただ、表示時間が多少速い程度では面白くないので、馬の過去走だけではなく騎手や調教師や馬主や生産者の過去走も表示させるようにした。
この機能はターゲットにもない。
騎手の過去走の表示は馬と同様にすれば良かったので問題はなかったのだが、調教師や馬主や生産者の過去走を表示するのは簡単ではなかった。
ご推察の通りこれらの場合は、1レースに2頭以上の馬を出走させている場合が数多くあって表示が単純ではないのである。
全ての競馬場での全レースで、同じレースに2頭以上出走させていないかを調べて表示させる必要がある。
面倒だったので、1レースに1頭だけにしてごめんなさいにしようかと思ったのだが、3流プログラマーである事がバレバレになるので何とかする事にした。
どうやるかだが、結論を言えばレースの開催日時と場所とレース番号の他に馬の血統番号も管理しなければならない事になる。
これだけのデータで何とか表示はできるのだが、まともに検索していたのでは表示までにえらく時間が掛かるので、データベースに過去走のデータを登録させる事にした。
1走前のデータ、2走前のデータ・・・と言ったような具合である。
どの程度前までにしようかと考えたのだが、10走前ではちょっと少なすぎる気がしたので15走前までにしたのだが、それでも気持ち少ない感じがしたので最終的には20走前までのデータを記録する事にした。
データの登録はJRA-VANからのデータの取り込み時に行うので、その分普通より時間は掛かるが表示させて見るとなかなか面白い。
この馬主は最近儲かっていないとか、この生産者の馬は良く走るとかが見えてくるのである。
ひょっとしたら、競馬予想に役立つ情報となるかも知れません。
表示例として中山グランドジャンプ(GT)レースで武宏平調教師を選択した画面です。
この調教師は同レースに2頭出走させておりましたが、2頭共に表示されているのが確認できます。
これで万々歳のようですが実はそうではありません。
データベースへの登録方法が追加する度に前走データを1行ずらすだけなので、登録日を戻して再登録をすると順番がずれてしまうのです。
これを解決するには前走のデータ部分だけを再構築する手段を設けるか、以前のデータ内容を確認しながら割り込ませてデータを登録する必要があります。
どちらも面倒そうな感じなので、今度こそごめんなさいにしようかと思っております。
ズレても再登録さえしなければ、やがては自然に整列していきますから。
2010年の4月19日(月)に福島で4月17日の全レースが中止になった代替競馬が開催されました。
私の作成した「馬吉」の移植版で出馬表から当日のレースを選択しようと思いましたが、出馬表に表示されません。
なぜなのかと言うと、私の移植版では開催予定(スケジュール)データを出馬表のデータとして表示しているからです。
本来は臨時開催の場合でも、開催予定(スケジュール)に追加すべきだろうと思うのですが、JRA-VANでは、そのようにしておりません。
あくまで開催予定は開催予定データで臨時開催は予定外だから載せる必要が無いと言う認識なのでしょう。
載せていないものは表示のしようがありませんので、対策を考える必要があります。
最初に思いつくのは、「馬吉」のオリジナルのように、出馬表はスケジュールデータとレースデータの両方を参照して作成する方法です。
他のソフトもレースデータから出馬表を作成しておりますし、これが自然で正統派的な方法です。
私がスケジュールデータを出馬表代わりにしているのは、圧倒的なデータ量の少なさです。
スケジュールデータが西暦2000年からJRA−VANから供給されている事もあるのですが、データの項目も少ないですから内容の表示がレースデータから行うよりも数分の1で済むのです。
年に1回あるかないかだけの臨時開催のために、出馬表の作成をスケジュールデータからレースデータに変更する気にはなれません。
かと言って、臨時開催の出馬表が表示できないのではひどすぎるでしょうから、対策を考える事にしました。
色々と考えましたが、「馬吉」のオリジナルのように出馬表の作成をレースデータとスケジュールデータを用いてデータの登録時に行うのは確実ですが、データの作成に時間も掛かるし、臨時開催も少ない事から止める事にしました。
それでどうやるかですが、出馬表に記載されていないレースの出馬表を表示するには、直接レース開催日を入力させる事にしました。
具体的には、インプットボックスを表示して、そこに開催日を入力させる方法です。
百聞は一見にしかずですから、実際の表示画面は以下のようになります。
メニュー画面でシフトキーを押した時にインプットボックスが表示されるようになっております。
こんな機能がある事などは、使用説明書を熟読した人でなければ判らないでしょうが、私はそれでも良いと思っています。
臨時開催のレースに参加する人は、相当の競馬好きな人達に限定されるでしょうし、ソフトの説明書も満足に読んでいない人には使って貰いたくないと思っているからです。