お絵かきロジックアナライザ開発記   その13

ようやく簡単なお絵かきロジックを解くことができましたが、ここで分析機能以外の部分を触っていきます。例えば分析が終わったのなら「終わりましたよ」と告げてくれるアラートが欲しくないですか?せっかくヒントを入力したなら、それをデータとして保存しておきたくありませんか?ヒント入力時のセル移動が入力順と一致しないと入力しづらくありませんか?ここではそのような分析支援機能をアクセサリとして加えていきます。

分析終了の告知

ロジックを解くことはできたものの「ここで終わり」というメッセージがないと、終わった感が薄いので、メッセージボックスで終了告知を行います。今まではヒントの入力内容にエラーがあったときだけエラーメッセージが表示されるようになっていましたが、分析終了告知も同じように行います。

分析中に塗潰し、あるいは空白が確定したらその数をカウントし、全マスの数と一致していれば分析終了、そうでなければ最後まで分析できずにループを抜けたと判断するようにしたいので、そのための変数が必要になります。

Option Explicit
Option Base 1                                     '配列最小添字=1
' モジュール内共用定数宣言
    ....

    ....
' モジュール内共用変数宣言
Dim HintLen As Integer                            '列内ヒント数
Dim HintSumHrz As Integer                         '水平ヒント値合計
Dim HintSumVrt As Integer                         '垂直ヒント値合計
Dim FieldSqr As Long                              'フィールドセル数
Dim MarkedCnt As Long                             '解決セル数
Dim ScanCnt As Integer                            'スキャンカウンタ
Dim HintCnt As Integer                            'ヒントカウンタ
    ....

Sub AnalyzeSheet(Optional ByVal CallSwitch As Boolean)
' シート分析
  '＜初期設定＞
  FieldSqr = CLng(FieldWd) * CLng(FieldHt)        'フィールドセル数算出
  MarkedCnt = 0                                   '解決セル数初期化
  ReDim ImgField(FieldHt, FieldWd)                '描画フィールド領域再定義
    ....

    ....
  '＜フィールド分析＞
  NonoModule.BlackOutCheck                        '初回塗潰しチェック
  Do
    LpStp1 = False                                '進捗フラグ初期化
    NonoModule.PSSrenewal                         '候補範囲更新
    NonoModule.BlackOutCheck                      '塗潰しチェック
    If Discrep Then Exit Do                       'エラーチェック
      If ErrorMsg = vbNullString Then _
        ErrorMsg = "分析中にエラーが発生しました"
      Exit Do       
    End If
    If MarkedCnt = FieldSqr Then Exit Do
  Loop While LpStp1
  '＜終了表示＞
ExitAnalyzeSheet:
  If Discrep Then                                 '矛盾チェック
    MsgBox ErrorMsg, vbCritical + vbOKOnly, "分析エラー"
  Else
    If MarkedCnt = FieldSqr Then
      MsgBox "分析が終了しました", vbOKOnly, "分析終了"
    Else
      MsgBox "分析が終了しませんでした" & vbNewLine & "進捗率 " _
        & CStr(Int(MarkedCnt / FieldSqr * 100)) & "%", vbOKOnly, "分析終了"
    End If
  End If
End Sub

Sub PutBlack(ByVal VrtPos As Byte, ByVal HrzPos As Byte)
' 塗潰し設置
  ImgField(VrtPos, HrzPos) = ImgField(VrtPos, HrzPos) Or BlackConc
  NonoWorksheet.Cells(HintHt + VrtPos, HintWd + HrzPos).Interior.ColorIndex = 16
  LpStp1 = True
  MarkedCnt = MarkedCnt + 1
  Discrep = ((ImgField(VrtPos, HrzPos) And MaskPtn) = Discrpnc)
End Sub

Sub PutWhite(ByVal VrtPos As Byte, ByVal HrzPos As Byte)
' 空白設置
  ImgField(VrtPos, HrzPos) = ImgField(VrtPos, HrzPos) Or WhiteConc
    ....

    ....
  End With
  LpStp1 = True
  MarkedCnt = MarkedCnt + 1
  Discrep = ((ImgField(VrtPos, HrzPos) And MaskPtn) = Discrpnc)
End Sub

分析が終了すると終了メッセージが表示されるようになり、分析が完了しなかった場合は進捗率が表示されます。また矛盾発見時のエラーメッセージが手付かずだったので、ここで一緒にケアしておきました。

ヒントデータの保存 その1

例題の難易度を上げて15×15の「こいのぼり」的なデザインを作ってみました。ここまでのサイズになると、ヒントの入力もひと手間なので、何かあったときのバックアップとしてデータを保存しておきたくなります。ワークシートをそのまま保存してもイイのですが、できればブックとして保存するのではなく、“お絵かきロジックのデータ”として保存しておきたいので、Excelからファイル操作してみましょう。ブックとして保存するよりもファイルサイズを小さくできるのでディスクスペースの節約になります。何もないサラピンの新規Excelファイルを作った場合でも10kバイト程度、ここまでコーディングを進めてきたExcelファイルなら100kバイト程度になっているハズです。専用フォーマットのデータファイルなら、これを1kバイト以下に抑えられることが期待できます。

ここでやろうとしているのは、メニューバーの[ファイル]から[名前を付けて保存]とか[上書き保存]などのコマンドを使用するのではなく、[Nonogram]メニューに保存コマンドを追加するというコトです。当然、保存したデータを呼出すための[開く]コマンドも併せて必要になります。簡単に済ませるならCSV形式などで保存するテもありますが、ここではちょっと踏込んでバイナリ形式での保存に挑戦します。16進数に慣れていないと、少々難解になってしまうかも知れません。

ところで、ヒントを入力してみると、今回始めて登場した2桁のヒント値が表示できなくなってしまいました(セルに#マークが出る)。左から3列目の縦ラインで‘15’の部分です。そこで[書式][セル]コマンドの[配置]タブにある「縮小して全体を表示する」にチェックを入れる操作を、ヒント入力欄に適応しておきましょう。ついでに入力規則に関しても手を加えておきます。

Sub NewLogicSheet(Optional ByVal CallSwitch As Boolean)
' 新規ロジックシート作成
  Dim StartPos As Integer                         '太線描画ポインタ
    ....

    ....
    Next StartPos
    .Range(.Cells(1, 1), .Cells(HintHt, HintWd)) _
      .Interior.ColorIndex = 15                   '左上無効領域
  End With
  With Range(Cells(1, HintWd + 1), Cells(HintHt, HintWd + FieldWd))
    .NumberFormat = "0"                           'ヒント部書式設定
    .ShrinkToFit = True
    With .Validation                              'ヒント部入力規則設定
      .Delete
      .Add xlValidateWholeNumber, xlValidAlertStop _
        , xlBetween, "1", CStr(FieldHt)
      .IgnoreBlank = True                         '空白有効
      .InCellDropdown = False                     'ドロップダウン無効
      .IMEMode = xlIMEModeOff                     'IME オフ
      .ShowInput = False                          '入力メッセージ無
      .InputTitle = vbNullString
      .InputMessage = vbNullString
      .ShowError = True                           'エラーメッセージ設定
      .ErrorTitle = "ヒント値エラー"
      .ErrorMessage = "垂直ヒントに使用できる値は 1 〜 " _
        & CStr(FieldHt) & " です。"
    End With
  End With
  With Range(Cells(HintHt + 1, 1), Cells(HintHt + FieldHt, HintWd))
    .NumberFormat = "0"                           'ヒント部書式設定
    .ShrinkToFit = True
    With .Validation                              'ヒント部入力規則設定
      .Delete
      .Add xlValidateWholeNumber, xlValidAlertStop _
        , xlBetween, "1", CStr(FieldWd)
      .IgnoreBlank = True                         '空白有効
      .InCellDropdown = False                     'ドロップダウン無効
      .IMEMode = xlIMEModeOff                     'IME オフ
      .ShowInput = False                          '入力メッセージ無
      .InputTitle = vbNullString
      .InputMessage = vbNullString
      .ShowError = True                           'エラーメッセージ設定
      .ErrorTitle = "ヒント値エラー"
      .ErrorMessage = "水平ヒントに使用できる値は 1 〜 " _
        & CStr(FieldWd) & " です。"
    End With
  End With
End Sub

ちょっと脇道にそれましたが、ここからはデータファイルの読書きに手を付けて行きます。まずはファイル操作に関するコマンドをメニューに追加しておきましょう。メニューグループを区分するラインも入れています。メニューから呼出されるプロシージャの雛形もNonoModuleに追加しておきます。

Sub NonoMenuAdd(Optional ByVal CallSwitch As Boolean)
' メニュー追加
  Dim MenuBar As CommandBar                       'メニューバーオブジェクト
  Set MenuBar = Application.CommandBars("Worksheet Menu Bar")
  If MenuBar.FindControl(Tag:="Nonogram") Is Nothing Then
    With MenuBar.Controls.Add(Type:=msoControlPopup)
      .Caption = "Nonogram(&N)"                   'メニュー追加
      .Tag = "Nonogram"
      With .Controls.Add                          'コマンド追加
        .Caption = "新規作成(&N)"
        .OnAction = "NonoModule.FieldSizeDialog"
        .FaceId = 18
      End With
      With .Controls.Add(msoControlButton)
        .Caption = "開く(&O)"
        .OnAction = "NonoModule.OpenHintFile"
        .FaceId = 23
      End With
      With .Controls.Add(msoControlButton)
        .Caption = "上書き保存(&S)"
        .OnAction = "NonoModule.SaveHintFile"
        .FaceId = 3
      End With
      With .Controls.Add(msoControlButton)
        .Caption = "名前を付けて保存(&A)"
        .OnAction = "NonoModule.SaveAsHintFile"
      End With
      With .Controls.Add
        .Caption = "イメージ消去(&E)"
        .OnAction = "NonoModule.EraseImg"
        .FaceId = 47
        .BeginGroup = True
      End With
      With .Controls.Add
        .Caption = "シート分析(&Z)"
        .OnAction = "NonoModule.AnalyzeSheet"
        .FaceId = 532
      End With
    End With
  End If
  Set MenuBar = Nothing                           'オブジェクト変数開放
End Sub

Sub OpenHintFile(Optional ByVal CallSwitch As Boolean)
' 開く
End Sub

Sub SaveHintFile(Optional ByVal CallSwitch As Boolean)
' 上書き保存
End Sub

Sub SaveAsHintFile(Optional ByVal CallSwitch As Boolean)
' 名前を付けて保存
End Sub

それでは実際のファイル操作を行っていきます。まずは保存コマンドから手を付けていきますが、バイナリ形式ですのでデータをどのように配置して行くのか、キチンと計画を立てて進めなければなりません。ヒント値はInteger型で扱っているので、16ビットバイナリが基本です。つまり5×5のロジックでは、水平ヒント3×5、垂直ヒント3×5なので、そのまま素直に並べていけば60バイトのデータとなります。しかしヒント値がないマスも保存対象とするのはゼロが連続で書込まれるコトになり少々シャクなので、「ヒント数+ヒント値」の形にします。小さなサイズのロジックではそれほど変わりませんが、サイズが大きくなるにつれてファイルサイズ縮小の効果が出てきます。

今からプログラミングして行くセーブ処理を実行すると、以下のようなデータが作られます。フィールドサイズとヒントサイズを水平、垂直の順に書込み、続けて水平ヒント1行目から、ヒント数とヒント値を収納して行く構造です。

ADDR : +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F
―――――――――――――――――――――――――――
0000 : 0F 00 0F 00 08 00 08 00 03 00 01 00 01 00 01 00
0010 : 01 00 05 00 03 00 01 00 01 00 01 00 02 00 01 00
0020 : 09 00 03 00 01 00 02 00 01 00 05 00 01 00 01 00
0030 : 01 00 02 00 01 00 04 00 02 00 01 00 02 00 01 00
0040 : 04 00 01 00 01 00 01 00 01 00 03 00 01 00 02 00
0050 : 01 00 02 00 01 00 09 00 01 00 01 00 01 00 01 00
0060 : 02 00 01 00 09 00 03 00 01 00 02 00 01 00 05 00
0070 : 01 00 01 00 01 00 02 00 01 00 01 00 03 00 01 00
0080 : 01 00 01 00 0F 00 02 00 01 00 01 00 04 00 03 00
0090 : 01 00 01 00 01 00 03 00 01 00 01 00 01 00 02 00
00A0 : 07 00 03 00 03 00 01 00 01 00 01 00 05 00 01 00
00B0 : 02 00 01 00 01 00 01 00 05 00 01 00 02 00 01 00
00C0 : 01 00 01 00 03 00 01 00 01 00 01 00 03 00 02 00
00D0 : 02 00 02 00 05 00 01 00 03 00 01 00 01 00 01 00
00E0 : 03 00 01 00 01 00 01 00 03 00 01 00 01 00 01 00

赤で示した部分がフィールドサイズとヒントサイズに関する数値です。水平15行、垂直15列なので000Fh、000Fhが書込まれますが、リトルエンディアンなので、上下バイトがひっくり返っています。つまり0Fh、00hと並んでいるのを‘00h×10h+0Fh=000Fh’と解釈して下さい。青い部分がヒント数とヒント値で、最初が水平1列目なのですが、ヒント数3、ヒント値は1、1、1と並んでいることが解ります。

ヒントファイルのパス名はシステム情報としてデータを保存するSystemWorksheetのC1セルに書込むこととし、そこに関連付けるファンクションプロシージャを準備しておきます。

Function HintFilePath() As Range
' ヒントファイルパス
  Set HintFilePath = SystemWorksheet.Range("C1")
End Function

まずは[名前を付けて保存]のファイル名をチェックするところから始めます。今扱っているヒントが既に存在するファイルを開いたものなら、HintFilePathにファイルへのパス名が書込まれているハズ(今後そのようにコーディングしていく)なので、そのチェックを行い、ファイル名がなければそのまま次に進みますが、ファイル名が存在すれば、その名前を[名前を付けて保存]ダイアログのデフォルトファイル名とします。

Sub SaveAsHintFile(Optional ByVal CallSwitch As Boolean)
' 名前を付けて保存
  Dim HintFileName As String                      'ヒントファイル名
  Dim TargetFilePath As String                    '操作対象ファイル名フルパス
  Dim TemporaryPath As Variant                    'Variant型一時変数
  HintFileName = HintFilePath                     'イニシャルファイル名取得
  If HintFileName <> vbNullString Then
    ScanCnt = Len(HintFileName)                   'パス文字列からファイル名抽出
    Do
      If Mid(HintFileName, ScanCnt, 1) = Application.PathSeparator Then Exit Do
      ScanCnt = ScanCnt - 1
    Loop
    HintFileName = Right(HintFileName, Len(HintFileName) - ScanCnt)
    ScanCnt = Len(HintFileName)
    Do
      If Mid(HintFileName, ScanCnt, 1) = "." Then Exit Do
      ScanCnt = ScanCnt - 1
    Loop
    HintFileName = Left(HintFileName, ScanCnt - 1)
  End If
  Do                                              '保存ファイル名入力
    TemporaryPath = Application.GetSaveAsFilename _
      (HintFileName, "お絵かきロジックアナライザヒントファイル,*.nng")
                                                  '[名前を付けて保存]ダイアログ
    If VarType(TemporaryPath) = vbBoolean Then _
      Exit Do                                     'キャンセルクリック時は無効
    TargetFilePath = CStr(TemporaryPath)
    If Dir(TargetFilePath) = vbNullString Then Exit Do
    If MsgBox("ファイル '" & Dir(TargetFilePath) & "' は既に存在します。" _
      & "既存のファイルを置換えますか？", vbYesNo + vbExclamation) _
      = vbYes Then Exit Do
  Loop
  If VarType(TemporaryPath) <> vbBoolean Then     'キャンセルクリック時は無効
    HintFilePath = TargetFilePath                 'ファイル名定義
    NonoModule.SaveProc                           'ファイル保存
  End If
End Sub

Sub SaveProc(Optional ByVal CallSwitch As Boolean)
' データセーブ機能部
End Sub

拡張子は“.nng”としました。お絵かきロジックを意味する“nonogram”から採っています。実際の書込処理は[上書き保存]と共通となるので、独立したサブプロシージャを準備します。つまり[上書き保存]と[名前を付けて保存]ではHintFilePathの確認と変更に関する処理が異なるだけというコトです。

フルパスからファイル名のみを抽出している部分で、Application.PathSeparatorはパスの区切文字(Windows系では¥マーク)を示しています。フルパスの右側から‘¥’を探し、最初に見付かった部分より右側を拡張子を伴ったファイル名としています。次に右から拡張子を区切る‘.’を探し、それより左側をファイル名としてHintFileNameにより、[名前を付けて保存]ダイアログのデフォルトファイル名としています。

ダイアログでキャンセルボタンがクリックされた場合の対応として、TemporaryPathがBoolean型かどうかをチェックします。GetSaveAsFilenameメソッドは、ファイル名が指定されればパス文字列を、キャンセルがクリックされた場合はブール型のFalse値を返すので、それを受取るTemporaryPathをVariant型で定義しておけば、TemporaryPathの変数型によってキャンセルを判別できます。TemporaryPathを文字列型で定義すると、キャンセル時に“False”という文字列に変換したものが収納されてしまい、ファイル名がもし“False”だった場合に区別がつきません。

今後のファイル操作に当ってはファイル名の管理以外にも様々なエラーチェックが必要になります。ファイル名管理は、例えば[上書き保存]の際にターゲットとなるファイルを特定するために必要です。まだファイル名が決まっていないのに[上書き保存]コマンドが実行された場合は[ファイル名を付けて保存]に進まなければならないなど、厳密なファイル名管理をしておく必要があります。またエラーチェックについては、ファイル操作となるとディスク破損などの物理的なエラーも含めて「なかなか思い通りに処理されない」という事態が予測されますので、しっかりとチェックしていかなければなりません。プログラムがイイ加減だと、最悪の場合ハードディスクにダメージを与えてしまいかねないので注意しましょう。

ではセーブ機能部をコーディングしてヒントデータを保存してみます。上記のようなエラーチェックに関しては後で付け加えるものとして、まずは保存機能のみを考えて行きます。

Sub SaveProc(Optional ByVal CallSwitch As Boolean)
' データセーブ機能部
  Dim FileNum As Integer                          'ファイル番号
  ReDim HintHrz(FieldHt, HintWd)                  'ヒント領域再定義
  ReDim HintVrt(FieldWd, HintHt)
  ReDim HintCntHrz(FieldHt)                       'ヒント数領域再定義
  ReDim HintCntVrt(FieldWd)
  For ScanCnt = 1 To FieldHt                      '水平ヒント領域ループ
    HintLen = 0                                   '列内ヒント数クリア
    For HintCnt = 1 To HintWd
      With NonoWorksheet.Cells(HintHt + ScanCnt, HintCnt)
        If CInt(.Value) > 0 Then                  'ヒント値がゼロでなければ...
          HintLen = HintLen + 1                   '列内ヒント数加算
          HintHrz(ScanCnt, HintLen) _
            = CInt(.Value)                        'ヒント値左詰転送
        End If
      End With
    Next HintCnt
    HintCntHrz(ScanCnt) = HintLen                 'ヒント数保存
  Next ScanCnt
  For ScanCnt = 1 To FieldWd                      '垂直ヒント領域ループ
    HintLen = 0                                   '列内ヒント数クリア
    For HintCnt = 1 To HintHt
      With NonoWorksheet.Cells(HintCnt, HintWd + ScanCnt)
        If CInt(.Value) > 0 Then                  'ヒント値がゼロでなければ...
          HintLen = HintLen + 1                   '列内ヒント数加算
          HintVrt(ScanCnt, HintLen) _
            = CInt(.Value)                        'ヒント値上詰転送
        End If
      End With
    Next HintCnt
    HintCntVrt(ScanCnt) = HintLen                 'ヒント数保存
  Next ScanCnt
  On Error Resume Next                            '既存同名ファイル削除
  Kill HintFilePath
  On Error GoTo 0
  FileNum = FreeFile(0)                           '使用可能ファイル番号取得
  Open HintFilePath For Binary Access Write Lock Write As #FileNum
  Seek #FileNum, &H1                              'ファイルオープン
  Put #FileNum, , CInt(FieldWd)                   'フィールドサイズ書込
  Put #FileNum, , CInt(FieldHt)
  Put #FileNum, , CInt(HintWd)
  Put #FileNum, , CInt(HintHt)
  For ScanCnt = 1 To FieldHt
    HintLen = HintCntHrz(ScanCnt)
    Put #FileNum, , CInt(HintLen)                 '水平ヒント数書込
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen                  '水平ヒント値書込
        Put #FileNum, , CInt(HintHrz(ScanCnt, HintCnt))
      Next HintCnt
    End If
  Next ScanCnt
  For ScanCnt = 1 To FieldWd
    HintLen = HintCntVrt(ScanCnt)
    Put #FileNum, , CInt(HintLen)                 '垂直ヒント数書込
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen                  '垂直ヒント値書込
        Put #FileNum, , CInt(HintVrt(ScanCnt, HintCnt))
      Next HintCnt
    End If
  Next ScanCnt
  Close #FileNum                                  'ファイルクローズ
End Sub

セル上のヒント値を内部変数に取込むために、分析プロシージャでも使っているHintHrz/HintVrt配列を利用しています。またヒント数も同様にHintCntHrz/HintCntVrtの流用です。上書き保存のことを考えて、Killコマンドで対象ファイルを削除していますが、新規保存ではファイルが存在せず、Killコマンドが実行できないためエラーを生じるので、On Error Resume Nextでエラーを無視しています。つまりファイルが既に存在していればそのファイルは削除、存在しなければ結果的に何もしないという処理です。その後、指定ファイルをバイナリモードでオープンし、先述の通りの順序でデータを書込んで行きます。エラートラップは整備されていないものの、機能としては問題ないので、ここで一度データ書込みを行ってみましょう。メニューバーの[Nonogram]から[名前を付けて保存]コマンドをクリックし、ダイアログでファイル名を指定してOKをクリックして下さい。作成されたファイルをバイナリエディタで開き、上記のようなデータフォーマットになっているか確認しましょう。再度[名前を付けて保存]を実行した際に、今付けたファイル名がデフォルトファイル名になっているかも確認しておいて下さい。

ヒントデータの保存 その2

続いて[上書き保存]コマンドをコーディングして行きます。ファイル保存に関する機能の大部分は既にでき上がっているので、それほど難しくはありませんね。

Sub SaveHintFile(Optional ByVal CallSwitch As Boolean)
' 上書き保存
  If LCase(Right(HintFilePath, 4)) = ".nng" Then
    NonoModule.SaveProc                           '保存プロシージャ
  Else
    MsgBox "ファイル名が付けられていません", vbOKOnly, "上書き保存"
    NonoModule.SaveAsHintFile                     '拡張子不一致：別名保存
  End If
End Sub

システムシートに設定してあるパスの末尾が“.nng”であるかどうかをチェックします。パス設定に不備があればメッセージを表示した上で[名前を付けて保存]コマンドに移行となります。ファイル名がなければパス文字列は空白なので、不一致と同様の結果となります。

ここで「ファイル名がなければパス文字列は空白」であるというタテマエを実現するために、[新規作成]コマンド実行時は「パス文字列を空白にする」という操作が必要になりますので、ケアしておきます。

Sub NewLogicSheet(Optional ByVal CallSwitch As Boolean)
' 新規ロジックシート作成
  Dim StartPos As Integer                         '太線描画ポインタ
    ....

    ....
      .ErrorMessage = "水平ヒントに使用できる値は 1 〜 " _
        & CStr(FieldWd) & " です。"
    End With
  End With
  HintFilePath = vbNullString                     'ヒントファイル名クリア
End Sub

ヒントデータの読込み

ヒント値を目的通りの形式でセーブできることを確認したら、次にデータロードを行う[開く]コマンドをコーディングしていきます。データセーブと表裏一体な感じのプログラムなので、ここまでの流れを理解できていれば、それほど難しくはないでしょう。

Sub OpenHintFile(Optional ByVal CallSwitch As Boolean)
' 開く
  Dim TemporaryPath As Variant                    'Variant型一時変数
  TemporaryPath = Application.GetOpenFilename _
    ("お絵かきロジックアナライザヒントファイル,*.nng")
                                                  '[ファイルを開く]ダイアログ
  If VarType(TemporaryPath) <> vbBoolean Then
    HintFilePath = CStr(TemporaryPath)
    If LCase(Right(HintFilePath, 4)) = ".nng" Then
      NonoModule.LoadProc TargetFilePath          'ファイル読込
    Else
      MsgBox "ファイル形式が一致しません", vbOKOnly + vbCritical, "開く"
    End If
  End If
End Sub

[ファイルを開く]ダイアログからターゲットパスを取得する変数をVariant型にしているのはデータセーブ時と同様の理由です。これによりダイアログのキャンセルボタンをクリックした場合にヒントの読込みを行わないようにしています。一応、拡張子のチェックを行っていますが、GetOpenFilenameプロパティで拡張子を指定しているので、エラーが発生することはないでしょう。

Sub LoadProc(Optional ByVal CallSwitch As Boolean)
' データロード機能部
  Dim FileNum As Integer                          'ファイル番号
  Dim ReadData As Integer                         '読込データ
  FileNum = FreeFile(0)                           '使用可能ファイル番号取得
  Open HintFilePath For Binary Access Read Lock Write As #FileNum
  Seek #FileNum, &H1                              'ファイルオープン
  Get #FileNum, , ReadData                        'フィールドサイズ取得
  FieldWd = ReadData
  Get #FileNum, , ReadData
  FieldHt = ReadData
  Get #FileNum, , ReadData                        'ヒントサイズ取得
  HintWd = ReadData
  Get #FileNum, , ReadData
  HintHt = ReadData
  ReDim HintHrz(FieldHt, HintWd)                  'ヒント領域再定義
  ReDim HintVrt(FieldWd, HintHt)
  ReDim HintCntHrz(FieldHt)                       'ヒント数領域再定義
  ReDim HintCntVrt(FieldWd)
  For ScanCnt = 1 To FieldHt                      '水平ヒント読込
    Get #FileNum, , HintLen
    HintCntHrz(ScanCnt) = HintLen                 'ヒント数
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen                  'ヒント値
        Get #FileNum, , HintHrz(ScanCnt, HintCnt)
      Next HintCnt
    End If
  Next ScanCnt
  For ScanCnt = 1 To FieldWd                      '垂直ヒント読込
    Get #FileNum, , HintLen
    HintCntVrt(ScanCnt) = HintLen                 'ヒント数
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen                  'ヒント値
        Get #FileNum, , HintVrt(ScanCnt, HintCnt)
      Next HintCnt
    End If
  Next ScanCnt
  NonoModule.NewLogicSheet                        '新規シート作成
  For ScanCnt = 1 To FieldHt                      '水平ヒント値転送
    HintLen = HintCntHrz(ScanCnt)
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen
        NonoWorksheet.Cells(HintHt + ScanCnt, HintWd - HintLen + HintCnt) _
          .Value = HintHrz(ScanCnt, HintCnt)
      Next HintCnt
    End If
  Next ScanCnt
  For ScanCnt = 1 To FieldWd                      '垂直ヒント値転送
    HintLen = HintCntVrt(ScanCnt)
    If HintLen > 0 Then
      For HintCnt = 1 To HintLen
        NonoWorksheet.Cells(HintHt - HintLen + HintCnt, HintWd + ScanCnt) _
          .Value = HintVrt(ScanCnt, HintCnt)
      Next HintCnt
    End If
  Next ScanCnt
  Close #FileNum                                  'ファイルクローズ
End Sub

基本的にはデータセーブの逆手順をプログラミングしているだけなので、それほどムツかしい部分はないでしょう。FieldWdなどに数値を読込む際、ReadData変数を介しているのは、FieldWd等が変数でなく、システムシートのセルアドレスを示すファンクション名であるためです。Getコマンドは引数に変数を要するので、ReadDataを使って間接的に転送している構造です。試しにGet #FileNum, , FieldWdなどとするとエラーになります。

これで[開く]コマンドによるヒントデータ読込みが可能となります。テストしてみて下さい。

← 前へ   → 次へ ▲ ページトップ