VB(VBA)で、濁点半濁点が1文字になっているものを濁点半濁点付き文字に変換する

VBA

　必要に迫られて、というほど迫られてもいないけれど、念のための処理が必要になったので作った。
　「半角カナ」ではなく「全角カナ」になっている前提。

'全角2文字で入力されている濁点、半濁点を全角1文字に変換する（例：カ゛→ガ）
Function convZenkakuDakuten(str As String) As String
Dim tmp     As String
Dim str1    As String
Dim str2    As String
Dim i       As Integer

    tmp = Trim(str)

    str1 = "ガギグゲゴザジズゼゾダヂヅデドバビブベボ"
    str2 = "カキクケコサシスセソタチツテトハヒフヘホ"
    
    For i = Len(str1) To 1 Step -1
        tmp = Replace(tmp, Mid(str2, i, 1) & "゛", Mid(str1, i, 1))
    Next

    str1 = "パピプペポ"
    str2 = "ハヒフヘホ"
    For i = Len(str1) To 1 Step -1
        tmp = Replace(tmp, Mid(str2, i, 1) & "゜", Mid(str1, i, 1))
    Next
    
    tmp = Replace(tmp, "ウ゛", "ヴ")
    
    convZenkakuDakuten = tmp
End Function

Sub test()
    MsgBox convZenkakuDakuten(任意の文字列)
End Sub

のように呼び出して使う。

いい加減なシステム会社のいい加減なソースをリファクタリングする

Visual Basic

出先はシステム会社がVB6で作ったシステムを使っているのだが、あまりにシステム会社が駄目なので私が途中からソースを引き取って完成させたという代物。
今でも私がメンテナンス（機能追加など）を請け負っている。

どのくらいダメかと言うと、

  • 何度かの打ち合わせを経て先方から「開発期間は2007年12月〜2008年3月、リリースは2008年4月1日」というスケジュールを提示されたのに、リリース日時点で（今から考えれば）30%程度しか出来ていなかった
  • 仕様の確認が甘く「そうじゃない」と指摘する事案が多発*1
  • 2010年1月時点でも完成度が70%ほどだった

結局2010年2月から私が開発を引き継いで根幹部分をほぼ作り直したりしながら完成させたのだが、それでも正しく動いているところは基本的にそのまま使っていた。

で、今回チェック機能を追加しようとして当該箇所のソースを見てうーむ。

*1:音楽CDのデータを扱うと分かっているのに、「B'z」と入れるとアポストロフィのエスケープが行われていないためDBエラーで落ちる、など

続きを読む

VB6やVBAで「長押し」処理を実装する

VBA

未だにVB6で作られたシステムを保守している。（保守と言っても、機能追加なども普通にある）
ちなみに私が作ったものではないが、種々の事情により完全に私の管理物であり、5年ほどの間にもはや私が作ったと言っても過言ではないくらいリファクタリングした。

そのシステムで「長押ししたらクリップボードにコピー」という処理を実装しようとして躓いたのでメモ。

何に躓いたかと言うと、MouseDownイベントは押しっぱなしの間ずっと発生し続けているのかと思ったら、どれだけ長押ししようと1回しかイベント発生しないのね、という点。

ネットであれこれ見てもしっくりくるものがなかったので、自作してみた。

Private mouseDownEndTime As Double  'この時間まで押されていたら「長押し」と判断

Private Sub コントロール_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール)
End Sub

Private Sub コントロール_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール)
End Sub

'マウスが長押しされた場合に、処理を実行する
Private Sub ctrlMouseDown(ctrl As Control)
    mouseDownEndTime = getTimer() + 1   'この場合は1秒間長押ししたら処理実行
    
    Do Until mouseDownEndTime < getTimer() Or mouseDownEndTime = 0
        DoEvents  'これがないとDo Untilで回っている間のMouseUpを検知しない
    Loop
    
    If mouseDownEndTime > 0 Then  '時間が経過する前にMouseUpしていたらここがゼロなので処理を行わない

        'ここに長押し時に実行したい処理を書く

    End If
    
    mouseDownEndTime = 0
End Sub

Private Function getTimer() As Double
    getTimer = CDbl(Timer)
End Function

Private Sub ctrlMouseUp(ctrl As Control)
    mouseDownEndTime = 0
End Sub

長押し時に実行したい処理がコントロール要素と特に関係ないのであれば、引数としてコントロールを渡さなくても構わない。
私は「コントロール要素の中身をクリップボードにコピーする」という処理を入れたかったので渡しているけど。

ちなみに、VBAにはないけどVB6にはあるコントロールの配列の場合は、MouseDownとMouseUpの書き方が下記のような感じになる。（私が今回使ったのはこっち）

Private Sub コントロール_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール(Index))
End Sub

Private Sub コントロール_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール(Index))
End Sub

どこにも需要がない「今が何回戦なのかを返すFunction」を考えた

VBA WEB甲子園

トーナメント戦を扱うと、1回戦、2回戦、3回戦と進んでいくのは分かりやすいのだが、どこかで「準々決勝」「準決勝」「決勝」と表記しなければならない。

1回戦から順番に数えると6回戦なんだけど、一般的な呼称は「準決勝」のような場合。

そこで、「単純に数えて今何回戦なのか」と「出場チーム数」を渡してやれば、「○回戦」あるいは「準々決勝」「準決勝」「決勝」のような表記を返してくれるFunction「getRoundName」を考えてみた。

Private Function getRoundName(intRound As Integer, schools As Integer) As String
Dim maxRound    As Integer
Dim rtn         As String

    maxRound = getMaxRound(schools)
    
    Select Case intRound
    Case maxRound
        rtn = "決勝"
    Case maxRound - 1
        rtn = "準決勝"
    Case maxRound - 2
        rtn = "準々決勝"
    Case Else
        rtn = intRound & "回戦"
    End Select
    
    getRoundName = rtn
End Function

'決勝なども含めて「最大何回戦相当まであるか」を取得して返す
Private Function getMaxRound(schools As Integer) As Integer
Dim i       As Integer
Dim j       As Integer
    
    i = 1
    Do While i < schools
        i = i * 2
        j = j + 1
    Loop
    
    getMaxRound = j + 1
End Function

下記のような感じで使用する。

Sub test()
Dim schools As Integer
    
    schools = 49
    
    MsgBox getRoundName(6, schools)
End Sub

で、実際にはVBAで処理している訳ではないのだけれど、Excelで手軽に確認できるからVBAでとりあえず作ってみたという。

何しろ出先なので……。 ← 暇だったらしい

ページネーションの実装について

WEB甲子園 CakePHP

管理者メニューで登録ユーザの一覧が見られるといいな、と思ったので、実装した。
その際に、CakePHPのページネーション機能を使ったのだが、下記サイトが分かりやすかったのでメモ。

「ページネーションを利用する | CakePHP2.1初心者メモ」

本番環境とテスト環境でDebugKitを使うかどうかを切り替える

CakePHP WEB甲子園

DebugKitが本番環境でも有効なのは困るので、「CakePHPでデバック用プラグイン「DebugKit」を使用する方法 | 【鋭利団体】PK-Brothers」の「開発時のみ有効となる設定を追加」を参考にして設定した。

よくある導入解説だと「AppController.php」の「$uses」に「DebugKit.Toolbar」を追加することになっているのだが、上記方法であればこの手順は不要である。