投稿者「サイト管理者」のアーカイブ

Get first character from string in image

画像の中の文字列から最初の一文字を取得する

最終的な目標は、カタカナ1文字で解答が書かれた解答欄の『自動採点』。
これを実現するには、まず、解答欄画像からカタカナを探して、それを切り抜き、それが何という文字なのかを判定しなければならない。これは、そのチャレンジの第一歩。
記事(内容)は最初Pythonですが、最終的にPythonのスクリプトは、Object Pascal に埋め込んで内部的に呼び出して利用するので、やがてDelphiに変わります・・・

1.手書き文字は認識できない?
2.文字の位置座標を取得するには?(その①)
3.文字の位置座標を取得するには?(その②)
4.まとめ
5.お願いとお断り

1.手書き文字は認識できない?

本当は、手書きの日本語でも、英語でも、数字でも、とにかく解答欄に書いてある内容を自由自在に読み取ってデータ化し、採点等、様々な目的に利用したいのだが、残念ながらそれはできない。

「それは無理・できるわけない」と思っていることこそ、本当にチャレンジし甲斐のある課題だと、いつも思うし、実際、過去5年間にやってきたことはいつも「できない」を「できる」に変えることへの挑戦だった。

上司に言われて作ったICカードを利用した出退勤の記録を管理するプログラムや、ほとんど自分のために作ったマークシートリーダー、それから、喜んでくれる人が多そうだから書いた(自分では絶対に使わないけど)手書き答案の採点プログラム・・・。「できない」を「できる」に変えて行く、その過程がたまらなくおもしろいことを、僕は知ってる。

しかし、記述式の解答欄を自由自在に読み取って自動採点することは、現時点では絶対に不可能だし、チャレンジしてもハードルが高すぎて、間違いなく途中で挫折する。それはやるまでもなく実現不可能な夢だと自分でもわかる。でも、カタカナ1文字を読み取って、その正誤を判定することならできるんじゃないか? そう思う僕がいる。

確か・・・4年前に、マウスでドラッグして画面に描いた(手書き)数字が0~9のいずれかを判定するプログラムを作成したことがあった。あれから4年経ってるから、認識技術も格段に進歩しているじゃないかって、期待する気持ちもある。

OCRを使った文字認識について、ここ数日間かけて調べたり、実際にプログラムを写経して動かしてみてわかったことは・・・『手書き文字の認識は難しい』ってこと。

『Python 文字認識』のようなキーワードで検索すると、PyOCRとTesseractを使った例が読み切れないほどヒットする。解答欄に見立てた画像を用意して、実際に試してみた・・・。

# PyOCRとTesseractを使用して手書き文字画像を認識
import os
import sys
from PIL import Image
import pyocr

tesseract_path = "C:\Program Files\Tesseract-OCR"
if tesseract_path not in os.environ["PATH"].split(os.pathsep):
    os.environ["PATH"] += os.pathsep + tesseract_path

tools = pyocr.get_available_tools()
if len(tools) == 0:
    sys.exit(1)
else:
    tool = tools[0]

img = Image.open("Image/画像ファイル名.jpg")
# デフォルト設定
builder = pyocr.builders.TextBuilder(tesseract_layout=3)
result = tool.image_to_string(img,lang="jpn",builder=builder)
print(result)
最もよく認識できた手書き文字の画像(実際に使用する解答欄同様に作成)
# 結果
ss アイ ウェ オ
[Finished in 1.953s]

①は ss に、デフォルト設定の tesseract_layout=3 で、エ は ェ として認識された。他のパラメータ設定ではどうだろうか? 次々と変更して試すことにする。結果は、次の通り・・・

# テキストの単一ブロックと仮定して認識
builder = pyocr.builders.TextBuilder(tesseract_layout=6)
# 結果
ss アイ ウェ オ
[Finished in 1.959s]

変化なし!

# 画像を1行の文字列として認識
builder = pyocr.builders.TextBuilder(tesseract_layout=7)
# 結果
ss アイ ウェ オ
[Finished in 0.423s]

これも変化なし!

# 文字が散らばっているテキストとして認識
builder = pyocr.builders.TextBuilder(tesseract_layout=11)
# 結果
oe アイ ウェ イオ
[Finished in 0.419s]

上記のテストが最も上手く認識できた例で、他にも複数の手書き文字を試したが、この例ほど正しく認識することは出来なかった。いちばん上手く認識できた例でも、完全ではないことから、誰もが容易に、かつ無償で利用できる環境での手書き文字認識には、まだ難しい部分があるようだ。

追記 正しく認識できなかった例

例えば、次の画像。比較的よく認識できた上の例と、それほど違いはないと思うのだが・・・

# デフォルト設定
builder = pyocr.builders.TextBuilder(tesseract_layout=3)
# 結果
Y ィ ウエ オォ
[Finished in 2.258s]

デフォルト設定の3では、ア が Y となってしまった。イ も小さな ィ になっている。それから、オはなぜ、オとォになるのだろう?

# テキストの単一ブロックと仮定して認識
builder = pyocr.builders.TextBuilder(tesseract_layout=6)
# 結果
oe マイ ウエ オ
[Finished in 0.435s]

6だと、①は oe に、ア は マ と認識された。残りは正解。

# 画像を1行の文字列として認識
builder = pyocr.builders.TextBuilder(tesseract_layout=7)
# 結果
o アマ アイウエオ
[Finished in 1.966s]

7では、① が o 、その後ろの アマ はどこからやってきたんだろう?

# 文字が散らばっているテキストとして認識
builder = pyocr.builders.TextBuilder(tesseract_layout=11)
# 結果
Y ィ ウエ オォ
[Finished in 0.44s]

11では、デフォルト設定と同じ結果になった。

ただ、PyOCRとTesseractの名誉のために、これは重要なことだと思うので掲載。認識する対象画像が手書き文字でなければ、必要かつ十分な素晴らしい性能を発揮する。

手書きでない画像を読ませてみる
# テキストの単一ブロックと仮定して認識
builder = pyocr.builders.TextBuilder(tesseract_layout=6)
# 結果
1 アイ ウエ オ
[Finished in 2.254s]

①は「(半角の)1」として読み取り、あとは正解。「文字」でなく、「画像」から文字の部分を判別し、しかも、その個々の文字を見分けているのですから、素直にすごいです!

# 文字が散らばっているテキストとして認識
builder = pyocr.builders.TextBuilder(tesseract_layout=11)
# 結果
アイ ウエ オ
[Finished in 2.419s]

①は認識せず。あとは正解。では、Fontを変更すると・・・?

別のFontで試すとどうなるか?
# テキストの単一ブロックと仮定して認識
builder = pyocr.builders.TextBuilder(tesseract_layout=6)
# 結果
"アイウエオ
[Finished in 0.36s]

①が ” に変わった? でも、あとは正解。

# 文字が散らばっているテキストとして認識
builder = pyocr.builders.TextBuilder(tesseract_layout=11)
# 結果
アイ ウエ オ
[Finished in 2.376s]

①は認識されない。あとは正解。さらに、別のFontでは・・・?

さらに別のFontでは?
# テキストの単一ブロックと仮定して認識
builder = pyocr.builders.TextBuilder(tesseract_layout=6)
# 結果
アイ ウエ オ
[Finished in 0.779s]
# 文字が散らばっているテキストとして認識
builder = pyocr.builders.TextBuilder(tesseract_layout=11)
# 結果
アイ ウツ ウエ オ
[Finished in 1.944s]

なんだか、むせてるような雰囲気を感じますが。元気? だいじょうぶ?

これから作成する自動採点プログラムで使用する解答欄画像には、設問番号や解答方法の指示が必ず含まれる予定なので、OCRを利用した手書き文字認識をそのまま読み取りに使用するのは少し難しそうだ。どうにかして、①などの設問番号への反応を読み取り結果から除外する方策を考えなければならない。

あと、認識結果のところどころにスペースが入るのは仕様なのか?(この点、不勉強で、よくわかりません)、まぁ、スペースは置換して取り除けばそれでOKだから気にしなくてもいいけど。

いずれにしても「手書きでない文字画像の認識」であれば、現在のOCR(光学的文字認識)は十分、実用になるレベルに達しているのは間違いない。これを無償で提供してもらえることに対し、プログラムの作成者と提供の仕事に関わった人々へ心から感謝。

2.文字の位置座標を取得するには?(その①)

次に考えたことは、手書き文字そのものを完全に認識(読み取って判別すること)は難しくても、「文字の位置」であれば座標というかたちで取得できるのではないか? ということ。僕の場合、そこに文字列があったとしても、最初の一文字だけ座標が取得できればOKなので、そこを重要視してテストを実行。

調べてみると、pyocrはbuilderというオプション部分の設定を変更することで、様々な読み取り形式を指定できるようだ。

※ pyocr のライセンスは GPL v3 なので、個人がローカルな環境で「使用」するだけであればソースコードの公開義務等は発生しないが、複製や改変、頒布は「利用」にあたり、ソースコードの公開義務等が発生することに十分留意する必要がある。

【builderに指定可能なオプション】(省略した場合はTextBuilderになる)

1.TextBuilder 文字列を認識
2.WordBoxBuilder 単語単位で文字認識
3.LineBoxBuilder 行単位で文字認識
4.DigitBuilder 数字 / 記号を認識
5.DigitLineBoxBuilder 数字 / 記号を認識

注意:DigitBuilderおよびDigitLineBoxBuilderは認識対象を数字に限定してTesseractを動作させる。ただし、新しい認識エンジン(Tesseract4.0系)では動作しない。

このオプションで、座標を取得するために利用できそうなのは、「2」と「3」だ。WordBoxBuilderが認識するのが「文字」ではなく、「単語」という部分がちょっと気になったが、「アイウエオ」は単語ではなく、「単なる文字列」だと思うので、どうなるか、ちょっと実験してみた。ア と イ と ウ と エ と オ を全部、別々の単語として認識してくれるとうれしいのだけれど。字と字の距離も離れているし・・・

手書きカタカナ画像
import sys
import os

from PIL import Image
from PIL import ImageDraw
from PIL import ImageFont

import numpy as np
import pyocr

img = Image.open(r".\img\画像ファイル名.jpg")

#tool = pyocr.get_available_tools()[0]

tesseract_path = "C:\Program Files\Tesseract-OCR"
if tesseract_path not in os.environ["PATH"].split(os.pathsep):
    os.environ["PATH"] += os.pathsep + tesseract_path

tools = pyocr.get_available_tools()
if len(tools) == 0:
    print("OCRエンジンが指定されていません")
    sys.exit(1)
else:
    tool = tools[0]

builder = pyocr.builders.WordBoxBuilder(tesseract_layout=6)
boxies = tool.image_to_string(img, lang="jpn", builder=builder)
draw = ImageDraw.Draw(img)

for box in boxies:
    text = box.content
    pos = box.position
    draw.rectangle(pos, fill=None, outline=(255, 0, 0))
    print(pos)

img.save(r".\img\out.jpg")

結果は・・・

# 出力された座標
((6, 0), (82, 98))
((67, 32), (181, 77))
((271, 27), (379, 82))
((417, 17), (481, 72))
[Finished in 3.125s]

WordBoxBuilderで最初の一文字の座標を取得するという目的の実現は困難なようだ。「使い方の方向性が間違ってる」と、作成者の方には叱られそう・・・。その通りです。すみません。

では、LineBoxBuilder の方はどうだろうか?

# builderオプションの設定を変更
# builder = pyocr.builders.WordBoxBuilder(tesseract_layout=6)
builder = pyocr.builders.LineBoxBuilder(tesseract_layout=6)

左x座標の起点が①の左にあるのは理解できるが、左y座標はどのようにして決めているのだろう? 左y座標は、点線の上限のようにも見えるが・・・。右x座標はオの右端だと思うが、右y座標はなぜ画像の外に・・・? もしかして、画像中の点線と何か、関係がある?

残念ながら、LineBoxBuilder も手書き文字一文字めの座標を取得する用途には向かないようだ。誤解のないように言っておくが、これは各Builderオプションが「使えない」という意味ではない。Builderは正しく機能している。僕の使い方=「手書き文字への適応」が「間違っている」ということに他ならない。

Builderオプションの名誉のため、手書きでない画像の①と点線を消して、WordBoxBuilder をもう一度実行して見ると・・・

使用目的によっては、日本語の単語をどの程度認識するか? その認識率が問題になりそうだが、文字や文字列の座標は間違いなく取得できる。すばらしい性能だ。

LineBoxBuilder では・・・

こちらはさらにすばらしい。手書きでない画像であれば、行単位での文字列の認識・切り出し用途に十分使えそうだ。要は、万能選手的な働き方はその性格上できないので、適材適所な使い方をすれば、大変優秀な働きを示してくれるということを、使う側が十分認識して、Toolがその性能を100%発揮できる場面を提供してあげることが大切なのだ。

3.文字の位置座標を取得するには?(その②)

では、手書き文字の最初の一文字目の座標を取得するにはどうしたらいいのか?
いちばんのヒントを与えてくれたのは、次のWebサイト様で紹介されていた画像内の数字を連続して認識するスクリプト。

PYTHONとRPAで遊ぶ 画像OCR(連続文字の認識)

https://ailog.site/2019/08/17/ocr1/

上記Webサイト様で紹介されているScriptをそのまま実行しようとすると、次のようなエラーメッセージが表示されることがあるようだ。これは、OpenCVの仕様変更のため?

# 表示されたエラーメッセージ
Traceback (most recent call last):
  File "X:\XXX\Sample.py", line XX, in <module>
    x, y, w, h = cv2.boundingRect(cnt)
cv2.error: OpenCV(4.5.5) X:\a\opencv-python\opencv-python\opencv\modules\imgproc\src\shapedescr.cpp:874: error: (-215:Assertion failed) npoints >= 0 && (depth == CV_32F || depth == CV_32S) in function 'cv::pointSetBoundingRect'

[Finished in 2.412s]

エラーの修正方法は、次の通り(赤字部分の[1] を [0] に修正)。また、状況によっては、いちばん外側の輪郭だけを検出するように、RETR_LISTRETR_EXTERNAL に修正しておいた方がよいとのこと。

#contours = cv2.findContours(
#    thresh, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)[1]

# エラーが出なくなるように修正
#contours = cv2.findContours(
#    thresh, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)[0]

# 領域の一番外側だけを検出するように修正
contours = cv2.findContours(
    thresh, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)[0]

紹介記事にあったスクリプトを元にして、解答欄の画像にある文字列から最初の一文字目の文字を取得するスクリプトを書いた。処理の流れとスクリプトは次の通り。

  • 検出した輪郭矩形の数だけ、その位置座標を二次元配列に取得(高さが小さすぎる輪郭は座標をゼロにしてないものとする)。
  • 横書き答案の場合はx座標の小さなものから昇順に、縦書き答案の場合はy座標の小さなものから昇順に並べ替えを行う処理を追加し、文字列の最初の一文字目の座標を取得。
  • さらにこれを囲む輪郭矩形の大きさを少し大きく補正して、一文字目の文字だけを切り出して保存する。
# 画像の中の文字を検出して、最初の一文字の画像を保存するScript

import sys
import numpy as np
import cv2
from PIL import Image

# 画像の読み込み(Pathとファイル名に日本語があるとエラーになる)
#im = cv2.imread(r".\img\numbers.png")

# 画像の読み込み(pillowで日本語に対応)
file_path = r".\img\Sample.jpg"
pil_img = Image.open(file_path)

# PillowからNumPyへ変換
img = np.array(pil_img)

# グレイスケールに変換
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)
# ぼかし処理(シミ抜き)
blur = cv2.GaussianBlur(gray, (5, 5), 0)
# 二値化
thresh = cv2.adaptiveThreshold(blur, 255, 1, 1, 11, 2)

# 輪郭を抽出
contours = cv2.findContours(
    thresh, cv2.cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)[0]

# 検出した輪郭の数
num = len(contours)
# 表示して確認
print(len(contours))

# 二次元配列を作成して初期化
mylist = np.zeros((num, 4))

# 配列の要素番号を指定する変数(初期化)
i = 0

# 描画色は赤を指定
red = (0, 0, 255)

# 抽出した領域を繰り返し処理する
for cnt in contours:
    x, y, w, h = cv2.boundingRect(cnt)

    if h < 30:  # 高さが小さい場合は検出しない
        # (ここを調整すれば設問番号や指示内容を無視できる)
        mylist[i][0] = 0
        mylist[i][1] = 0
        mylist[i][2] = 0
        mylist[i][3] = 0
    else:
        mylist[i][0] = x
        mylist[i][1] = y
        mylist[i][2] = x + w
        mylist[i][3] = y + h
        cv2.rectangle(img, (x, y), (x+w, y+h), red, 2)
        # 最後の出力がいちばん手前の矩形の座標というのは勝手な思い込み
        # 最初の一文字目の座標を確認するために取得した座標を表示
        print(str(x)+", "+str(y)+", "+str(x+w)+", "+str(y+h))

    i += 1

# 配列を並べ替え(キー列は0:x1、1:y1・昇順)
pw, ph = pil_img.size
if pw > ph:
    # 横書きと判断
    mylist_sort = mylist[np.argsort(mylist[:, 0])]
else:
    # 縦書きと判断
    mylist_sort = mylist[np.argsort(mylist[:, 1])]

# 表示して確認
print(mylist_sort)

# 緑色を指定
green = (0,255,0)

# 輪郭枠の大きさを微調整するための変数
intTweak = 5

# 最も左の文字を緑の枠で囲んで示す
for i in range(num):
    if mylist_sort[i][0] != 0:
        x1=int(mylist_sort[i][0]-intTweak)
        y1=int(mylist_sort[i][1]-intTweak)
        x2=int(mylist_sort[i][2]+intTweak)
        y2=int(mylist_sort[i][3]+intTweak)
        print(str(x1)+", "+str(y1)+", "+str(x2)+", "+str(y2))
        cv2.rectangle(img, (x1,y1), (x2, y2), green, 2)
        break

# 輪郭枠付きの画像を保存
cv2.imwrite(r".\img\result.png", img)
# 最初の一文字を切り抜き
img_crop = pil_img.crop((x1,y1,x2,y2))
# 最初の一文字を保存
img_crop.save(r".\img\crop.jpg")

# 表示
cv2.imshow('rect', img)
cv2.waitKey(0)
cv2.destroyAllWindows()
【実行結果】

【検出した輪郭の数】
 23

【最初の一文字目の座標を確認するために取得した座標を表示】
262, 36, 296, 83
332, 35, 380, 68
66, 34, 105, 78 <- これがほしかった座標!
146, 32, 181, 77
416, 16, 482, 73

【並べ替えを実行した後の二次元配列の内容】
[[  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [  0.   0.   0.   0.]
 [ 66.  34. 105.  78.]
 [146.  32. 181.  77.]
 [262.  36. 296.  83.]
 [332.  35. 380.  68.]
 [416.  16. 482.  73.]]

【少し輪郭矩形を大きくした切り抜き用の座標】
 61, 29, 110, 83

[Finished in 11.51s]
ようやく最初の一文字目を取得できた!
正誤判定用に一文字目を切り抜いて保存
縦書きの解答欄の場合もOK!

追記 読み取りに失敗(?)した例

文字の一部が「切れている・つながっていない」場合、読み取りに失敗(?)してしまうことがあるようだ(ヒトは、その期待に反している結果を「失敗」と感じてしまうが、キカイ的には間違いなく正確に輪郭を検出している)。だから、これも僕が運用方法を間違えているだけと言えなくもない。例えば、次の画像で試すと・・・

ア・ウ・エとも、文字の一部がつながっていない
「輪郭」を検出しているわけだから、プログラム的には大正解のはず

高さの閾値をゼロにして、プログラムが正しく動作していることを確認する。

OpenCVの性能は素晴らしい!

この読み取り方法での(自分的に工夫はしたが)限界がこの辺りにあることがわかったので、運用する際はこれを「読み取りエラー」として処理し、ヒトが目視で確認するように案内することに決め、これ以上、この問題には深入りしないことにする。確かに「自動採点が目標」なんだけど、最終的にはヒトの確認作業が必ず必要。機械と協働するのだからお互いが気持ちよく働ければいいのだ・・・と、自分自身に言い聞かせて、先へ進む。

(追記ここまで_20221231)

スクリプトを書いていて、すごくうれしくなったのは、解答欄に欠かせない設問番号や指示内容を小さめに作成(印刷)すれば、高さの閾値を用いて、その存在を無視できること。これを発見した時は、もう小躍りしたいほど、うれしかった!

1回の計算に必要な時間が長いような気もするが、Loopを作って複数の解答欄画像を連続して処理して見ると2回目からは初期化が必要なくなるためか、計算時間はグンと短くなった。

次の課題は、切り出して保存したカタカナ画像の文字が何であるかを判定するスクリプトを完成させること。4年ぶりにチャレンジする機械学習だが、この4年間でどれくらい進化したのだろう? 4年前はMNISTデータベースを活用して手書き数字を認識・判定する方法を学んだが、今回のターゲットは言語的にはマイナーすぎるカタカナ・・・

もし、この夢が実現できてもプログラムを商品化するつもりなどまったくないので、研究用に無料で利用できるカタカナデータベースがどこかにあるとよいのだが。

4.まとめ

(1)画像内の手書き文字をOCRで完全に認識させるのは、現段階では難しい。
(2)OpenCVの輪郭検出を用いれば画像内の文字位置の座標を取得可能。
(3)座標から文字の輪郭矩形を切り出して保存。機械学習で文字種を判定する。

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Rectangle Detector

矩形検出器

手書き答案をスキャナーで画像化して採点するソフトを書いた。概ね、思った通りにカタチになったが、解答欄の位置座標を取得するのに、解答欄の数だけ、その左上隅から右下隅へマウスでドラッグする作業を繰り返さなくてはならない。(もし、これが自動化できたら・・・) そう思って書いたのが、このプログラム。

1.矩形の検出方法
2.字数制限のある解答欄の作り方
3.GUIはDelphiで作成
4.矩形検出器の使い方
5.まとめ
6.お願いとお断り

1.矩形の検出方法

キーワードを『矩形 検出』にしてGoogle先生にお伺いをたてると、思った通りOpenCVを活用する方法がいくつもヒットする。しかも、そのほとんどすべてがPythonでの活用方法だ。Delphi用のOpenCVもあるようだけれど、次の理由から矩形の検出はPython用のOpenCVで行うことにした。

Pythonを使う利点は、まず、何と言っても、情報が豊富なことだ。マイ・プログラミング環境では、わからないことはすべてGoogle先生に教えてもらうしかないので、情報が入手しやすいことは、他のすべてに優先する。

(メインの開発環境がDelphiなのは、上記の内容と大いに矛盾しますが・・・)

さらに、手書き答案の採点ソフトより前に、マークシートリーダーを作った時、マーク欄の座標を得るために、やはりPythonとOpenCVのお世話になった。マークシートリーダーも、手書き答案の採点ソフトも、embeddable pythonに入れたOpenCVと一緒のフォルダに詰め込んでユーザーに配布しているから、Pythonを内包して使う環境は既に完成済み。PythonのスクリプトをDelphiのコードに埋め込んで、PythonForDelphiを使って実行する方法は勉強済みだから安心。Delphi用のOpenCVは、情報も少ないし、何よりその使い方がわからない・・・。

他人様に使っていただくプログラムはDelphiで書くけれど、自分専用のToolはPython環境を利用して作ることが多い。ちょっと特別なことをしたい時、Pythonはとても便利だ。いろいろ紆余曲折はあったけれど、現在はSDカードにWinPythonとAtomエディタを入れて持ち運べるPython環境を作っている。

そのSDカードに入れたPython環境で、いつものようにAtomを起動し、Web上にあったいくつものScriptをコピペして試してみる。

まず、OpenCVで「ハフ変換」なるものを利用する例だが、ハフ変換はノイズの除去で苦労しそうだ。ノイズの発生源が多数存在する解答用紙の矩形検出でパラメータを適切に設定することが果たしてできるだろうか? 経験がない自分にはちょっと厳しそうだ。

次に、LSD(Line Segment Detectorの略とのこと)という直線検出器を試した。試した瞬間、(もう、これしかない!)と思うほど、これは凄かった。使い方も超カンタンで、LSDをこれでもか!とばかりに並べるだけ。

from pylsd.lsd import lsd
Mylines = lsd(picture)

【検出結果】

LSDで検出できた矩形の例

さらに驚くべきことに、こういう作業には付き物の引数も一切ない。つまり、パラメータを調整する必要など『ない』ということなのだろう・・・。ただ、LSDはそのライセンス形態がAGPLであると知り、使用を断念。MITやBSDでないと自分的にはやはり困る・・・。

最後に試したのが、OpenCVのfindContours関数。これを使うには前処理として、まず、画像をグレースケールに変換し、さらに白黒反転させて二値化しなければならない。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く(全角文字対応の確認用にファイル名は「ひらがな」)
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)

# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

Pillowで画像ファイルを開いているのは、OpenCVのimread関数が日本語(全角文字)に対して拒絶反応を示すので、これを回避するため。もし、ファイル名とそこまでのPathに全角文字が含まれないという確実な保証があるなら、次のようにしてもいいようだ。これなら1行で済む。

# 8ビット1チャンネルのグレースケールとして画像を読み込む
img = cv2.imread("全角文字のないPathと画像ファイル名", cv2.IMREAD_GRAYSCALE) 

で、準備が出来たらfindContours関数を使って輪郭を検出する。

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

解答欄には、その性格上、小さな矩形が多く使われることが多いので、閾値以下の面積の矩形は削除する。※ 閾値は整数型の数値で指定する。

# 閾値以下の面積の矩形(小さい輪郭)は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 閾値, contours))

よりスムーズに作業するためには、予め、小さな矩形を消去した機械読み取り用の解答欄(解答用紙)をヒト用の解答用紙のコピーから作成し、これを用いて解答欄座標を取得した方がよい(国語の縦書き解答用紙は、ワープロソフトではなく、表計算ソフトで作成する方法が業界では一般的らしいので、機械読み取り用の解答用紙はそれほど手間をかけなくても、カンタンに作成できる・・・はず)。

解答欄矩形をちゃんと認識できているか・どうかを確認するため、検出した輪郭を描画する。このPythonのスクリプトをDelphiのObject Pascalに埋め込んで実行する際は、ここが最大の「見せ場」になる。検出した矩形をグラブハンドル付きのラバーバンドで表示する方法は後述。

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

最後に解答欄矩形の座標を取得する(これが最終的な目標)。取得した座標は、採点順になるよう、並べ替えて表示する(並べ替え方法は後述)。

# 矩形の座標を表示(左上の座標, 右下の座標)
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

数値より、画像(絵)で見た方がわかりやすいのは言うまでもない。

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()
画像を表示して、解答欄矩形の取得状況を確認

ここまでの Python Script をまとめて示せば、次の通り。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)
# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

# 閾値以下の面積の矩形(小さい輪郭)は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 数値, contours))

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

# 矩形の座標を表示(左上の座標, 右下の座標)
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()

OpenCVのfindContours関数を使って検出した輪郭(=解答欄の矩形)の例。
(解答用紙画像はLSDを試した時と同じものを使用)

矩形を検出しやすいように作った解答用紙なら、この結果はまさに『ブラボー!』

解答用紙中の ■ や □ を検出しないよう、検出下限の閾値を設定したこともあり、期待した通りの満足できる結果が得られた。OpenCVのハフ変換や、LSDでは日本語に対する反応が見られたが、findContours関数は(適切な閾値を設定してあげれば)日本語に反応しないようだ。

答案の「答」には「口」、問にも「口」、漢字にはたくさんの矩形が使われている。適切な閾値を設定することで、誤認識を減らせることも理想的。

【実験してみた!】

閾値を「700」として、□ に対する反応を実験して確認した。結果は次の通り。

26×26=676、28×28=784 だから・・・機械は正確に反応している

28ポイントの「□」から反応するが、40ポイントの「問」には無反応。通常使用される解答用紙であれば、フォントの大きさに制限を設ける必要性はなさそう。

もう少し細かい矩形を使った解答用紙で、閾値700で実験すると・・・

解答欄の矩形をさらに細かく分割したサンプルを作成してテスト
解答欄の番号の矩形に反応してしまう・・・

閾値1400までは・・・

解答欄の番号の矩形に反応するが

閾値を1500にすると・・・

解答欄の番号の矩形には反応しなくなる☆

少し、細かい矩形を用いた解答用紙であれば、閾値1500くらいから試せば狙った通りに解答欄の座標だけを取得することができそうだ。

閾値に上限を設定すれば、さらに良い結果を得られるかも・・・と思ったが、数学の解答用紙には他の教科ではあり得ない巨大な矩形が普通に使用される。矩形を取得できなければ、検出器とは言えない。さらに、解答欄全体を一つの大きな矩形として認識してしまうのはプログラムの性格上、絶対に回避できないから、閾値の上限は設けずに、むしろ、不要な矩形の座標を削除しやすいプログラム(GUIを作成)を書けばいいと気づく。

さらに、ユーザーが矩形座標の編集(修正)を自由にできるようにプログラムを工夫すれば、理想的な矩形検出器ができるはず。

これでDelphiでGUIを作成する際の方向性も見えてきた。

2.字数制限のある解答欄の作り方

解答欄の矩形を検出する上で、大きなハードルになるだろうと予想していたのが『字数制限が設定された解答欄』。

機械読み取り用に作成した解答用紙であっても・・・

上の解答用紙は、ヒト用の解答用紙の問題番号部分にあった小さな矩形を消去して、機械読み取り処理用に作成した解答用紙。この状態で矩形を検出(閾値1500)すると・・・

それでも削除しなければならない矩形座標が多すぎ・・・

閾値を「3100」に設定して、ようやく・・・

閾値をどんどん大きくすれば、何とかなることはわかった!

閾値を大きく設定すれば、何とかなることは上の例でわかったが、閾値を大きくすれば当然必要な解答欄の座標を取得できなくなる可能性も生じてくるわけで・・・。

ところが別の国語用解答用紙を処理している際に、閾値を気にせずに字数制限のある解答欄を作成する良い方法があることを偶然発見。それは・・・

罫線に「点線」を利用した解答用紙

字数制限を設定したり、完全解答で正解としたい解答欄は内側の罫線を点線にする!

閾値「700」で実験した結果

これなら問題2の(1)・(2)が作る大きな矩形の座標のみ削除すればOK!
点線を活用することで、一番大きな問題を難なくクリアできることが判明。
やったー☆

【embeddable Pythonのバージョンとインストールしたライブラリの一覧】

Python 3.9.9

Package Version
numpy 1.21.5
opencv-python 4.5.4.60
Pillow 9.3.0
pip 22.3.1
setuptools 60.1.0
wheel 0.37.1

3.GUIはDelphiで作成

取得した解答欄の座標を編集するGUIはDelphiで作成。最終的にはこうなった。

検出した矩形の確認と編集を行うGUIはDelphiで作成

画面下の「操作」グループ内のVCLを左から右へ順にクリックして行けば、解答用紙画像から解答欄の矩形が取得・表示できる仕組み。

左から右へ順に操作して解答欄矩形の座標を取得する。

取得した解答欄矩形の座標は、画面右上に一覧形式で採点順に表示されるようにプログラミングした。

取得した座標の一覧を表示

横書き答案が指定された場合は、y座標の値が昇順になるよう並べ替え(y座標が同じなら、x座標でさらに昇順に並べ替え)。

縦書き答案が指定された場合は、x座標の値が降順になるよう並べ替え(x座標が同じなら、y座標でさらに昇順に並べ替え)。

こうすれば、座標の並び方が「ほぼ採点する順番になる」はず。なお、並べ替えはカンマで区切った解答欄矩形の座標を入れたStringListを対象として実行(解答欄数は多くても100未満のはず・・・だから、並べ替えの速度はまったく考えていない)。そのアルゴリズムは次の通り。まず、グローバルに使う変数、ソート用のプロパティと関数を準備。

  private
    { Private 宣言 }
    x1,x2:integer;
    y1,y2:integer;
    //Pythonから送られたデータを保存する
    strAnsList:TStringList;

var
  Form1: TForm1;

type TSStyle = (ssText,ssInteger);
var
  //ソート用のプロパティ
  fAscending : Boolean;
  fIndex : Integer; //項目番号
  fStyle : TSStyle; //テキストか整数か

implementation

uses
  System.UITypes;
function GetCommaText(aStr:String; aIndex:Integer):string;
  var
    subList:TStringList;
begin
  subList := TStringList.Create;
  subList.Delimiter := ',';
  subList.DelimitedText := aStr;
  Result := subList.Strings[aIndex];
  subList.Free;
end;
function MyCustomSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  case fStyle of
    ssText:begin
      Result:=CompareText(GetCommaText(List.Strings[Index1],
      fIndex),
      GetCommaText(List.Strings[Index2],fIndex));
    end;
    ssInteger:begin
      //一重ソート
      //Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
      //          -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      //二重ソート
      Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
                -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      if Result=0 then
        //-1することで1番目の項目がソートキーになる
        Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex-1))  
                  -StrToInt(GetCommaText(List.Strings[Index2],fIndex-1));
      if fAscending then
      begin
        Result:=Result*-1;
      end else begin
        Result:=Result*1;
      end;
    end;
  else
    //これを入れておかないとコンパイラが警告を表示する
    Result:=0;
  end;
end;

で、「解答欄座標を取得」ボタンがクリックされたら、PythonForDelphiを通じてPythonのScriptを内部的に実行して座標を取得し、上記関数を呼び出して並べ替えを実行、結果をMemo2に表示する。

procedure TForm1.btnGetSquareClick(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する -> グローバル変数化
  //strAnsList:TStringList;
  //Sort
  i:integer;
  strFileName:string;
  strList:TStringList;
begin
  //初期化
  Memo1.Clear;
  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try
    //Python Script
    strScrList.Add('import cv2');
    strScrList.Add('import numpy as np');
    //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
    strScrList.Add('img = cv2.imread(r"./ProcData/'+ExtractFileName(StatusBar1.SimpleText)+'")');
    strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
    strScrList.Add('gray = 255 - gray');
    strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
    strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
    strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
    strScrList.Add('for i in range(len(contours)):');
    strScrList.Add('    im_con = img.copy()');
    strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
    strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

  strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
  Memo2.Lines.SaveToFile(strFileName);

  strList := TStringList.Create;
  try
    for i := 0 to Memo2.Lines.Count-1 do
    begin
      strList.Add(Memo2.Lines[i]);
    end;
    //fAscending := True; //昇順で
    fAscending := False;
    fIndex := 1; //2番目の項目を
    fStyle := ssInteger; //整数型でソート
    strList.CustomSort(MyCustomSort); //ソート
    //データ抽出
    Memo2.Clear;
    for i := 0 to strList.Count - 1 do
    begin
      //Memo2.Lines.Add(GetCommaText(strList.Strings[i],fIndex));
      Memo2.Lines.Add(strList[i]);
    end;
  finally
    strList.Free;
  end;

end;

上記のアルゴリズムは、次のWebサイトに紹介されていた情報を元に作成。
カンマ区切りのデータの並べ替えは初めて行った。採点順に座標を並べたかったので、プログラムコードをよく読んで、二重ソートになるよう工夫した。
貴重な情報を投稿してくださった方に心から感謝申し上げます。

[delphi-users:1175] カンマ区切りのデータの並べ替え

https://groups.google.com/g/delphi-users/c/Ck2mQXNFTvw

4.矩形検出器の使い方

ここまでの操作で解答欄の座標はすべて取得できたはずなので、不要な矩形のデータをいかに効率よく削除するかを主眼に、GUIの操作方法を考えた。

まず、取得できた座標データの先頭にセットフォーカスし、そのデータが示す矩形を赤いラバーバンドで囲んで表示する。ユーザーは、ラバーバンドで囲まれた矩形を見て、その要・不要を判断。

この矩形は不要

不要な矩形であった場合は、「編集」ボタンをクリック。不要なデータを自動で選択状態に設定。

Memoの一行全部を選択状態に設定

手続きは次の通り。

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin

  //行番号をLines[i]で取得
  i:=StrToInt(LBRow.Caption)-1;

  EditTF:= not EditTF;
  if EditTF then
  begin
    BitBtn1.Caption:='編集中';
    BitBtn1.Font.Color:=clRed;
    Memo2.ReadOnly:=False;
    btnSave.Enabled:=False;

    //i行目の文字全てを選択状態にしたい場合
    //先頭にカーソルをセット
    Memo2.SelStart:=Memo2.Perform(EM_LINEINDEX, i, 0);
    //全ての文字を選択
    Memo2.SelLength:=Length(WideString(Memo2.Lines[i]));
    //Memo2.Perform(WM_VSCROLL,SB_TOP,0); //先頭にスクロール

  end else begin

    BitBtn1.Caption:='編 集';
    BitBtn1.Font.Color:=clBlack;
    Memo2.ReadOnly:=True;
    Memo2.SelStart:=SendMessage(Memo2.Handle,EM_LineIndex,i,0);
    btnSave.Enabled:=True;
    Memo2Click(Sender);

  end;

  //SetFocus
  Memo2.SetFocus;

end;

Delete or Backspaceキーで不要なデータを削除すると同時に、Memoの行も削除する。で、ボタンを「編集」(=意味的には「編集したい場合はクリックせよ」)に戻す。次のデータをラバーバンドで囲む。この一連の動作がすべて自動的に流れ作業で行われるように手続きを作成。

コードは次の通り。

procedure TForm1.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  LineNo:integer;
begin
  //現在、カーソルがある行を取得
  LineNo:=Memo2.Perform(EM_LINEFROMCHAR, UINT(-1), 0);
  //空欄なら行を削除
  if Memo2.Lines[LineNo]='' then
  begin
    Memo2.Lines.Delete(LineNo);
  end;
  //表示
  GetLinePos;
  if not EditTF then
  begin
    Memo2Click(Sender);
  end else begin
    BitBtn1Click(Sender);
  end;
end;
procedure TForm1.GetLinePos;
var
  CurPos,Line:Integer;
begin
  with Memo2 do
  begin
    CurPos:=SelStart;
    Line:=Perform(EM_LINEFROMCHAR, CurPos, 0);
    //LBRowは現在フォーカスがある行番号を表示するラベル
    LBRow.Caption:=Format('%d', [Line+1]);
    LBRow2.Left:=LBRow.Left+LBRow.Width;
    LBRow2.Caption:='行目';
  end;
end;
procedure TForm1.Memo2Click(Sender: TObject);
var
  i:integer;
  p1,p2:TPoint;

  function RemoveToken(var s:string;delimiter:string):string;
  var
    p:Integer;
  begin
    p:=Pos(delimiter,s);
    if p=0 then Result:=s
    else Result:=Copy(s,1,p-1);
    s:=Copy(s,Length(Result)+Length(delimiter)+1,Length(s));
  end;

  function GetTokenIndex(s:string;delimiter:string;index:Integer):string;
  var
    i:Integer;
  begin
    Result:='';
    for i:=0 to index do
      Result:=RemoveToken(s,delimiter);
  end;

begin

  if not EditTF then
  begin

    //座標を取得
    i:=Memo2.Perform(EM_LINEFROMCHAR, Memo2.SelStart, 0);

    //エラー対策
    if Memo2.Lines[i]='' then Exit;

    x1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',0));
    y1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',1));
    x2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',2));
    y2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',3));

    if Assigned(plImage1) then begin
      FreeAndNil(plImage1);
    end;

    //コンポーネントを生成し,イベントを定義し,位置を指定して画像を表示
    plImage1:=TplResizeImage.Create(Self);
    plImage1.Parent:=ScrollBox1;
    plImage1.TransEvent:=True;
    //クライアント座標をスクリーン座標へ変換
    //GetSystemMetrics(SM_CYCAPTION) -> タイトルバーの高さ
    //GetSystemMetrics(SM_CYFRAME) -> ウィンドウの枠幅
    p1.X:=x1-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1.Y:=y1-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.X:=x2-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.Y:=y2-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1:=Image1.ClientToScreen(p1);
    p2:=Image1.ClientToScreen(p2);
    plImage1.SetBounds(p1.X, p1.Y, p2.X-p1.X, p2.Y-p1.Y);

    //SelectedプロパティをTrueにするとラバーバンドとグラブハンドルが表示される
    plImage1.Selected := True;
    plImage1.BringToFront;

  end;

end;

ラバーバンドはMr.XRAYさんのWebサイトにあったplResizeImageを使わせていただいて作成。これまでにもどれだけ助けていただいたことか・・・。このような素晴らしい素材を提供し続けてくださっているMr.XRAYさんに今回も心から感謝申し上げます。

157_移動リサイズ可能な TImage   ラバーバンドとグラブハンドル

http://mrxray.on.coocan.jp/Delphi/plSamples/157_MoveResize_GrabHandle.htm

ラバーバンドで囲まれた矩形が必要な矩形であった場合は、下のMemo3へ「移動」ボタンをクリックしてデータを移す。で、次の矩形をラバーバンドで囲んで表示する。

次の矩形の要・不要を判断
必要な矩形であれば下のMemo3へ移動する

この作業を順次繰り返すと、最終的に必要な矩形の座標のみがMemo3に移動。不要な矩形の座標はすべて削除されることになる。

必要な矩形の座標のみ、採点順に取得できた!

最終的に過不足がないか・どうか、Memo3の先頭座標データをクリック、ラバーバンドで該当矩形を囲んで表示、下向きの矢印キーを次へ次へと押して、フォーカスを下の座標データへ移動、ラバーバンドを表示して確認、これを最後の座標データまで繰り返し。

採点順を含めて、必要な座標データがすべて揃っていることを先頭データから順に確認する。

必要な座標がすべて取得できていることを確認したら、「保存」ボタンをクリックして手書き答案採点ソフトが実行時に読み込む、様々な採点設定を記録するための iniファイルに解答欄の座標データを保存する。

データの保存

【任意の範囲を指定したい場合】

複数の解答欄を抱き合わせて、完全解答で正解としたい場合などに対応するため、任意の範囲を矩形選択できるようにした。

画面中央左の追加ボタンをクリックすると、画面の中央にラバーバンドが表示される。これを任意の位置へドラッグする。

追加ボタンをクリックしてラバーバンドを表示
画面の中央にラバーバンドを表示、これを任意の位置へドラッグ。

ボタンのCaptionは、自動で「取得」に変更。

ボタンのCaptionを変更

任意の範囲をラバーバンドで囲んだら(=範囲指定完了)、「取得」ボタンをクリック。取得された座標がボタンの右のEditに表示され、同時にクリップボードへ送られる。

任意の範囲を指定して座標を取得

Memo3上の「追加」ボタンをクリックすると、Memo3が編集可能になるので、採点順を確認して、適切な行に座標のデータを追加(クリップボードから貼り付けても、データを見ながら手動入力してもよい)。

適切な位置に座標のデータを入力する

ラバーバンドを使わなくても、解答欄の左上と右下を、それぞれポイントすればその座標をラベルに表示する機能も追加したので、上の図のように、Memo3を編集モードにして、座標を任意の行へ直接入力することも可能。

マウスでポイントした場所の座標をリアルタイムで表示する

クライアント座標の取得と表示を行う手続きは、次の通り。

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  PtInput:TPoint;
begin
  //スクリーン座標を取得
  GetCursorPos(PtInput);
  //で、そのコントロールのクライアント領域に対するカーソルの座標を取得
  PtInput := Image1.ScreenToClient(PtInput);

  //補正する必要はない(確認済み)
  //表示
  Label2.Caption:=
    Format(' クライアント座標  '+'X : %d, Y : %d', [PtInput.X, PtInput.Y]);
end;

【矢印キーの押し下げを拾う】

最も難しかったのが、フォーカスが「どこにあるか」で矢印キーの挙動を制御すること。以前にStringGridのセルのフォーカスの移動を制限した時に学んだ内容が今回も役に立った。

今回は、Memoにフォーカスがある場合と、ラバーバンドにフォーカスがある場合、さらにラバーバンドにフォーカスがある場合のうち、Shiftキーと同時に矢印キーが押し下げられているのか(=ラバーバンドの大きさの変更)、それとも矢印キーが単独で押し下げられているのか(=ラバーバンドの表示位置の移動)、この3パターンを見分けてそれぞれにあった動作を行わせたいと考えた。最終的には次のコードで対応。

  private
    { Private 宣言 }

    //ある(矢印他)キーが押されたことを知る
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

上のように手続きを宣言して、Shift+Ctrl+Cで手続きを生成。

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  StrText: string;
begin
  //何かキーが押し下げられたら
  if Msg.message = WM_KEYDOWN then
  begin
    try
      if ActiveControl is TMemo then
      begin
        //キー操作を「通常動作」にするおまじない
        case Msg.Message of
          WM_USER + $0500:
          Handled := True;
        end;
      end else begin
        //上位ビットが1ならShiftキーが押されている
        if GetKeyState(VK_SHIFT) and $8000 <> 0 then
        begin
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Width := plImage1.Width + 1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Width := plImage1.Width - 1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Height := plImage1.Height - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Height := plImage1.Height + 1;
              Msg.wParam:=0;
            end;
          end;
        end else begin
          //Shiftキーは押されていない
          //対象を限定(どちらでも動いた)
          //if TplResizeImage(ActiveControl).Visible then
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Left := plImage1.Left +1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Left := plImage1.Left -1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Top := plImage1.Top - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Top := plImage1.Top + 1;
              Msg.wParam:=0;
            end;
            //Deleteキー
            if Msg.wParam=VK_DELETE then
            begin
              //plImage1を解放
              if Assigned(plImage1) then begin
                FreeAndNil(plImage1);
              end;
              Msg.wParam:=0;
            end;
          end;
        end;
      end;
    except
      on E: Exception do
      begin
        StrText := E.ClassName + sLineBreak + E.Message;
        Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
      end;
    end;
  end;
end;

plImage1が生成されないうちに上の手続きが呼ばれると、当然、一般保護違反のエラーが発生するので、FormCreate時にplImage1を生成しておく。

procedure TForm1.FormCreate(Sender: TObject);
var
  //Python39-32へのPath
  AppDataDir:string;
  i:integer;
begin

  //メモリーリークがあれば検出
  ReportMemoryLeaksOnShutdown:=True;

  //有効にする(忘れないこと!)
  Application.OnMessage := AppMessage;

  //[Enter]でコントロールを移動させるために、Form上のコンポーネント
  //より先にFormがキーボードイベントを取得する。
  KeyPreview:=True;

  //コンポーネントを生成 -> インスタンス(実体)をつくる
  // = 一般保護違反エラーの防止
  //plImage1はグローバル変数として宣言しているから未定義の識別子エラーは発生しない
  //でも、Create(生成)してからでなければ使えない!
  plImage1:=TplResizeImage.Create(Self);

  //編集フラグ(編集中ではない)
  EditTF:=False;
  PlusTF:=False;
  Memo2.ReadOnly:=True;

  //StatusBar1の設定
  StatusBar1.SimplePanel:=True;

  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;

  //Embeddable Pythonの存在の有無を調査
  AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理    
    PythonEngine1.AutoLoad:=True;
    PythonEngine1.IO:=PythonGUIInputOutput1;
    PythonEngine1.DllPath:=AppDataDir;
    PythonEngine1.SetPythonHome(PythonEngine1.DllPath);
    PythonEngine1.LoadDll;
    //PythonDelphiVar1のOnSeDataイベントを利用する
    PythonDelphiVar1.Engine:=PythonEngine1;
    PythonDelphiVar1.VarName:=AnsiString('var1');  //プロパティで直接指定済み
    //初期化
    PythonEngine1.Py_Initialize;
  end else begin    
    PythonEngine1.AutoLoad:=False;
  end;

  //面積の閾値の選択肢を設定
  for i := 1 to 200 do
  begin
    cmbThreshold.Items.Add(IntToStr(i*100));
  end;

  //画面のちらつきを防止する
  DoubleBuffered := True;

end;

で、メモリーリーク発生の原因とならないよう、アプリの終了時に忘れずに解放。

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //メモリーリークを防止する
  PythonEngine1.Py_Finalize;
  PythonDelphiVar1.Finalize;
  FreeAndNil(plImage1);
end;

5.まとめ

(1)矩形の検出は、OpenCVのfindContours関数を利用する。
(2)矩形の検出を回避するには「点線」を利用する。
(3)GUIはDelphiで作成し、必要な座標だけ保存できるように工夫。
(4)「フォーカスがどこにあるか」で矢印キーの動作を制御。
(5)コントロール生成のタイミングと確実な破棄にも注意する。

6.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Controlling Message Dialog Buttons

メッセージダイアログのボタンを制御する!

メッセージダイアログのボタンを「状況によってはクリックできないように設定」する必要に迫られて、その方法を調べてみたのだけれど、探した範囲では見つからず、よくよくコードを眺めたら、ボタンにはEnabledプロパティがあることに気付き、簡単に実現できちゃった・・・というお話。

1.ヒトはよく間違える
2.ボタンをクリック不可に設定
3.まとめ
4.お願いとお断り

1.ヒトはよく間違える

TImageに表示した画像上で、連続して矩形選択するプログラムを書いた。ユーザーが画像上で矩形選択する毎に次のメッセージダイアログを表示し、続けて矩形選択する場合は「はい」や「やり直し」、指定した選択範囲をすべて保存して終了する場合は「終了」、設定内容を保存せずに終了する場合は「キャンセル」を、それぞれ選択できるようにプログラミングしたのだが・・・

説明をよく読んで作業してもらえば大丈夫だと思ったんだけど・・・

50回とか、それくらい連続して矩形選択を繰り返すと、『終了』をクリックしなければならない場面で、つい・うっかり、『はい』をクリックしてしまうという、いかにも人間らしい失敗があちこちで発生。この問題が起きるのを防止するため、次のようにラベルに残りの選択数を表示して注意を促したが・・・

ラベルに残りの選択回数を表示

「あー!まちがえちゃったー☆」という声が増えはしても、減ることはなく、根本的な間違いクリック防止対策を施す必要性を痛感。で、行うべき対策はただひとつ。矩形選択が残り0回になったら、表示するメッセージダイアログの「はい」ボタンをクリック不可能に設定する & それまでは「はい」ボタンを初期選択状態としていたのを「終了」ボタンに変更する。これだけ!

早速、『Delphi メッセージダイアログ ボタン Enabled』を検索キーワードにしてGoogle先生にお伺いをたてたが探した範囲では、参考となる情報は見つからず。

仕方がないので、残り0回になったら「はい」ボタンのないメッセージダイアログを表示することにしようか・・・と思いつつ、コードを眺めていたら、

TButton(Dlg.FindComponent('YES')).Caption := 'はい';

TButton・・・? の
Captionプロパティを「はい」に設定してる・・・?

・・・ってコトは、当然、Enabledプロパティも設定できるはず! と気づき、早速設定☆

2.ボタンをクリック不可に設定

矩形選択の残りの回数がゼロになった時点で「はい」ボタンのEnabledプロパティをFalseに設定し、これをクリックできないようにする。さらにそれまでは「はい」ボタンが初期選択状態であったのを「終了」ボタンに変更してみた。その方法は次の通り。

var
  msg : string;
  rc : integer;
  Dlg : TForm;
begin
  Dlg:=CreateMessageDialog(msg,mtConfirmation,[mbYes,mbNo,mbOK,mbCancel]);
  try
    //フォームの中央に表示
    Dlg.Left:=Form1.Left+(Form1.Width -Dlg.Width ) div 2;
    Dlg.Top:=Form1.Top +(Form1.Height-Dlg.Height) div 2;
    //ボタンの文字を変更
    TButton(Dlg.FindComponent('YES')).Caption := 'はい';
    TButton(Dlg.FindComponent('NO')).Caption := 'やり直し';
    TButton(Dlg.FindComponent('OK')).Caption := '終了';
    TButton(Dlg.FindComponent('CANCEL')).Caption := 'キャンセル';
    //選択(クリック)の可否を設定
    if StrToInt(矩形設定数.Text) - 矩形選択数 <> 0 then
    begin
      //「はい」ボタンを選択できる
      TButton(Dlg.FindComponent('YES')).Enabled := True;
      //初期選択状態のボタンを「はい」にする
      Dlg.ActiveControl := TWinControl(Dlg.FindComponent('YES'));
    end else begin
      //「はい」ボタンは選べない
      TButton(Dlg.FindComponent('YES')).Enabled := False;
      //初期選択状態のボタンを「終了」にする
      Dlg.ActiveControl := TWinControl(Dlg.FindComponent('OK'));
    end;
    //表示
    rc := Dlg.ShowModal;
  finally
    Dlg.Free;
  end;

  //必要に応じて記述
  case rc of
    mrYes: begin
      //「はい」が選択された場合の処理

    end;
    ・・・省略・・・
  end;

end;

テストしてみました!
矩形選択数が残り0(ゼロ)になると・・・

「はい」ボタンはクリックできない!

これでもう大丈夫☆
このシーンで間違って「キャンセル」をクリックするヒトは、そんなに多くないはず・・・

3.まとめ

メッセージダイアログに表示した特定のボタンをクリックできないようにするには・・・

//「はい」ボタンをクリック不可に設定
TButton(Dlg.FindComponent('YES')).Enabled := False;

メッセージダイアログは何度も使ってきたけれど、ボタンのEnabledを設定したのは今回が初めての経験でした!!

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

If you want to show ScrollBar.

スクロールバーを表示したい時は・・・

複数のTImageを切り替えて表示し、あんな処理やこんな処理やそんな処理をそれぞれの場面で実行する場合、「あんな処理」ではGoodだったことが、「こんな処理」ではBadになっちゃうことがある。・・・んで、プログラムをイロイロいじって矛盾をなんとか解消し、さらに、エラー対策をこれでもか!と詰め込み、はたまた新たに要望のあった新機能を追加・・・、もう自分でも全体像がつかめないほど矜羯羅がってスパゲッティ状態になったプログラムに、総仕上げの「そんな処理」を書き足し、その中でTImageに画像を表示したら、自動的に出るはずの『スクロールバーが出ない!』みたいなー (T_T)

これまでにも、何度もこの問題で悩み、苦しんだ末に、とうとう解決方法を見つけたというお話。

1.問題が起きる状況
2.解決方法
3.お願いとお断り

1.問題が起きる状況

Formに、ScrollBoxをのせ、その上に複数のImageを載せた状態で、状況に応じてImageを切り替えながら作業するような場合、『どこか』で・『なにか』を(設定)やってしまっていて、FormCreate時にスクロールバーが自動的に出るよう、

ScrollBox1.AutoScroll:=True;

と、設定してあるにもかかわらず、ScrollBoxよりはるかに大きな画像を表示しても、垂直・水平両方向のスクロールバーが『出ない!』みたいな・・・

2.解決方法

どこで、なにをやったのか、徹底的に調べて問題を解決するのが本当なんだろうけれど(この正しい解決方法にチャレンジした結果)、あっちをイジったら、こっちがオカしくなり、こっちを直したら、あっちがコケた!みたいなことになるのが怖い。

そこで「これまでに書いたコードには一切変更を加えずに問題を解決する方法」を模索。

そもそも、ScrollBoxにScrollBarが表示される仕組み自体がわからない。その仕組みを調べてみると・・・

Vcl.Forms.TControlScrollBar.Range

https://docwiki.embarcadero.com/Libraries/Alexandria/ja/Vcl.Forms.TControlScrollBar.Rangeより引用

『水平スクロールバーの Range がフォームまたはスクロールボックスの幅より小さい場合,水平スクロールバーは表示されません。垂直スクロールバーの Range がフォームまたはスクロールボックスの高さより小さい場合,垂直スクロールバーは表示されません。』

・・・と説明されている。ってコトは、Imageコントロールに画像をセットした状態で、上の『スクロールバーが表示されない状態を明示的に回避(Rangeの値を手動で大きく設定)』してあげれば、スクロールバーが必ず表示されるはず。そう思って書いたのが次のコード。

  //水平スクロールバーの Range がスクロールボックスの幅より小さい場合,
  //水平スクロールバーは表示されない
  if ScrollBox1.HorzScrollBar.Range < ScrollBox1.Width then
  begin
    //表示したい画像の幅をRangeの値に設定
    ScrollBox1.HorzScrollBar.Range := Image1.Picture.Bitmap.Width;
  end;

  //垂直スクロールバーの Range がスクロールボックスの高さより小さい場合,
  //垂直スクロールバーは表示されない
  if ScrollBox1.VertScrollBar.Range < ScrollBox1.Height then
  begin
    //表示したい画像の高さをRangeの値に設定
    ScrollBox1.VertScrollBar.Range := Image1.Picture.Bitmap.Height;
  end;

  //ScrollBarを最も上へ&最も左へ移動
  ScrollBox1.VertScrollBar.Position := 0;
  ScrollBox1.HorzScrollBar.Position := 0;

  //ScrollBarを最も下へ&最も右へ移動
  //ScrollBox1.VertScrollBar.Position := VertPositionMax(ScrollBox1);
  //ScrollBox1.HorzScrollBar.Position := HorzPositionMax(ScrollBox1);

  //画像を表示
  Image1.Visible := True;

このように「これまでに書いたコードには一切変更を加えずに問題を解決する」ことに、
一応成功☆

もしかしたら、もしかしたら、同じ問題で悩んでいる人が、
どこかにいるかもしれないから・・・

3.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Button to Scroll Horizontally

横スクロールボタン

縦書きの手書き答案をスキャンして画像化し、設問毎に解答欄画像をかき集め、PCとコラボして採点するプログラムを書いた。ちなみに実行時の画面はこんな感じ。

縦書き答案をスキャンして、PCとコラボして採点

縦書き答案は、基本的に国語のテストで使用されるアレだ(国語以外の教科・科目ではまず使わない?)。通常、設問1の解答欄が最も右側にあり、解答は縦書きで、左へ向かって順次記入する形式になっている。プログラムの仕様をこれに合わせる必要もないかと思ったが、取り敢えず、郷に入ればなんとやらで、答案の形式に倣って、スキャンした答案画像から設問1の解答欄画像をかき集めて右から左へ、出席番号順に並べて表示してみることにした。PCで何か測る場合の座標原点は、左上を(0,0)にするのが普通だから、計算式を考えるのに著しく、いや、激しく頭が混乱したが、頑張って、なんとかこれを実現。

西洋式機械文明と和の精神文化の見事なる融合がここに結実。よかよか *(^_^)*♪
えぇ天気じゃのー

・・・ってか、正直、なんか画面の並びにワタシ、微妙な違和感があるんですけど・・・
まぁ 今さら気にしても仕方ない。深く考えずに、次へ

困ったのはその次。横書き答案の場合は、マウスのホイールをクルクル回せば、画像が縦にどんどんスクロールするから何の問題もないのだが、縦書き答案の場合、採点する際、横のスクロールバーをいちいちドラッグして、画面を左へ・左へと動かさなくてはならない。これがいまいち、どうにも使いづらい(気がした)。

マウスのホイールを廻して、縦ではなく横方向にスクロール・・・って方法もあるんじゃないかと思い、調べてみると「Ctrl+Shift+ホイール回転」で横スクロールできるらしい。

実際に試してみると(何もプログラムを書かなくても)、右へ・左へ、答案画像は確かに横にスクロールする。つまり、これはWindowsの標準仕様なのだ。

でも、一般的に広く認知されている方法ではない(と思う)し、何よりMy採点プログラムは「スクロールは右手・採点は左手が担当する」ことが設計のポイント(こだわり)。私的には、ここでそれを曲げるわけにはいかない・・・(もちろん、ユーザーに「Ctrl+Shift+ホイール回転」で横スクロールすることは案内するつもりだけれど、それに頼らない方法も準備したい・・・)。

そこで思いついたのが、ボタンを使って移動できないか? ということ。設定部に用意したComboBoxで移動人数10名を指定すれば10名分、ScrollBoxではなく、Formにドッキングさせた「スクロールに追従しない」ボタンで、Imageに表示した解答欄画像を左へ(or 右へ)スクロールするプログラムが出来たら使い勝手がよかろーということで、これは、その作成にチャレンジした記録。

1.フローティングで行こう!
2.ToolBarの「閉じる」ボタンを無効化
3.初めてBevelを使う
4.まとめ
5.お願いとお断り

1.フローティングで行こう!

実は前からやってみたかったんだ。VCLコンポーネントのフローティング。
でも、その機会になかなか恵まれなくて、今回、初めて、それにチャレンジ!

移動用のボタンを作成するには、どうするのがいちばんイイのか、調べてみると、ControlBarの上にToolBarを載せ、このToolBar内にToolButtonを作る方法がいちばん良さそうだ。これでやってみてダメだったら、その他の方法を考えることにして、まず、この方法で作ってみることに決定。

復習を兼ねて、作り方を以下に再現。

解答欄の画像はScrollBoxの上に載せたImageに表示している。まず、練習用のFormにPanelを1つ載せて、AlignをalRightに設定。次に、FormにScrollBoxを1つ載せて、AlignをalClientに設定。さらに、このScrollBoxの上にImageを1つ載せる(AlignはalNone)。

FormにVCLコンポーネントを3つ載せ、それぞれにAlignを設定

次に、ScrollBoxをクリックして選択して、その上にControlBarを1つ載せる。

ScrollBoxにControlBarを載せ、そのAlignをalTopに指定

このControlBarの各種プロパティは、以下のように設定。

  1. Alignは「alTop」を指定。
  2. このままだと存在感がありすぎるので、BevelKindプロパティを「bkNone」にして立体感(=境界線)を消す。
  3. AutoSizeプロパティを 「True」にして、ツールバーが複数ある場合に大きさ(幅と高さ)が自動的に変わるように設定。
  4. ドッキングを受け入れる側なので、DockSiteプロパティを「True」に設定。

構造ペインとオブジェクトインスペクタの様子は・・・

構造ペイン

ちなみにペイン(Pane)とは、枠や区画のことなんだそうな。ずっと「痛(イテ)ぇ」だと思ってたのは私だけ? そっちは「Pain」で同音異義語とのこと。だから「構造痛ぇ」じゃなくて「構造枠・区画」でした・・・。英語もイロイロむずかしいな。

ControlBar1のオブジェクトインスペクタ(その1)
ControlBar1のオブジェクトインスペクタ(その2)

次に、ControlBarをクリックして選択し、その上にToolBarを1つ載せる。

ControlBar(見えない)の上に、ToolBarを載せたところ

ToolBarの各種プロパティは、以下のように設定。

  1. AlignプロパティをalNoneにして、大きさを小さくする。
  2. ShowCaptions プロパティを True にする。
  3. ToolBar1を右クリックし、表示されるポップアップメニューの「ボタンの新規作成」を選択。これでツールバーの上に[ToolButton1]が作成される。
  4. 続けて右クリックして、表示されるポップアップメニューから「セパレータ新規作成」を選択すると[ToolButton2]という名前のセパレータが出来る(名前は気にしない)。
  5. さらに右クリックして、表示されるポップアップメニューの「ボタンの新規作成」を選択。これでツールバーの上に[ToolButton3]が作成される。
  6. 構造ペインでToolBarをクリックし、オブジェクトインスペクタのWidthプロパティの値を「180」に変更(フローティングさせた時、ユーザーが扱いやすくなるよう、一工夫)
  7. ドッキングに対応させるため、DragKindプロパティを「dkDock」に設定。
  8. ドッキングに対応させるため、DragModeプロパティを「dmAutomatic」に設定。

4.でセパレータを作成するときの画面

5.で[ToolButton3]を作り、さらに6.で幅を広げた時の画面

構造ペインとオブジェクトインスペクタの様子は・・・

セパレータの名前が[ToolButton2]なのが気になるが、見なかったコトに・・・

セパレータの名前が「どうしても気になる」場合は、構造ペインでToolButton2を選択し、オブジェクトインスペクタのNameプロパティやCaptionプロパティを「MySeparator」等に変更し、さらにToolButton3のNameプロパティやCaptionプロパティを「ToolButton2」にすると満足できるかもしれません・・・。が、説明の都合上、私はこのままで行きます(変更しません)。

7.と8.を設定した時の画面

これはドッキングさせるためのお呪いみたいなもんかなー

へぇー。「おまじない」って漢字で書くと「お呪い」なんだー。
これ、読めって言われたら、私は間違いなく「おのろい」と読んだと思いますが。
日本語もイロイロですな・・・

コードはまだ何にも書いてないけど、この状態で保存して、実行すると・・・

ドッキング状態でToolBarが表示されている
ToolBarは、左右にドラッグして移動することが出来る。静かに感動。
ToolBarを取り外してフローティング状態にすることも出来る。感動を超えて感激。
(さらにフォーム画面上部に移動すれば、またドッキングしちゃったりする)

オレ、プログラム1行も書いてないけど。Delphiすげー!!

ToolBarをフローティングさせたり、移動する際、画面枠の線だけが表示される。
動きがスムーズでなく、かなり「ぎくしゃく」している。感動に疑問符が・・・

このフローティングさせた時の動きが、なんか、気に入らない。チラついてる感があって、ぎくしゃくしていて、かつ、鈍重な感じ。調べてみると、これは改善できるらしい。ToolBar1 の OnStartDock イベントで、以下を記述。

OnStartDock の右の空白部分をダブルクリック
procedure TForm1.ToolBar1StartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  DragObject := TToolDockObject.Create(Sender as TToolBar);
end;

保存して、実行。ToolBarをフローティングさせると、ちらつく枠線でなく、ToolBar本体が表示されたまま、スムーズに移動する。最初からこうしておいてほしかった!!

ちらつく枠線じゃなく、フローティングしているToolBarがスムーズに移動することを確認

今はToolBarしかないから、特に必要じゃないけど、他にもVCLコンポーネントがある場合は、コントロールバーにドラッグされたVCLコンポーネントがToolBarであった場合のみ、ドッキング可としなければならない。これを実現するには、ControlBarのOnGetSiteInfoイベントを次のように設定。

OnGetSiteInfoの右の空白部分をダブルクリック
procedure TForm1.ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
  var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
  if Not (DockClient is TToolBar) then
  Candock := False;
end;

ここまでの内容は、次のWebサイト様で紹介されていた内容を引用&参考にさせていただきました。作者様に心より感謝申し上げます。

ドッキングコントロールを使ってみる

http://www.surveytec.com/prog/delphi/del4rev/dock.html

Delphi2010 コントロールバー(ControlBar)

http://afsoft.jp/program/del2010/p11_033.html

で、最後にToolBarの受け入れ先をFormに設定(いつまでもフローティングさせておくわけにもいかない)。Formを選択しておいて、オブジェクトインスペクタのDockSiteプロパティを「True」にするだけでOK!

ToolBarのドッキング先(受け入れ先)をFormに設定

ここまでの設定をテストするには、何でもいいのでFormに設置したScrollBoxより大きな画像を用意(例:デスクトップをそのままキャプチャーして保存するとか)して、Image1のPictureプロパティでこの画像を指定する。で、Image1のAutoSizeプロパティを「True」に設定。また、ScrollBoxのAutoScrollプロパティがTrueに設定してあることも確認。

Image1のPictureプロパティで大きな画像を指定

参考:画像なんて準備できない・・・という場合

ScrollBoxのAutoScrollプロパティがTrueに設定してあれば、内部に配置したVCLコンポーネントのサイズが枠内に表示しきれないほど大きくなると、自動でスクロールバーが表示される(AutoScrollプロパティがFalseだとスクロールバーは現れない)。

やってみた!
ScrollBoxの幅と高さより、Imageの幅と高さを大きく設定すれば、ScrollBarが自動的に表示されるはず。

Imageが小さい場合、ScrollBarは表示されない
Imageの幅をScrollBoxの幅より大きくすると、横のスクロールバーが表示される
Imageの幅に加え、高さも大きく設定。すると縦のスクロールバーも追加される。
スクロールバーは、表示されるだけでなく、実際にスクロールすることもできる!

参考:画像なんて準備できない・・・ は、ここまで

ScrollBoxのプロパティについて、学んだことをちょっとまとめた!

【ScrollBoxのRangeプロパティ】
スクロールボックス内部に作成される(仮想的な)表示領域のサイズと考えればいいようだ。このRangeのサイズがScrollBoxのサイズより大きくなると、スクロールバーが自動的に現れる。

【ScrollBoxのMarginプロパティ】
スクロールボックスの右下端の「余白」領域のことで、内部のコンポーネントとスクロールボックスの端との距離が、この値より小さくなると、スクロールバーが自動的に現れる。

【ScrollBoxのTrackingプロパティ】
ついでにScrollBoxの縦・横のスクロールバーのTrackingプロパティを「True」にして、スクロールバーを移動させた時、表示されている画像も同時に動くように設定を変更。もし、これを行わない(デフォルト設定のFalseのままだ)と、スクロールバーを動かしている最中は画像は動かず、バーを動かし終えた瞬間に、バーの移動量だけ、画像の表示位置が飛ぶようにずれるスクロールになる。

ScrollBox1の縦のスクロールバーのTrackingプロパティをTrueに設定
ScrollBox1の横のスクロールバーのTrackingプロパティをTrueに設定

同じことを、コードで設定する場合は・・・

  //滑らかぁーにスクロール
  Scrollbox1.VertScrollBar.Tracking := True;
  Scrollbox1.HorzScrollBar.Tracking := True;

保存して、実行する。スクロールボックスより十分に大きい画像を準備したので、縦・横ともにスクロールバーが自動的に表示される。

スクロールバーが自動的に表示されない時は・・・?(間違いかもしれない私の経験)

私がどこかで、なにかを、間違えているのかも、知れないが(自分が絶対に正しいという自信はまるでないけれど)、オブジェクトインスペクタで予め、ScrollBoxのAutoScrollプロパティを「True」に設定してあるにもかかわらず、画像を表示する際に、プログラムコードの中でこれを明示的に指定しないと、「横の」スクロールバーが表示されなくなる現象が、これまでに少なくても2回あった(両方出ないならまだしも、この現象に遭遇した時、縦のスクロールバーは2回とも自動的に表示されていた)。

私がどこかで、なにかを、間違えていたのかも、知れないが、原因が皆目わからず、もちろん検討もつかず、途方に暮れ、悩みに悩んでようやく発見したスクロールバーが自動で表示されなかったトラブルの解決方法なので、いちおう、ここに書いておきます・・・。

  //オブジェクトインスペクタのプロパティでTrueに指定してあっても
  //再指定しないと横スクロールバーは表示されない!
  ScrollBox1.AutoScroll:=True;

もしかしたら、RangeプロパティやMarginプロパティ関係の設定値のどこかに真の原因があったのかもしれないが・・・。あの時、ものすごく、困ったことは本当で、この方法で解決できたことも、本当だから。もしかしたら、同じことで悩んでいる人が・・・どこかに・・・

ToolBarのフローティングとドッキングを確認!

ToolBarをフローティングさせ、Formにドッキングしたところ
画像をスクロールしても、ToolBarの位置は変わらない

2.ToolBarの「閉じる」ボタンを無効化

ここまでの設定だと、プログラム起動時のToolBarは、下のように、画面のTopにあるControlBar(見えない!)にドッキングしている状態で表示される。

プログラム起動時、ToolBarはControlBarにドッキングしている状態で表示される

実は、自分的にはこれがちょっと気に入らない。なぜかというと、作った採点プログラムは横書き答案でも、縦書き答案でも、どちらも採点可能なプログラム。

で、横書き答案を採点する場合には、マウスのホイールをブンブン廻す「縦のスクロール」で解答欄画像を次々に表示できるから、「ボタンでスクロール(表示を移動)」させる機能はオプション設定で、ユーザーが明示的に選択した場合だけ使えれば十分。必要がなければToolBarのVisibleはFalseに設定し、「最初から表示しない」くらいでちょうどいい。

一方、縦書き答案を採点する場合は、ToolButtonのCaptionを「左へ移動」・「右へ移動」に設定したToolBarを最初から表示し、これを使って横にスクロールする機能をユーザーに提供したい。それだとControlBarにドッキングさせた状態(=画像と一緒にスクロールしてしまう)ではなく、最初からフローティングさせて表示し、「横スクロールはこれだよ!」ってユーザーに積極的にPRしたい。

また、ToolBarが「フローティング」すること自体を知らないユーザーも当然いるはずだし、何より、ControlBarからフローティングさせる手順を説明して理解してもらい、ユーザーにそれをやってもらうのは、ユーザーの手間を増やすだけで、ユーザーにとってのメリットは何一つない。必ず使ってもらうなら、最初からフローティングさせておきたい。

最初からFormにドッキングさせておくのも却下。それだと地味で存在を見落としてしまいそうだし、何より、Formの任意の位置に「ユーザーがドッキングさせる」ことが理想的な使用方法だから、フローティング状態からのドッキング位置はユーザー自身が任意の位置に決めてほしい(解答欄の画像は千差万別で高さや幅がことごとく変化するから当然余白の位置も変わり、また、コントロールを操作しやすいと感じる上下左右の位置は、人により異なって当然だろう)。

そこで、PanelにButtonを一つ追加して、ToolBarをフローティング状態で表示できるように、次のコードを書いてみた・・・

Panelの上にButtonを一つ追加
procedure TForm1.Button1Click(Sender: TObject);
var
  r:TRect;
begin
  r.Left:=ScrollBox1.Width div 2;
  r.Top:=ScrollBox1.Height div 2;
  r.Right:=r.Left+ToolBar1.Width;
  r.Bottom:=r.Top+ToolBar1.Height;
  ToolBar1.ManualFloat(r);
end;

保存して実行し、ボタンをクリックすると・・・

実際のプログラムでは、「縦書き答案」が選ばれた時だけフローティング状態で表示する

無事、フローティングした状態でToolBarを表示することができた☆

重要 この逆をやってはイケナイ。

コードでドッキングさせる実験を面白半分でやったら大変なコトに!
エラーメッセージも何もなく、いきなりプログラムが落ちて(Delphiらしくないけど)、PCを再起動しないと、どーにもならなくなっちゃった T_T いったいナンだったんだろー。理由はわかりません。

皆様に謹んで報告申し上げます m(_ _)m

(追伸 アブナイからコードは書きません)

それよりなにより、ここでひとつ、すごく気になったコトがあって、それはせっかくフローティング状態で表示したToolBarだけど、もしユーザーが間違って(或いは故意に)「閉じる」ボタンを押しちゃったら、どう対応するか? ってコト。

地味な灰色のToolBar上で、由々しい存在感を示す「閉じる」ボタン

「由々しい」の意味:そのままにしてはおけない重大な事柄であるさま

実用日本語表現辞典より引用

上の画面で見る限り、ボタンに見えないボタンより、閉じるの [×] マークの方がよほど魅力的に感じます。つい、クリックしたくなるのが人情というもの。やはり、人間は「知」より「情」ですな・・・

で、[×] の誘惑に負けて、ついクリックすると・・・

「さよなら」も言わずに、ToolBarはあっさりと消えた・・・。最後まで無口なイイ奴だったが・・・。

この練習プログラムなら、右上のボタンをクリックすればToolBarは復活するけど、実際の採点プログラムには「ToolBarを表示する」ためだけのボタンを設置する場所はない。ことここに至っては、とるべき方法はただ一つ。何としてもToolBarの [×] ボタンの機能を停止し、ToolBarが非表示になるのを断固阻止しなければならない。よぉーし、オレはやるぞー

・・・ということで、どのように閉じるボタンの機能を停止するか、足りないアタマで考えた。

ボタンそのものを消してしまうのは、調べてみると難しそうだ。最初からグレイアウトさせるのは出来そうだけれど、なんとなーく、面白くない気がした。ちっちゃくても、アレだけ存在感のある [×] 閉じるボタンだもの。ユーザーの皆様にも1度はその真の勇姿を眺めていただき、ぜひ、ついクリックしたくなる「特別な衝動」を感じてもらいたい。

やっぱり、そのなんて言うか、そう!アレだ。アレ。アレで行こう!!
某OSを供給している世界的超有名大企業がよく使う「アンタの責任だよ!」って、アレだ。アレ。あの〇ACに代表される・・・、アレを真似しよう。

〇AC:解答欄(Answer Column)に〇という意味ではありません!

ユーザーが閉じるボタンをクリックしたら、「閉じるボタンを無効化しました!」とメッセージを表示して、それからあらためてボタンをグレイアウトしてクリックできなくする。最初から強制的に使えなくなってたら、「押したいのに、なんでだっ」と、気分を悪くする人もいるかもだけど、試しにクリックしたところ「無効化しました!」というメッセージが出て、それからグレイアウトすれば、きっと「使えたんだけど、無効にしたのはワタシなのね」と、主体的な観点で納得してもらえるんじゃないか? と。

実は「 閉じるボタンを無効化しますか? [はい]・[いいえ]・[キャンセル] 」でもよかったんだけど、さすがにアホらしい気がして、これはボツにしました☆

だって、ナニが選ばれても、ユーザーの意思に関係なく、全部「無効化するつもり」でしたから!

以下、ToolBarの閉じるボタンの機能を停止する方法。

  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  //ToolBarの閉じるボタンを無効化(赤字部分を書いてShift+Ctrl+C)
  TToolDockSite = class(TToolDockForm)
  private
    procedure WMSysCommand(var Msg: TWMSysCommand);
      message WM_SYSCOMMAND;
    end;

uses
  System.UITypes;

  //System.UITypesはMessageDlgを使うために追加

{$R *.dfm}
//手続きを記述
procedure TToolDockSite.WMSysCommand(var Msg: TWMSysCommand);
var
  hBarHandle : HMENU;
begin
  case Msg.CmdType of
    SC_CLOSE: begin
      //処理
      MessageDlg('閉じるボタンを無効化しました!', mtInformation, [mbOk] , 0);

      //閉じたい場合
      //inherited;

      //閉じたくない場合
      //ハンドルを取得
      hBarHandle := GetSystemMenu(Self.Handle,False);

      if hBarHandle <> 0 then
      begin
        //閉じるボタンを無効化する
        EnableMenuItem(hBarHandle, SC_CLOSE, 
          (MF_BYCOMMAND or MF_DISABLED or MF_GRAYED));
        //グレイアウトして無効化されるが、削除はできない
        //DeleteMenu(hBarHandle, SC_CLOSE, 
        //  (MF_BYCOMMAND or MF_DISABLED or MF_GRAYED));
      end;
      DrawMenuBar(Self.Handle);
      //メッセージは「なかった」ことにする
      Msg.Result:=0;

    end;
  else
    inherited;
  end;
end;

で、FormCreate時に、ドッキングを制御するクラスを指定。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //ToolBarの閉じるボタンを無効化
  ToolBar1.FloatingDockSiteClass:=TToolDockSite;
end;

保存して、実行すると・・・

閉じるボタンをクリックすると「無効化」のメッセージを表示
[×]部分がグレイアウトして無効化されている

「ToolBarの閉じるボタンの無効化」は、こちらで紹介されていた記事を参考にして、さらに、この練習プログラムで必要なコードと情報を追加しました。質問者様と回答者様に厚く御礼申し上げます。

TOOLバーのFloating解除

https://www.petitmonte.com/bbs/answers?question_id=4452

実際の採点プログラムでは、最初に設定画面で「採点する答案の書式」・「画面を横にスクロールさせる移動ボタン利用の有無」・「1クリックで移動する解答欄数(=人数)」を指定してもらい、採点を実行。

縦書き答案で、移動ボタンを利用し、1クリックでの移動数は10名分を指定する例
Formにドッキングさせる前のToolBar
右から左へ採点、No,15まで来たら「左へ移動」ボタンをクリック
画面の右端がNo,1からNo,11になる(1クリックで10名分スクロールする)

計算方法は簡単。
個々の解答欄画像1個分の幅を記憶している動的配列から該当解答欄の幅を取得。
これにスクロールする解答欄数を掛ける。
この値を、現在の水平スクロールバーのPositionから引き、
得られた値を水平スクロールバーのPositionに代入する。これだけ!

//縦書き(左へ移動)
//現在、処理中の解答欄番号を取得(-1するのは動的配列要素を考慮)
int解答欄番号 := StrToInt(現在採点している解答欄番号.Text)-1;
//幅の増分 -> 幅の異なる解答欄に対応
XPlus := arryPX[解答欄番号] - arryIX[解答欄番号];
ScrollBox1.HorzScrollBar.Position :=
  ScrollBox1.HorzScrollBar.Position - (XPlus * StrToInt(移動人数.Text));

採点結果は、元の答案画像へ書き戻して、最後に合計点を自動計算。ユーザーが指示した場所へ書き込み。受験者へ返却する答案画像として印刷して、採点終了。やったー!

採点結果を書き戻した答案画像。これを印刷して受験者へ返却する。

3.初めてBevelを使う

目標は実現できた。あとはバグ取りはもちろんのこと、ユーザーになるべくやさしいインターフェイスを提供したい。そのようなユーザー目線で使ってみるといろんなことに気がつく(もちろん、ユーザーに言われて初めて気がつくことも、あるけれど・・・>_< )。

たとえば、コレ!

縦に長い解答欄画像の中に、移動ボタンが埋もれちゃった!

このような場合は、愛しの移動ボタンを「救出」して、他の適切な位置へ素早く配置転換しなければならない。

☆障害物がない場所へ無事移動できました☆

でも、ドッキング時のカタチがコレでは・・・

「かくれんぼ」なら、かなり強者になれそうだが・・・
普通のヒトは困ってしまうレベルのわかりにくさ。すでにボタンにも見えない。

「ここ」をクリックして、
ドラッグすればイイんだなー みたいなモノがあれば・・・☆
どうしたら、いいかなー?

そうだ☆ つかみどころが「ない」んだ!
つかみどころを作ろう!

でも、どぉすれば いい?

ワクだ。枠。枠がほしい。
でも、枠のVCLは、どこにある?

そういえば・・・パラパラっと、この前眺めた参考書になんかあったような・・・
確か、ベバルとか、ベビルとか、ベブルとか、んー! なんだったっけ?

正解は「Bevel(ベベル)」でしたー☆ 舌噛んだー

言葉の意味としては、多種多様な業界で使われ、実に様々な意味をとることが多いそうなのですが、PC業界ではおそらく「デザイン性を上げるための作業を指すのがベベルという言葉です。見た目の雰囲気を変えるのが面取りです・・・」というあるWebサイトにあった言葉が最も適切な気が・・・。

ベベルの意味を用語ごとに3種紹介|一般的な意味と辞書の意味とは

https://lostash.jp/sales/business-skill/1088812#toc17より引用

まぁ ここではとりあえず「枠」で行きます!
さっそくサイズ20×23のBevelをToolBarに配置。

ToolBarの右部分に余白を作っておいたのはこのためです。

Shapeプロパティは、「枠」なんだから迷わず「bsFrame」を指定。
Styleプロパティは、盛り下がる(=凹む)「bsLowered」と、盛り上がる「bsRaised」のふたつにひとつだから、有無を言わさず盛り上がる「bsRaised」に決定。

プロパティを設定

気になる実行時画面は・・・

フローティング時のBevelさん
Formにドッキングした時のBevelさん

Bevelさん、どちらも「しっかり」自己主張してます。

実に、イイ感じ。
誰がどう見ても、この枠内をクリックすれば、
何か、起きそうです。

ここをクリックしてドラッグ・・・なんて言わなくても、
ヒントも表示しなくても、
きっと、大丈夫。

ただ、Bevelさん、あなた・・・
盛り下がってる ようにしか、見えないのですが。
私の気のせいですか・・・?

それは、置いといて
実は、ものすごーく、大切なコトがあるのです。
このままではBevelさんをクリックしてもナニも起きません!

どこを探しても「Enabled」プロパティがありませんが・・・

オブジェクト インスペクタに表示されてませんが、
Bevelさんには、なんと! Enabledプロパティがあって、
しかもそれはデフォルト:True (=有効)で、
このままでは、Bevelさんの下にいるToolBarくんに、
クリックが伝わらないのです。

では、どぉすればいいかと言うと・・・
FormCreate時に、

  //クリックイベントをToolBarへ届ける
  Bevel1.Enabled:=False;

これでOK!
Bevelさんは自己主張しつつ、自らを無効化。
「枠」という役割に専念してくれるようになります!

4.まとめ

  1. Formの上にControlBarを置き、ControlBarの上にToolBarを配置すれば、ToolBarをフローティングさせることができる。ToolBarプロパティは、DragKindプロパティを「dkDock」に、DragModeプロパティを「dmAutomatic」に設定する。
  2. ControlBarやFormなど、ドッキングを受け入れる側は、DockSiteプロパティをTrueに設定するだけでOK!
  3. ToolBarの閉じるボタンは、プログラムコードを書いて無効化できる。
  4. Bevelは「枠」として利用できるが、Enabledプロパティがデフォルトで有効(True)になっているので、クリックを下のVCLに通知するためには、FormCreate時にEnabledをFalseに設定して、Bevel自身を無効化する必要がある。

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

BringToFront

最前面に表示する!

TImageに表示したある画像の上を、マウスでドラッグして、矩形選択するプログラムを書いた。

ちょっとだけ、同じセクションの仲間に「今度書いてるプログラムなんだけど。けっこうイイかんじで・・・」みたいな話をしたら、ICカードリーダーを使った出退勤管理のプログラムを作った時と同様に、「あいつがまた、ナニやらおかしなプログラムを書いたらしい」と、同僚から同僚へ、さらに別のセクションの人たちにも「風の便りに聞いたけど、これは内緒の話・・・」みたいな感じで次々に噂が広まり、果ては「あのイヤな仕事をかなり高速に処理できる魔法のプログラムが出来たらしい」と話しに「尾ひれ」が付いて評判となり、その「幻のプログラムの使い方」は職場内で「呪文の伝授」と呼ばれ、果ては公開前なのにすでに伝説化して、頼んでもいないのに積極的に人柱になりたい(=プログラムを試用したい)との申し出が若手の職員から殺到。

そんな時、プログラムの根幹をなす「画像の上をマウスでドラッグして、ラバーバンドを描きながら矩形選択」する部分で大問題が発生。僕自身が行ったテストでは何の問題もなかったのに、なんと、テストを頼んだ同僚が用意した画像上には「絶対にドラッグできない領域」が存在するとの報告が・・・。僕が用意した画像では何の問題もなくドラッグして、矩形選択できたのに・・・。

問題の解決までに2日半、エンエンと悩み続けることに。

以下、Delphiに触れて十数年も経って「初めて」知った「BringToFront」の物語。

1.プログラムの仕様
2.遭遇した摩訶不思議な現象
3.解決までの道のり
4.問題を再現
5.まとめ
6.お願いとお断り

1.プログラムの仕様

作成したプログラムはTImageを2個準備して、そこに表示した別々の画像を切り替えて仕事をするというもの。具体的には、画像Aの一部を範囲指定(矩形選択)してコピー、画像Bに貼り付け、次に、現在のそれとはまた別の画像をAに表示し、一部を矩形選択してコピー、画像Bに貼り付け、これを自動的に繰り返して仕事に必要な画像を一揃い画像Bに表示し、あとはユーザーが目視で内容を確認しながら、一斉に処理するというものだ。

だから、最初にコピーする範囲を指定する必要があり、画像Aで矩形選択ができなければ仕事にならない。よりによって、プログラムのいちばん根幹をなす部分で未知のトラブルに遭遇するとは・・・

2.遭遇した摩訶不思議な現象

僕自身が用意した画像でテストした時は、少なくとも矩形選択に関しては何も問題は起きなかった。他に細かなトラブルはたくさんあったけど、すべて原因がすぐわかり、これまでに培った知識で何とか解決できることばかりだった。テストのテスト的に、ごく近しい同僚に試用してもらった結果も良好だった。

そこで、テストのテストで見えてきた(実際に運用した際に発生すると予想される)エラーの処理をある程度書き加え、実用的なプログラムとして完成に近づいた段階で、職場内の別のセクションの仲間にテストを手伝って欲しいと依頼して、限られたセクションに属する人だけが入れるネットワークフォルダにプログラムを置き、テストを実施。

そして事件が発生。

支給されたノートPCを抱えてやってきた同僚が言うには、画像の一部に絶対に矩形選択できない場所があるというのだ。

そんなバカな! ・・・と思いながら、確かめたら本当だった。

信じたくない。信じたくない。信じたくない。夢なら覚めてくれ・・・。
そう祈りつつ、何遍クリックしても、同僚が用意した画像上の、「その領域」だけは絶対に選択できない。ラバーバンドの「ラ」の字も現れない。不思議なことに、同じ画像上の別の場所ならラバーバンドが普通に表示されるし、矩形選択もできるけど。その画像上の「ある領域」だけは、絶対に選択できない・・・。何度、何遍クリックしても・・・。

この現実は、絶対、信じたくないから、お互いに見つめあって、口をついて出た言葉は、お決まりの・・・

もしかして、マウスが壊れてるんじゃないか?

無線じゃなく、USBヒモの付いてる普段は絶対に使わないマウスに試しに交換。
祈りと願いを込めて画像上のある一点をクリックするも、PCは無反応。OnMouseDownイベントは発生の兆しすらなし。My TImageには、この期待も、祈りも、願いも、すべて届かず・・・

あぁ TImageよ、きみを泣く。
きみ、死にたもうこと なかれ。

なんとゆーことに。毎日午前2時から起きてプログラム書いたのに・・・
なんで夕陽が東から昇るんだって、疑問に感じながら毎朝ハンドル握ったのに・・・
今日の第2部の始まりだって、自分に言い聞かせて「昼間」ずっと働いたのにー

画像を表示し きみなれば
ほかに仕事はなかりしも、
せめてマウスのドラッグに
応える心を持ち給え、

祈りつつ、願いつつ、ドラッグしても、ポイントしても、TImageは期待を完全に無視。

ドラッグ無視してコケよとて
きみを完成間際まで育てしや。

愛してたのにー。 T_T
エラーすら出してくれないDelphiを逆恨み。可愛さあまって憎さ100000000倍。

あぁ 神さま
どうか 夢なら覚めてください・・・

正直、この時はプログラムの公開を目前に控えて「初めて遭遇した現象」に激しく狼狽。

(なんで、エラーすら出ないのかなー)

なんとかしなければならない。そう、なんとかしなければならないのだが、解決方法がまったくわからない。泣いても、喚いても、誰も助けてはくれない。

「プログラム使うの、楽しみにしてるね!」

そう言ってくれた同僚の笑顔が瞼に浮かぶ。

今更、「プログラム。コケました!」・・・なんて、絶対に言えない。

公開すると約束した日まで、あと3日。

仕事上の約束はこれまで必ず守ってきた。
今、この約束は破れない・・・。

3.解決までの道のり

問題が発生したのは金曜日の午後。幸いなことに土日は休日で予定は何も入っていないので、仕事に復帰する月曜日までの丸2日間、問題の解決に専念できる。それだけを唯一の救いにして、問題の原因と解決方法を考えよう・・・

(ほんとに、OnMouseDownイベントが発生してないのかな?)

初めにそれを確認することにして、ログを記録するように設定し、プログラムを走らせて矩形選択できない領域を何度もクリック&ドラッグ。プログラムを停めて、テキスト形式で記録されたログを確認。予想した通り、そのどこにもOnMouseDownイベント発生の記録はない。これでとにかく、「それが発生していない」ことだけは確実にわかった。

次に考えたのは、TImageに表示するJpeg画像の縮小率を変更して試してみること。・・・と言うのも、スキャナーで読み込んだ画像がPCの画面上で表示するのにデカすぎる場合は、任意の大きさに縮小できるよう予めプログラミングしてあり、その縮小率を変更したら、もしかしたら矩形選択できるようになるのではないか? と、思ったのだ。

問題が発生する前、A3サイズの用紙をスキャナーで読み込んでみたが、画像がかなり大きくて50~80%に縮小しないと、そのままでは作業に使えないことが判明。画像の状況により、ユーザーの判断で任意の縮小率を設定できるようにしてあった(プレビュー画面で確認しながら縮小率を設定できるようにプログラミングした)。

問題となった画像の縮小率は75%だったので、これを68%に変更。プログラムを動かして確認すると何の問題もなく動作する(実は、縮小率を変更したため、範囲指定する領域が変化して、たまたま矩形選択できない領域を外れてた・・・つまり、単にラッキーだった・・・だけなんだけど)。でも、これで一安心。原因はわからないが、もし問題が発生した場合は、縮小率を変更して試してもらえば、プログラムは正常に動作する可能性が「ある」ことが確認できた。

こうして「まったく動作しない」という最悪の事態だけは、なんとか、回避できる見込みがついた。しかし、問題の根本的な原因は一向に解明できないまま、土曜、日曜と時間だけが虚しく流れた。

日曜は、朝から机に向かって(あぁでもない・こうでもない)と思いつく限りの方法を試したが、「特定の縮小率を指定して作成したある画像に限って、絶対に矩形選択できない領域がある」という事実に変化はなく、前に困った時のことを思い出して、TImageのEnabledプロパティを間違いなくTrueに設定してもラバーバンドは出現せず、様々にキーワードを変えてGoogle先生に伺いを立てても、その解答に問題解決のそれらしきヒントとなるような内容は見当たらず、万策尽きて・・・。こんなことで時間を無駄にするよりは、まだ作りきってない部分や、手直しが必要な部分もいくつかあるから、そっちの仕事を先にやって・・・みたいな感じで、問題の原因調査とプログラム作成・手直しの間を1日中、行ったり、来たり。

(画像によっては、何の問題もなく処理できるし、問題の起きた画像でも縮小率変えれば使えたりするからー。ユーザーには、問題が起きることもあるけど・・・って、あらかじめ、そう説明して・・・使ってもらえばいいかぁ T_T)

日曜の夕方、折れかけた心を抱えたまま、僕はベッドに倒れ込んで・・・

目覚めたのは日曜の深夜・・・というより、月曜の早朝(?)午前0時すぎ。

(まだ、朝までには数時間ある・・・。選択肢はやるか・やらないか、のみ)

( やるしか、ない・・・ )

Google先生に再び訊ねた検索キーワードは「Delphi Image onMouseDown 起きない」
これはもう何度も使った検索キーワード。でも、もしかしたら、もしかしたら、どこかに見落とした情報があるんじゃないか・・・。やっぱりキーワードはこれしかないだろーって、そう思いながら、あるWebサイトの記事を見た瞬間。視野でない場所に、ナニかが見えた気がした・・・。その記事がこちら

Imageで描画したものが常にTop

https://www.petitmonte.com/bbs/answers?question_id=7660

気になった言葉は、ただ一言。「BringToFrontでは意味がなく…」

BringToFront ってナンだ? オレ、知らないぞ。
Delphiにそんなメソッド、あったっけ?

・・・ ってか、確か Formに配置した順に ・・・
・・・ コントロールは積み木を積むように ・・・
・・・ 上に、上に、重なって ・・・

そうだ。オレ、最初にFormを用意して、
ScrollBoxを置いて、
その上にImageを載せて・・・

そのあと、RadioGroupとか、ListBoxとか、Editとか、
アレも、コレも、たっぷりVCLコントロール積んだカラ。

Imageは 積み木のいちばん下になってる・・・
問題のほんとうの原因はきっと、コレだぁ!!!

あぁ 長かったぁ・・・

BringToFront が、なんのことか、まだわからんけど、
(おおよその挙動は文字から伝わるけど)
それを調べるより先にやることがある。それはナニかと言うと・・・

Imageを切り取って、ScrollBoxの上に貼りなおすコト!
これでImageが積み木のいちばん上にくるはず!!

プログラムを走らせる。
まったく言うことをきいてくれなかった画像を敢えて選ぶ。
絶対にクリック出来なかった領域を、クリック。

夢にまで 見た ラバーバンドが 現れた!!!

あきらめなくて・・・ よかったぁ

そして、さらに気がついたことは・・・
つい、さっきまでImageの上に表示されてた
( 今日:正確には昨日、作ったばかりの )
残り工程数を示すためのLabelが見えなくなってる・・・

調べなくても、これでわかった!
こんな時は、きっとLabelにBringToFrontなんだぁ

“BringToFront”

これまで使ったことないし、その存在さえすら知らなかったけど、
ここで早速、それが存在するもっともな理由を、自然な流れの中で確認&納得。

Imageには、いつも何か画像を表示するだけで、縮小・拡大・回転はしても、切ったり、貼ったりしたのはオレ、今回がたぶん、初めてだもんなー。

プログラムも、僕も、少しだけ
よく なれた かな?

4.問題を再現

簡単な検証プログラムで問題が再現できれば、今回のミスの原因は完全に解明できたことになる・・・。そう考えて作ってみたのが次の検証プログラム。科学する心。

Form上にScrollBox、その上にImageを二つ載せ、CheckBoxを二つ用意。

ここで重要なのは、VCLコントロールを設置する順番。

最初にScrollBox、
次がImage1、
最後にImage2 の順番でなければならない。

わかりやすくするため、TImageのAlignはalNoneのまま、大きさだけを上の図のように、Image1がImage2より大きくなるように設定。Image2は、Image1の上に乗ってる感じで設置。

で、Image1のVisibleプロパティはTrue、Image2のVisibleプロパティはFalseに設定。

それからTImageのEnabledプロパティはどちらもTrueにしておく。

(以前、ユーザーの誤ったクリックを防止するため、ある手続きの処理の最後に、これをFalseに設定し、Trueに戻すのを忘れたまま、次の手続きに進み、今回とは別の理由で矩形が描けなくて大騒ぎ。この場合もエラーメッセージ等は出ないので、原因がわかるまで相当長時間にわたり悩んだことがあった・・・)

ScrollBoxを置いたのは、問題を起こしたプログラムと同じ仕様にするためで、それ以外の特別な意味はない。

ラバーバンドの描画コードは、Mr.XRAYさんのWebサイトにあったコードをそのまま使わせていただく。

154_画像の矩形範囲選択とラバーバンド

http://mrxray.on.coocan.jp/Delphi/plSamples/154_Rubberband.htm#01

上のコードでは、ラバーバンドをFormに描画しているので、これをImageのCanvasに描画するように変更したコードが、以下。

まず、必要な変数の宣言と、Image1のOnMouseDownイベント。

  private
    { Private 宣言 }
    InitX : Integer;
    InitY : Integer;
    PrevX : Integer;
    PrevY : Integer;
    DragFlag : Boolean;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  if Button = mbLeft then
  begin
    //TImageのCanvasの描画をクリア
    Image1.Canvas.Brush.Style := bsSolid;
    Image1.Canvas.Brush.Color := Self.Color;
    Image1.Canvas.FillRect(ClientRect);
    //クリック位置の座標を取得
    InitX := X;
    InitY := Y;
    PrevX := X;
    PrevY := Y;
    DragFlag := True;
    //描画設定
    Image1.Canvas.Pen.Mode := pmNotXor;
    Image1.Canvas.Pen.Color := clBlue;
    Image1.Canvas.Pen.Width := 1;
    Image1.Canvas.Pen.Style := psDot;
    Image1.Canvas.Brush.Style := bsClear;
    //矩形を描画
    Image1.Canvas.Rectangle(InitX, InitY, PrevX, PrevY);
  end;

end;

同じくImage1のOnMouseMoveイベント。

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin

  if not DragFlag then exit;

  //不要な部分を消去
  Image1.Canvas.Rectangle(InitX, InitY, PrevX, PrevY);
  //新しい矩形を描画
  Image1.Canvas.Rectangle(InitX, InitY, X, Y);
  //現在値を取得
  PrevX := X;
  PrevY := Y;

end;

最後にImage1のOnMouseUpイベント。

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  if not DragFlag then exit;

  //ラバーバンドの描画終了
  DragFlag := false;

  //不要な部分を消去
  Image1.Canvas.Rectangle(InitX, InitY, PrevX, PrevY);

  //ラバーバンドの最終サイズで矩形を描画
  Image1.Canvas.Pen.Color := clBlue;
  Image1.Canvas.Pen.Width := 3;
  Image1.Canvas.Rectangle(InitX, InitY, PrevX, PrevY);

end;

この状態で保存して実行すると・・・

ドラッグ中は、クリック位置(矩形の左上)を起点に、点線で矩形が描画される
マウスの左ボタンを離すと、選択範囲に太い実線で矩形が描画される

で、問題の再現。

Form右上に置いたCheckBox1のCaptionを「Image2を表示」にして、そのOnClickイベントに次のコードを書く。

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    Image2.Visible := True;
  end else begin
    Image2.Visible := False;
  end;
end;

プログラムを保存して、実行。CheckBox1にチェックを入れて、(見えないけど)Image2を表示。この状態でさっきと同じ場所をドラッグして、矩形選択しようとしても・・・

あたりまえですが、エラーも起きません!

ここで、いよいよ “BringToFront” の出番。

CheckBox2のCaptionを「Image1を最前面に表示」として、OnClickイベントには次のコードを記述。

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked then
  begin
    Image1.BringToFront;
  end else begin
    Image1.SendToBack;
  end;
end;

保存して実行。

最初に、ChekBox1をチェック -> Image2が表示される(見えないけど)。

いちおうImage2があると思しきあたりをドラッグして矩形選択できないことを確認。

次に、CheckBox2をチェック -> Image1が最前面に表示される(はず)。

で、Image2があると思しきあたりをドラッグすると、今度は矩形が描かれる。

Image2のVisibleプロパティがTrueでも、Image1をBringToFrontすれば矩形が描画される

わかってしまえば、ほんとに、なんでもないこと・・・なんだけれど。
それが「わかる」までは(こんなことで悩むのは僕だけかもしれませんが)、
ほんとうに、苦しかった。

僕が調べた範囲では、Web上に「こんなことがあったよ!」っていう情報はなかったので、ここに “BringToFrontの物語” として記録しておけば、100万人にひとりくらい、もしかしたらいるかもしれない、同じ問題で困っている人へのヒントになるかもしれない・・・。

そう思ったのです。

5.まとめ

画面に描画処理を行う必要があるTImageを含む、複数のTImageを切り替えて使うプログラムを作るときは、描画処理対象のTImageを呼び出す(VisibleプロパティをTrueにする)際に必ず、次のようにして、これを最前面に表示しておく。

  //最前面に表示(持ってくる)
  Image1.BringToFront;

この設定を忘れると、他のVCLコントロールの設置状況によるが、矩形が描画できない領域が生じることがある。

この “BringToFront” と対をなすメソッドは “SendToBack” 。
こちらの使い方は、例えばCheckBoxのチェックの有無に対応させて、

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked then
  begin
    Image1.BringToFront;
  end else begin
    Image1.SendToBack;
  end;
end;

Checkedの時は “BringToFront” でいいけど、not Checkedの時はどうしたらイイ?
・・・と思って調べて、”SendToBack” メソッドの存在も知りました!

6.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

I don’t want to press the enter key to confirm the input.

「入力確定のEnterキーは押したくない!」

TStringGridを使って何らかの入力作業を行う時、任意のあるキーを押したら直ちに、予め指定した内容をアクティブなセルに入力し(入力を確定)、次のセル(右 or 下)へフォーカスを移したいことがある。これは、そんな時のための備忘録。

1.Bキー押し下げでゼロを入力したい理由
2.StringGridを準備する
3.Bキー押し下げでゼロ入力を実装(その1)
4.任意の1文字+数字の入力を負の数に変換
5.Bキー押し下げでゼロ入力を実装(その2)
6.まとめ
7.お願いとお断り

1.Bキー押し下げでゼロを入力したい理由

手書き答案をスキャナーで読み込み、採点するプログラムを書いた。元の答案画像から設問ごとに解答欄をかき集めて一覧表示し、まとめて採点すれば効率よく採点できると思ったのだ(実際、試してみたら驚くほど速く採点できた!)。その手順を紹介。

ぱっと見て「よく出来てるなー」と思ったら、全員分採点記号と得点を一括入力
誤りの解答だけ採点記号を × にして、得点はゼロに変更

採点スタイルとして予定した(考えた)のは、「左手で入力作業、右手はマウス操作(解答欄のクリックと画像のスクロール)に専念する」というカタチ。

解答欄画像をクリックしたら、その座標から解答番号を計算し、採点欄のフォーカスが自動で移動するようプログラミング。(その方法は以下のリンク先を参照してください)

で、正の数値を入力したら、そのまま採点欄に、その数値が入力され、
Qとか、Sとか、何か文字を入力して確定したら、採点欄には0(ゼロ)が入り、さらに

オプション設定で「マイナス(ー)」記号に変換する文字を指定

上の設定であれば、aキーに続けて数字を入力して確定した場合は、採点欄に負の値が入力されるようにプログラミング。なぜaなのかというと、左手小指のホームポジションだからまず間違えずに(位置を確かめずに)押し下げ可能だと思ったから。

そもそも、なんで、こんな仕様(入力値が正負の数およびゼロ)にしたかというと、採点欄への数値入力と同時に、入力された数値に応じて、解答欄画像の方にも、採点記号と得点を(透過状態で)表示するプログラムにしたかったから。具体的な表示内容は次の通り。

(1)入力が正の数なら、解答欄画像の上に採点記号と得点を表示、
(2)入力が0(ゼロ)なら、解答欄画像の上に採点記号 × のみを表示
  (ゼロは〇:まるとまぎらわしいのでデフォルト設定では表示しない)、
(3)入力が負の数なら、解答欄画像の上に採点記号と部分点を表示。

当初、この採点補助プログラムでは、採点記号として〇と × しか利用できなかった(△とした場合に、それを見分ける良いフラグが用意できなかった)が、コピペしたプログラムコード中に残していた負の数は赤で表示するコードを見て、負の数を「部分点あり」のフラグとして利用できることに気づき、「部分点あり」の採点記号△も使えるように改良。

部分点を与える時は採点欄にマイナス記号に変換する文字と部分点になる数値を入力し、Enterキー押し下げ
負の数で「部分点あり」を表現(合計点は絶対値で計算すればイイ)

マウスは右手で操作する(左利きの方も?)ので、自ずと採点は左手で行うことに。

多くの場合、1問あたりの得点は5点未満だろうから、これらの数字キーはキーボードの左側にあって押しやすい。もし、数値でなく文字が入力された場合は、有無を言わさず0(ゼロ)に変換してしまえば、左手側にある1~5の数字キーの下には押しやすい文字キーがたくさんあるから、キーボード右側にあって、左手が届きにくい0(ゼロ)キーは押さなくてすむ。

あとは右手でマウスを操作し、解答欄画像を次々にクリックして、採点欄のフォーカスを切り替えて(=入力を確定して)行けば・・・

採点補助プログラムとして、十分使えるかなー?っと思ったんだけれど、

実際使ってみたら、入力後、次の解答欄画像をいちいちクリックして( or Enterキーを押し下げして)入力を確定 & 次の採点欄へフォーカスを移動させるのが、非常にめんどくさい。

せめて × の場合だけでも、採点欄に0(ゼロ)を入力した瞬間に、解答欄画像上に × を表示し、フォーカスが自動で次のセルへ移動するようにできないか?

そんな理由から、採点記号「 × 」は「ばってん」だから、BATTENで、Bキー押し下げ、即、0(ゼロ)を入力 & 確定、フォーカスは次のセルへ自動で移動するプログラムを書くことに決めました(Bキーも左手で押しやすい位置にあるのがうれしい!)。

2.StringGridを準備する

Bキー押し下げ、即、入力確定のプログラム自体は、前にStringGridで矢印キーの動作を制限したことがあったので、その時学んだテクニックを応用すれば、きっと書けると思ったので全然心配はなかったが、それを設定する対象のTStringGridは実に設定し甲斐のあるコントロールで、ある目的を実現(実装)しようとすると、そこに行きつくまでの工程が何段階も必要だったりする。

今回、この記事を書くのにあたり、いい機会だからStringGridの設定について(自分自身の勉強の復習の意味も込めて)まとめてみた。練習用に手間をかけずに作成したFormとコントロールは次の通り(Formに各VCLコントロールを置いただけ!)。

Form上に、StringGrid、Label、ComboBox、CheckBoxを各1個ずつ用意

で、FormCreate時の手続きは・・・

procedure TForm1.FormCreate(Sender: TObject);
begin

  //[Enter]でコントロールを移動させるために、Form上のコンポーネント
  //より先にキーボードイベントを取得する。
  KeyPreview := True;

  //描画処理は自前で行わずDelphiにおまかせ
  StringGrid1.DefaultDrawing := True;

  //Fixed(固定セル)のスタイル
  //現在のオペレーティングシステムのテーマを使用
  StringGrid1.DrawingStyle := gdsThemed;
  //標準のテーマの指定がないスタイル
  //StringGrid1.DrawingStyle := gdsClassic;
  //グラデーションのあるスタイル
  //StringGrid1.DrawingStyle := gdsGradient;

  //セルを強調表示
  StringGrid1.Options := StringGrid1.Options + [goDrawFocusSelected];

  //Clickでセル編集を可能にする-> [goEditing]をTrueに設定(方法は以下の通り)
  StringGrid1.Options := StringGrid1.Options + [goEditing];
  //常に編集可能に設定
  StringGrid1.Options := StringGrid1.Options + [goAlwaysShowEditor];

end;

KeyPreview := True の設定の他は、すべてStringGrid関係。僕がこのコントロールを使う時は、常に編集可能状態で起動するように設定することがほとんど。

続けてFormShow手続き。

procedure TForm1.FormShow(Sender: TObject);
var
  i : integer;
begin

  //行数と列数を適当に指定(Fixedセルを除いて10行10列あればテスト用途には十分)
  StringGrid1.RowCount := 11;
  StringGrid1.ColCount := 11;

  //FixedCols & FixedRows(固定列と固定行)を設定
  StringGrid1.FixedCols := 1;
  StringGrid1.FixedRows := 1;

  //フィールド名をセット(Rowに一括設定)
  //',Aの[,]に注意!-> セル[0,0]は空欄(フィールド名は入れない)
  //プログラムが長くなる時は['+]を使用してフィールド名を設定する
  StringGrid1.Rows[0].CommaText := ',A,B,C,D,E,F,'+
    'G,H,I,J';

  //FixedRows(固定行)に値をセット
  for i := 1 to 10 do
  begin
    StringGrid1.Rows[i].Append(IntToStr(i));
  end;

  //StringGrid1へフォーカスを移す。
  //下のようにまずフォーカスを移してからCol, Rowを指定。
  //でないとエラーになる。
  StringGrid1.SetFocus;
  StringGrid1.Col := 1;
  StringGrid1.Row := 1;
  StringGrid1.SetFocus;
  //カーソルが見えるようにする
  StringGrid1.EditorMode := True;

end;

さらにStringGrid1DrawCell手続きで、Fixed(固定)セルの表示方法と、入力された数値の右寄せ表示を指定。

implementation

uses
  Vcl.GraphUtil;

  //GraphUtilはFixedセルのセンタリング用に追加

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i : integer;
begin
  //Fixedセルをセンタリング
  with StringGrid1 do
  begin
    if (gdFixed in State) then
    begin
      //usesにGraphUtilを追加(Vcl.GraphUtilではないことに注意!)
      //->Vcl.GraphUtilとすると「未定義の識別子エラー」になる!
      //GraphUtil.GradientFillCanvas(Canvas, GradientStartColor,
      //  GradientEndColor, Rect,gdVertical);
      //Vcl.GraphUtilとusesした場合
      //これは未定義の識別子エラーにならない
      Vcl.GraphUtil.GradientFillCanvas(Canvas, GradientStartColor,
        GradientEndColor, Rect,gdVertical);
      //センタリング
      DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),
        -1, Rect, DT_CENTER OR DT_VCENTER OR DT_SINGLELINE);
    end;
  end;

  //セルの表示を制御
  if not (gdFixed in state) then
  begin
    if StringGrid1.Cells[ACol,ARow] <> '' then
    begin
      //数値であるかどうかをCheck
      if not TryStrToInt(StringGrid1.Cells[ACol,ARow],i) then Exit;
      {数値である場合}
      //背景色を白に設定
      StringGrid1.Canvas.Brush.Color := clWhite;
      //正負をチェック
      if StrToInt(StringGrid1.Cells[ACol,ARow]) < 0 then
      begin
        StringGrid1.Canvas.Font.Color := clRed;
      end else begin
        StringGrid1.Canvas.Font.Color := clBlack;
      end;
      //セルを塗りつぶす
      StringGrid1.Canvas.FillRect(Rect);
      //数値は中央寄せで表示
      {DrawText(StringGrid1.Canvas.Handle,
              PChar(StringGrid1.Cells[ACol,ARow]),
              //[+1]は数値描画位置の調整のため
              Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
              DT_CENTER or DT_VCENTER or DT_SINGLELINE);}
      //数値は右寄せで表示
      DrawText(StringGrid1.Canvas.Handle,
              PChar(StringGrid1.Cells[ACol,ARow]),
              //[+1]は数値描画位置の調整のため
              Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
              DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
    end;
  end;
end;

ついでにIMEも設定(IME ONの列は任意指定)。まず、次のように宣言しておいて・・・

//Col毎のIMEの制御(制御内容はStringGrid1GetEditTextを参照)
type
  _TGrid = class(TCustomGrid);

var
  Form1: TForm1;

implementation

StringGrid1GetEditText手続きで、次のように設定。

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  //IMEの制御
  with TEdit(_TGrid(Sender).InplaceEditor) do
  begin
    case ACol of  //最初のAColは「 0 」
      2: ImeMode := imHira; //日本語入力ON
    else
      //ImeMode := imClose;   //日本語入力OFF-> ×
      ImeMode := imDisable;   //日本語入力OFFは imDisable
    end;
  end;
end;

ここまでの設定で、実行時の画面は、こんな感じ。

某有名表計算ソフト風の画面が出現

Enterキーでフォーカスを移動するために、FormKeyPress手続きで、次のように設定。

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  //[Enter]キーでコントロールを移動
  //StringGridは編集可能にFormCreateで設定しておく
  //->忘れるとセルの移動にEnter×2回必要!
  //この方法を使う時はKeyPreview:=True;をFormCreateで指定。
  if Ord(Key) = VK_RETURN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        //VK_TABではカーソルがレコードの項目を右へ移動。
        //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
        //VK_DOWNにすると同じ項目の次のレコードへ移動。
        //if intStringGrid1ActiveRow < StringGrid1.RowCount-1 then
        if TargetRow < StringGrid1.RowCount-1 then
        begin
          ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
        end else begin
          ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
        end;
        Key := #0;
      end;
    end else begin
      SelectNext(ActiveControl,True,True);
      Key := #0;
    end;
  end;
end;

さらに、列幅を自動調整したい場合は・・・

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  iCOL: Integer;
  iROW: Integer;
  MaxColWidth: Integer;
  TmpColWidth: Integer;
begin
  //DefaultColWidthを設定(これでCheck OFF時に元に戻る!)
  StringGrid1.DefaultColWidth:=64;
  //AutoAllColFit(全列幅の自動調整)
  if CheckBox1.Checked then
  begin
    for iCOL := 0 to StringGrid1.ColCount-1 do begin
      MaxColWidth := 0;
      for iROW := 0 to StringGrid1.RowCount-1 do
      begin
        //数字は列幅の調整用
        TmpColWidth := Canvas.TextWidth(StringGrid1.Cells[iCOL,iROW]) + 40;
        if MaxColWidth < TmpColWidth then
          MaxColWidth := TmpColWidth;
      end;
      StringGrid1.ColWidths[iCOL] := MaxColWidth;
    end;
  end;
end;

列幅自動調整実行時の画面は・・・(チェックOFFで、列幅は元に戻る)

列幅調整用の数値を調整して好みの幅に設定(上の画像では40を使用)

これでStringGridの準備が完了!

3.Bキー押し下げでゼロ入力を実装(その1)

※ 各セルに対して10以上の値の入力がないことが前提です!

この機能の実装にあたり、次のWebサイトにあった情報を参考にさせていただきました。質問者様と解答者様のご両名に対して、心から厚く御礼申し上げます。

@NIFTY FDELPHI Delphi Users’ Forum15番会議室「FAQ編纂委員会」に寄せられた「よくある質問の答え」

http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/faq/00075.htm

StringGrid 行移動の把握

https://www.petitmonte.com/bbs/answers?question_id=7289

Private宣言に、次のローカル変数とAppMessage手続きを追加。

  private
    { Private 宣言 }
    //入力=確定&フォーカスの移動用に追加
    //行・列位置を記憶する変数
    TargetRow:integer;
    TargetCol:integer;
    //ある(矢印他)キーが押されたことを知る
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

Shift+Ctrl+C で AppMessage手続きを作成して、次の内容を設定。

※ usesに System.UITypes を追加するのを忘れないこと!(忘れるとBキーを意味するVKBが「未定義の識別子エラー」になる。

重要 次のコードでは、各セルに対して10以上の数値の入力は「ない」ものとしている。

implementation

uses
  Vcl.GraphUtil,
  System.UITypes;

  //GraphUtilはFixedセルのセンタリング用に追加
  //System.UITypesはキーコードでBキー(=VKB)を指定するために追加

{$R *.dfm}

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  //任意のキーの押し下げをキャッチ
  if Msg.message = WM_KEYDOWN then
  begin
    //StringGridがアクティブだったら
    if ActiveControl is TStringGrid then
    begin
      //StringGridが編集可能だったら
      if TStringGrid(ActiveControl).EditorMode then
      begin
        //Bキー or 0キー押し下げでゼロを入力(入力値は10未満であることが前提)
        if (Msg.wParam=VKB) or (Msg.wParam=VK0) then
        begin
          //keybd_event(VK_TAB,0,0,0);
          //VK_TABではカーソルがレコードの項目を右へ移動。
          //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
          //VK_DOWNにすると同じ項目の次のレコードへ移動。
          if TargetRow < StringGrid1.RowCount-1 then
          begin
            //アクティブなセルが最終行でない場合はフォーカスは下へ移動
            StringGrid1.Cells[TargetCol, TargetRow]:='0';
            ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
          end else begin
            //最終行ならフォーカスは上へ移動
            StringGrid1.Cells[TargetCol, TargetRow]:='0';
            ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
          end;
          //Msg.wParam:=#0; //エラーになる
          Msg.wParam:=0;
        end;
      end;
    end;
  end;
end;

FormCreate時に、AppMessageを有効にする。これを忘れると動かない!

procedure TForm1.FormCreate(Sender: TObject);
begin

  ・・・ 省略(StringGridその他の初期設定) ・・・

  //入力=確定&フォーカスの移動用に追加
  //StringGridの初期位置の設定
  TargetRow := 1;
  TargetCol := 1;
  //AppMessageを有効にする
  Application.OnMessage := AppMessage;

end;

AppMessage手続きの引数にはACol, ARowがないから、その代わりにStringGrid1SelectCell手続きの最後で、行列位置を変数に取得。

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  //入力=確定&フォーカスの移動用に追加
  //セルを選んだときに行位置を記憶
  TargetRow := ARow;
  //セルを選んだときに列位置を記憶
  TargetCol := ACol;
end;

実行時の様子は・・・

Bキーもしくは0キーの入力と同時にフォーカスは下のセルに移動する

4.任意の1文字+数字の入力を負の数に変換

Formに用意したLabel1のCaptionプロパティには「マイナス記号に置換する文字:」を設定し、ComboBox1のTextプロパティに「a」を設定。

FormCreate手続きの最後で、マイナス記号に置換する文字の選択肢を準備。

procedure TForm1.FormCreate(Sender: TObject);
begin

  ・・・ 省略 ・・・

  //入力=確定&フォーカスの移動用に追加
  //StringGridの初期位置の設定
  TargetRow := 1;
  TargetCol := 1;
  //AppMessageを有効にする
  Application.OnMessage := AppMessage;

  //マイナス記号に変換する文字の選択肢
  ComboBox1.Items.Add('q');
  ComboBox1.Items.Add('a');
  ComboBox1.Items.Add('z');

end;

StringGrid1DrawCell手続きに、次の赤字の部分を追加。
(1列目であったら、文字の入力はすべてゼロに変換する処理も追加している)

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i: integer;
  str1, str2: string;
begin

  ・・・ 省略 ・・・

  //セルの表示を制御(中央寄せ・負の数は赤で表示)
  if not (gdFixed in state) then
  begin
    if StringGrid1.Cells[ACol,ARow] <> '' then
    begin

      //文字数が2文字なら実行
      if Length(WideString(StringGrid1.Cells[ACol,ARow])) = 2 then
      begin
        //指定文字が入力されたら'-'に変換
        str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
        str2 := Copy(StringGrid1.Cells[ACol,ARow],2,1);
        if str1 = LowerCase(ComboBox1.Text) then
        begin
          StringGrid1.Cells[ACol,ARow] := '-'+str2;
        end;
      end;

      if ACol = 1 then
      begin
        //「文字」はすべて'0'に変換
        if not TryStrToInt(StringGrid1.Cells[ACol,ARow], i) then
        begin
          StringGrid1.Cells[ACol,ARow] := '0';
        end;
      end;

  ・・・ 省略 ・・・

実行時の様子は・・・

a2と入力してEnterキー押し下げで確定
無事、目的を達成

左手だけで、視線をキーボードに落とすことなく、負の数も簡単に入力できるようになった☆

ただし、上の手続きでは、StringGridのセルへの入力が3桁であった場合に対応できない。こと採点に関しては、部分点が2桁の数値になることは、多分アリエナイから、採点補助プログラム用のアルゴリズムとしての利用に限れば、上の手続きでも、まず問題は起きないと思うが・・・もし、どうしても3桁以上の入力値に対応させたいなら、コードを次のように変更すればOK!

//StringReplaceuses関数を使用するので uses節に System.SysUtils を追加
uses
  System.SysUtils
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i: integer;
  str1, str2: string;
begin

  ・・・ 省略 ・・・

  //セルの表示を制御(中央寄せ・負の数は赤で表示)
  if not (gdFixed in state) then
  begin
    if StringGrid1.Cells[ACol,ARow] <> '' then
    begin

      //文字数が2文字なら実行 -> コメント化
      {if Length(WideString(StringGrid1.Cells[ACol,ARow])) = 2 then
      begin
        //指定文字が入力されたら'-'に変換
        str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
        str2 := Copy(StringGrid1.Cells[ACol,ARow],2,1);
        if str1 = LowerCase(ComboBox1.Text) then
        begin
          StringGrid1.Cells[ACol,ARow] := '-' + str2;
        end;
      end;}

      //文字数が2文字以上なら実行
      if Length(WideString(StringGrid1.Cells[ACol,ARow])) >= 2 then
      begin
        //指定文字が入力されたら'-'に変換
        str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
        //2桁以上の入力値に対応
        str2 := StringReplace(
          LowerCase(StringGrid1.Cells[ACol,ARow]), 
          str1, '', [rfReplaceAll, rfIgnoreCase]);
        if str1=LowerCase(ComboBox1.Text) then
        begin
          StringGrid1.Cells[ACol,ARow] := '-'+str2;
        end;
      end;

      if ACol = 1 then
      begin
        //「文字」はすべて'0'に変換
        if not TryStrToInt(StringGrid1.Cells[ACol,ARow], i) then
        begin
          StringGrid1.Cells[ACol,ARow] := '0';
        end;
      end;

  ・・・ 省略 ・・・
適当な値を入力してEnterキーを押し下げて確定
採点プログラムとしての実用性は感じられないが・・・プログラム的には目的を達成

5.Bキー押し下げでゼロ入力を実装(その2)

※ 各セルに対して10以上の値の入力がある場合

各セルに対して10以上の値の入力がある場合は、入力された0(ゼロ)が不正解の0(ゼロ)なのか、10の2桁目の0(ゼロ)なのか、判定する工夫が必要になるが、良い判定方法が思いつかなかった。

そこで思い切って問題を単純化し、「高速入力モード」を作成して、それが ON の場合は入力値を0-9に限定し、ユーザーがそのことを理解した上で操作できるように工夫してみた。もし、各セルに対して10以上の値の入力がある場合は、「高速入力モード」は OFF で使用して貰い、Bキーが押された場合のみ、0(ゼロ)に変換して入力確定 ⇨ フォーカスを移動することにして、数字キーの0(ゼロ)の入力に対しては、直ちに入力の確定としないことにした。

あと、ついでだから、「高速入力モード」の名に恥じないよう、それが ON の場合は、0-9の数字キー押し下げで、直ちに入力確定、次のセルへフォーカスが移動する処理も追加してみた。以下、その実装。

CheckBox2を追加し、Captionを設定
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  str1:string;
begin
  //任意のキーの押し下げをキャッチ
  if Msg.message = WM_KEYDOWN then
  begin
    //StringGridがアクティブだったら
    if ActiveControl is TStringGrid then
    begin
      //StringGridが編集可能だったら
      if TStringGrid(ActiveControl).EditorMode then
      begin

        //高速入力使用の有無で処理を切り替え
        if not CheckBox2.Checked then
        begin

          //高速入力を使用しない場合の処理
          //Bキー押し下げでゼロを入力
          //0キー押し下げは無視
          if (Msg.wParam=VKB) then
          begin
            //keybd_event(VK_TAB,0,0,0);
            //VK_TABではカーソルがレコードの項目を右へ移動。
            //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
            //VK_DOWNにすると同じ項目の次のレコードへ移動。
            if TargetRow < StringGrid1.RowCount-1 then
            begin
              //下のセルへ移動
              StringGrid1.Cells[TargetCol, TargetRow]:='0';
              ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
            end else begin
              //上のセルへ移動
              StringGrid1.Cells[TargetCol, TargetRow]:='0';
              ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
            end;
            //Msg.wParam:=#0; //エラーになる
            Msg.wParam:=0;
          end;

        end else begin

          //高速入力を使用する場合の処理
          //Bキー押し下げでゼロを入力
          //0キー押し下げにも対応
          if (Msg.wParam=VKB) or (Msg.wParam=VK0) then
          begin
            //keybd_event(VK_TAB,0,0,0);
            //VK_TABではカーソルがレコードの項目を右へ移動。
            //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
            //VK_DOWNにすると同じ項目の次のレコードへ移動。
            if TargetRow < StringGrid1.RowCount-1 then
            begin
              //下のセルへ移動
              StringGrid1.Cells[TargetCol, TargetRow]:='0';
              ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
            end else begin
              //上のセルへ移動
              StringGrid1.Cells[TargetCol, TargetRow]:='0';
              ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
            end;
            //Msg.wParam := #0; //エラーになる
            Msg.wParam := 0;
          end;

          //1-9の入力があった場合
          if StringGrid1.Cells[TargetCol, TargetRow] <> '' then
          begin
            str1:=Copy(StringGrid1.Cells[TargetCol, TargetRow],1,1);
          end else begin
            str1 := '';
          end;

          //任意の1文字+数字の入力を負の数に変換する処理用に追加
          if (str1 <> '-') and (str1 <> ComboBox1.Text) then
          begin
            if (Msg.wParam = VK1) then
            begin
              //keybd_event(VK_TAB,0,0,0);
              //VK_TABではカーソルがレコードの項目を右へ移動。
              //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
              //VK_DOWNにすると同じ項目の次のレコードへ移動。
              //if intStringGrid1ActiveRow < StringGrid1.RowCount-1 then
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '1';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '1';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              //Msg.wParam := #0; //エラーになる
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK2) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '2';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '2';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK3) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '3';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '3';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK4) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '4';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '4';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK5) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '5';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '5';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK6) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '6';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '6';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK7) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '7';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '7';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK8) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '8';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '8';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

            if (Msg.wParam = VK9) then
            begin
              if TargetRow < StringGrid1.RowCount-1 then
              begin
                //下のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '9';
                ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
              end else begin
                //上のセルに移動
                StringGrid1.Cells[TargetCol, TargetRow] := '9';
                ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
              end;
              Msg.wParam := 0;
            end;

          end;
        end;
      end;
    end;
  end;
end;

6.まとめ

重要 各セルへの入力値が10未満であることが前提のコードです!

Bキーを押すだけでStringGridのアクティブなセルにゼロを入力し、フォーカスを次のセルへ移動するプログラムで、必要な変数と手続きは次の通り。

各セルへの入力値が10以上の場合、「まとめ」のコードは期待通りに動作しません。
10以上の入力値にも対応させたい場合は、「5.各セルに対して10以上の値の入力がある場合」が参考になるかもしれません。

  private
    { Private 宣言 }
    //行・列位置を記憶する変数
    TargetRow:integer;
    TargetCol:integer;

    //ある(矢印他)キーが押されたことを知る
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

//Col毎のIMEの制御(制御内容はStringGrid1GetEditTextを参照)
type
  _TGrid = class(TCustomGrid);

var
  Form1: TForm1;

implementation

uses
  Vcl.GraphUtil,
  System.UITypes;

  //GraphUtilはFixedセルのセンタリング用に追加
  //System.UITypesはキーコードでBキー(=VKB)を指定するために追加

{$R *.dfm}

procedure TFormCollaboration.FormCreate(Sender: TObject);
begin
  //StringGridの初期位置の設定
  TargetRow := 1;
  TargetCol := 1;
    //AppMessageを有効にする <- 忘れないこと!
  Application.OnMessage := AppMessage;
  //[Enter]でコントロールを移動させるために、Form上のコンポーネント
  //より先にFormがキーボードイベントを取得する。
  KeyPreview := True;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  //入力=確定&フォーカスの移動用に追加
  //セルを選んだときに行位置を記憶
  TargetRow := ARow;
  //セルを選んだときに列位置を記憶
  TargetCol := ACol;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  //任意のキーの押し下げをキャッチ
  if Msg.message = WM_KEYDOWN then
  begin
    //StringGridがアクティブだったら
    if ActiveControl is TStringGrid then
    begin
      //StringGridが編集可能だったら
      if TStringGrid(ActiveControl).EditorMode then
      begin
        //Bキー or 0キー押し下げでゼロを入力(入力値は10未満であることが前提)
        if (Msg.wParam=VKB) or (Msg.wParam=VK0) then
        begin
          //keybd_event(VK_TAB,0,0,0);
          //VK_TABではカーソルがレコードの項目を右へ移動。
          //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
          //VK_DOWNにすると同じ項目の次のレコードへ移動。
          if TargetRow < StringGrid1.RowCount-1 then
          begin
            //アクティブなセルが最終行でない場合はフォーカスは下へ移動
            StringGrid1.Cells[TargetCol, TargetRow] := '0';
            ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
          end else begin
            //最終行ならフォーカスは上へ移動
            StringGrid1.Cells[TargetCol, TargetRow] := '0';
            ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
          end;
          //Msg.wParam := #0; //エラーになる
          Msg.wParam := 0;
        end;
      end;
    end;
  end;
end;

7.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Causes of hard-to-find bugs

「また、やっちゃった。発見困難なバグの原因(は自分)」

数十枚の画像を次々に切り貼りして保存するプログラムを書いた際に、少しでも高速に処理するため、VCLのBmpをGDI+のBmpに変換して保存する方法を採用した。その際、var宣言に画像処理用の変数を、付け足し、付け足し・・・してプログラムを書いたら、自ら発見困難なバグを作り出してしまった・・・というお話。

1.不思議な現象が発生(バグその1)
2.原因を解明(したはずだった)
3.さらに不思議な現象が発生(バグその2)
4.バグ作成の元になった状況を再現
5.Createしないで使った場合は・・・
6.まとめ
7.お願いとお断り

1.不思議な現象が発生(バグその1)

TImageに数十枚の画像を切り貼りする処理は、それなりに時間がかかる。なので、処理が完了するまでは、ButtonのEnabledプロパティをFalseに設定して、気の短いユーザーに何度もボタンをクリックされるのを防止する。

このような場合、try ~ finally ~ end; を使って・・・

begin
  Button1.Enabled := False;
  try
    //処理
  finally
    Button1.Enabled := True;
  end;
end;

処理の途中で、なにかエラーがあっても、最終的にはTButtonのEnabledプロパティがTrueになるように組むことが基本だと学んだ。

同様に、TImageをマウスでクリックした際のイベントを拾う処理でも、間違ったクリックを拾うのを防止するため、ユーザーのクリックを拾った場合はTImageのEnabledプロパティを、一時的にFalseに設定して、メッセージを表示し、ユーザーの受け答えに応じてEnabledプロパティをTrue/Falseのいずれかに設定するようにしたのだが、この処理のどこかでTImageのEnabledプロパティがFalseのままになってしまって、いて・・・。

そのため「ある特定の画像処理手続き(その1)」を実行した後では、TImageのEnabledプロパティがFalseになっているから、TImageの画像をクリックすると走る「ある特定の画像処理手続き(その2)」が絶対に実行できない。プログラムを再起動して、手続き(その1)を実行せずに、手続き(その2)を実行した場合は、何でもなかったかのように問題なく手続き(その2)が実行できる。・・・という、理由がわかってみれば当たり前なんだけど、原因がわかるまでは何とも摩訶不思議な現象が発生(これがSetFocusならエラーが発生するから、話はまた別なんだけど・・・)。

2.原因を解明(したはずだった)

プログラムが完成に近づいたところで、(なんでかなー?)って、真剣に考えてようやくTImageのEnabledプロパティ設定の切り替え忘れだと気づき、あわててTImageに対する処理の直前に Image1.Enabled := True; を入れてプログラムを修正。

こんなことにならないよう、画像処理(その2)の手続きの最初に、先に述べたように、Image1.Enabled := True; と記述して強制的にエラー防止策をとるか、「TImageのEnabledプロパティがFalseで変更できません!」みたいなエラーメッセージが表示されるよう、if not Image1.Enabled then のようなエラー回避の処理を入れておくべきだったのだ。そうすれば、もっと早く間違いを発見できたと思うのだが、実際には、EnabledプロパティがFalse状態のTImageをクリックしても「何も起こらない」(もちろんエラーも起きない)ので、Enabledプロパティの設定が原因だと気づくまでに(なんでかなー?)っと、考えに考え、それなりに時間がかかってしまったのだ。

これで原因は解明され、バグは消えた(・・・と僕は思っていた)。

3.さらに不思議な現象が発生(バグその2)

TImageのEnabledプロパティ設定を修正したプログラムを実行してみると、今度は画像処理(その1)を行ったあと、連続して画像処理(その2)を確実に実行できるようになった。

MyPCで最初にテストした時は、画像処理(その1)に続けて、画像処理(その3)も確かにエラーなく実行できた。何回か、その後もMyPCでテストを繰り返し、僕は問題が完全に解決できたと信じ、MyPCではない、このプログラムを実際に実行(運用)する予定の業務用ノートPCで試しにプログラムを動かしてみた。すると・・・

MyPCではエラーを起こしたことは1回もなかったのに、業務用のノートPCでは画像処理(その3)で時々エラーが発生する。しかも、それが毎回必ず発生するわけではなく、起きる時と、起きない時があり、どちらかと言えば、起きるほうが少ない。画像処理(その3)は数十枚の画像に変更を加えて、さらにそれを1枚ずつ保存する時間のかかる重たい処理なので、途中で何らかの障害が発生してエラーになるのかと思ったが、エラーが起きなくても(エラーメッセージが明示的に表示されなくても)、画像に対して行った変更が「まったく保存されていない場合がある」ことにも気づく。同じループの中で処理した画像なのに、変更が保存される場合と、されない場合の2通りがあるなんて! しかも、ランダムに。これはもう、完全に想定外。・・・てか、Delphi環境下、Object Pascalで書いたプログラムで、まさか、こんなことが起きるなんて・・・信じられない。Delphiとの思い出を過去20年遡って、こんなエラーを、僕は、これまでに経験したことが「ない」。

混乱の中で思いついたことは、GDI+を使った保存処理の記述のどこかに問題があるのは間違いないから、いったん、GDI+で処理していた部分をコメント化して、旧来のオーソドックスなJpeg画像の保存処理に変更してみることだった。これでエラーが起こらずに、変更を加えた画像データがきちんと保存できれば、最後の一手だけは確保できる。

procedure TForm1.ButtonXClick(Sender: TObject);
var
  jpg: TJPEGImage;
  s, strText: string;
begin
  //エラーが発生しても処理を止めない
  try
    for i := 1 to StringGrid1.RowCount-1 do
    begin
      S := ChangeFileExt(ListBox2.Items[i-1], '.jpg');
      Jpeg := TJPEGImage.Create;
      try
        //Jpeg.Assign(Image1.Picture.Bitmap);
        Jpeg.Assign(Image1.Picture.Graphic);
        Jpeg.Compress;
        Jpeg.SaveToFile(S);
      finally
        Screen.Cursor := crDefault;
        Jpeg.Free;
      end;
    end;
  except
    //エラー発生時の処理
    on E: Exception do begin
      strText := E.ClassName + sLineBreak + E.Message;
      Application.MessageBox(PChar(strText), '情報', MB_ICONINFORMATION);
    end;
  end;
end;

期待した通り、これなら、まったくエラーは起きない。ただし、GDI+を使った画像の高速な保存処理に慣れてしまった自分には、耐え難いほど処理速度が遅い・・・

すごく悩む。
時々、エラーは起こすけど、とりあえず動くし、何より速いGDI+のままで行くか、
それとも、遅いけど、確実に動作する旧来のJpeg画像の保存方法に変えるか、
それとも、いっそのこと、ユーザーが画像の保存処理方法を選択できるようにするか、
それとも、エラーが起きた時だけ、旧来の保存方法に戻そうか、
でも、明示的なエラーが起こらずに、変更した画像が保存されてない場合もあるし・・・

どうしよう・・・

困ったことにGDI+を使った方法では、もし明示的なエラーが発生しても、続けてもう一度保存処理を実行すれば「何事もなかったか」のようにプログラムは走り、多くの場合、「何事もなかったか」のように画像が保存されるのだ。ただ、ループ処理10回に1回くらいの割合で、エラーが出ないにもかかわらず、しかも同一ループの中で保存処理する画像全部ではなく、そのうちの数枚だけ、加えた変更が「なぜか、反映されない」不思議な現象がランダムに起こってしまう。

いくらGDI+で保存する処理のプログラムを眺めても、原因が見出せない。
(この時はVCLからGDI+へのビットマップの変換部分に原因があると思っていた)

GDI+の保存処理のどこに原因があるのか、それがどうしてもわからなくて困った僕は、要するにJpegで保存するから、圧縮に時間がかかって遅いんだと考え、試しにビットマップ画像で保存する処理も試してみることにした。

  S:=ChangeFileExt(ListBox2.Items[i-1], '.bmp');
  tmpBmp:=TBitmap.Create;
  try
    tmpBmp.Assign(Image1.Picture.graphic);
    tmpBmp.SaveToFile(S);
  finally
    tmpBmp.Free;
  end;

エラーも出ず、全ての画像が確実に保存され、かつ、処理速度も速い。
ただ、Jpegで保存すれば、1枚あたり数百KBしかなかった画像が、わずか1枚で10MBを超える容量を食ってしまう・・・。ここさえ目をつぶればBMPも「あり」なんだけど。

だが、作業する度にとんでもない容量を食いつぶす画像データが生成されることを考えると、いくらGBオーダーのSSDを積んでるって言っても、やっぱりBMPでの保存は無理だ。

ここにきて、ようやく僕はTImageのEnabledプロパティの設定以外の、より重大で、深刻なバグが自分の書いたプログラムのどこかに潜んでいることに気づく。

溺れる者は何とかで(せめて、毎回、確実にエラーが起きてくれれば・・・)と、とんでもないことまで考えてしまう(これまでいろんなプログラムを作ったけれど、エラーが発生して欲しいと、心から願ったことは多分なかった気がする・・・)。

何度、プログラムの怪しいと思われる(ビットマップへの変換処理)部分を見返しても原因がわからない。援けてくれる人は誰もいない。泣いても、喚いても、自分で何とかするしかない。今までにも数限りなく、これを繰り返してきたんだけれど、ここでまた・・・

選択肢は次のいずれか。
GDI+をあきらめる、か、あきらめないか だ。
自分で決めるしかない。どちらをとる? 決心するための、自問自答を繰り返す。

( あきらめたら、僕は、もう、よくなれない )

答えは一つしかない。それは最初からわかっている。大量の画像を保存するから、処理速度が速いことが、絶対条件だ。ならば、今、自分が知っている最良・最速の処理方法であるGDI+を使うしかない。GDI+のプログラム自体に間違いがあるとは思えないから、データの保存処理の記述を見直して、誤りを発見・修正し、その保存の確実性を100%にすればいいだけだ。少なくとも、今、画像データの保存処理のどこかに重大な問題が隠れていることだけは、わかった。

( きっと、もう少しだ )

このプログラムより先にGDI+を使って書いた1枚の画像を保存する処理は、確実に成功して、エラーが発生したことは1度もない。だから、GDI+のプログラム自体には絶対に間違いはない。自分の書き方のどこかに問題がある。もし、GDI+の使用をあきらめないなら、時々エラーになるその原因を探し、修正すること以外に、その解決方法はない。

( いま、僕に、できることは・・・? )
( 原因がわかるまで、最初から1行ずつ、プログラムを見直すんだ・・・。 )

そう決心した僕は、試しに書いたTJPEGImageを使う保存手続きをコメント化して、もう一度、GDI+を使った保存手続きを最初から1行ずつ、読んでみることに決めた。

4.バグ作成の元になった状況を再現

次のプログラムが「バグ作成!の元になった状況を再現」したもの。どこに重大な問題があるのか、すぐに気がつかないのは僕だけかもしれないが・・・。
(実際には、この他にもその他の変数の宣言、数々のエラー処理や、ループの中で複数の画像を加工する処理が書かれている。また、ファイルの保存パスはプログラム内で明示的に指定し、SaveDialogは使用していない)

重要 コピペ厳禁!!(このプログラムには重大な誤りがあります)

implementation

uses
  System.IOUtils,
  Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL;

  //System.IOUtilsはPathから拡張子を取得するTPath.GetExtensionを使うために追加
  //GDIPAPI, GDIPOBJ はGDI+を利用した描画に資料するために必要
  //GDIPUTILを宣言すればGetEncoderClsid関数を利用してGUIDを取得できる

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  //TImageへの画像読み込み用に使用
  bmp:TGPBitmap;
  //VCL TBitmapからGDI+ Bitmapへの変換に使用
  Graphics:TGPGraphics;
  srcBMP:TBitmap;
  dstBMP:TGPBitmap;
  stream:TMemoryStream;
  //拡張子を取得するために使用
  dotExt, strExt:string;
  //GetEncoderClsid関数の利用とTGUIDを使用するには、usesにWinapi.GDIPUTILが必要
  ImgGUID:TGUID;
begin

  //Create
  bmp:=TGPBitmap.Create;
  try
    //TImageへ画像を読み込む処理
  finally
    //確実に解放
    bmp.Free;
  end;

  {TImageに読み込んだ画像に数々の変更を加える処理}

  //SaveDialogのプロパティはExecuteする前に設定しておくこと
  With SaveDialog1 do begin
    //デフォルトのファイル名を設定
    FileName:='Test';
    //表示するファイルの種類をcsvに設定
    //Filter:='コンマ区切りテキストファイル(*.csv)|*.csv';
    //表示するファイルの種類を設定
    //Filter:='JPEG Files (*.jpg, *.jpeg)|*.jpg;*.jpeg';
    Filter:='画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.emf;*.wmf;*.ico' +
    '|*.png|*.png' +
    '|*.jpg|*.jpg' +
    '|*.gif|*.gif' +
    '|*.bmp|*.bmp' +
    '|*.tif|*.tif';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'Data';
    //拡張子の指定がなかった場合に付加される拡張子を指定
    DefaultExt:='jpg';
    //上書き保存の確認の設定
    Options:=[ofOverWritePrompt];
  end;

  if not SaveDialog1.Execute then Exit; //キャンセルに対応

  //保存(VCL TBitmap -> GDI+ Bitmap)
  srcBMP:=TBitmap.Create;
  srcBMP.Width:=Image1.Width;
  srcBMP.Height:=Image1.Height;
  srcBMP.Assign(Image1.Picture.graphic);
  //データ受け渡し用のストリームを生成して保存
  stream:=TMemoryStream.Create;
  srcbmp.SaveToStream(stream);
  //保存GDI+のBMPを生成
  dstbmp:=TGPBitmap.Create(TStreamAdapter.Create(stream));
  ////変更できるのはBitmapを含む画像のみですのエラーが発生
  //Graphics:=TGPGraphics.Create(Image1.Canvas.Handle);
  //これならエラーは発生しない
  Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  try
    Graphics.DrawImage(dstbmp,0,0);
    //拡張子を小文字に変換して取得(.XXX形式:Dotが付いている)
    dotExt:=LowerCase(TPath.GetExtension(SaveDialog1.FileName));
    //JPEGに対応する
    if dotExt='.jpg' then begin
      strExt:='jpeg';
    end;
    //指定された拡張子を付けて保存
    if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
    begin
      bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
    end;
  finally
    Graphics.Free;
    srcbmp.Free;
    dstBMP.Free;
    stream.Free;
  end;
end;

上のコードのもとのプログラムは、SaveDialogでファイル名を含めた保存パスを取得してGDI+で保存処理するものだった。だから、ビットマップ変換用の変数は必要なく、一つだけ、ビットマップデータを入れるTGPBitmap型の変数bmpを用意すれば事足りた。

GDI+を使った画像の保存処理を実現するために、どうしても必要だったのが「VCLのビットマップ」を「GDI+のビットマップ」に変換する作業で、これが出来なかった僕はさんざん悩みながら、Web上の情報に援けてもらって、この変換処理を行う方法を学んだ(その詳細は、次のリンク先を参照)。

で、僕はビットマップ変換処理用に、srcBMP:TBitmap; dstBMP:TGPBitmap; stream:TMemoryStream; 等の変数を今回のプログラムに追加した。

GDI+で書いた元々のプログラムは、ファイルとして存在する画像データをOpenDialogを使ってGDI+ビットマップに読み込み、SaveDialogでファイル名を含めて保存パスを指定して処理するものだった。だから、ビットマップ変換用の変数は必要なく、bmp:TGPBitmap; として、ビットマップデータを入れる変数を1つだけ var 宣言して、もちろん、読み込み時にも、書き込み時にも、それぞれの手続きで同じように、これをローカル変数として使用した。

読み込み、書き込みの手続きはそれぞれ独立していたから try 文のfinallyブロックで、bmp.Free として最後に確実に解放すれば、何も問題は起きなかった。

しかし、このプログラムの保存手続きでは、GDI+を利用して、高速にTImageへ画像を読み込み、その画像に変更を加え、TImageのVCLのビットマップからGDI+のビットマップに変換して、保存処理を行っている。

1行ずつプログラムを確認して行く。そして、ついにバグの原因に気づく。

var
  //TImageへの画像読み込み用に使用
  bmp:TGPBitmap;
  //VCL TBitmapからGDI+ Bitmapへの変換に使用
  dstBMP:TGPBitmap;
  ・・・ 省略 ・・・
begin
  //Create
  bmp:=TGPBitmap.Create;
  try
    //TImageへ画像を読み込む処理
  finally
    //確実に解放
    bmp.Free;
  end;

画像の読み込み完了時に、変数bmpは解放済みだから、この変数は再度Createしない限り、もう使えない。しかし、この手続き内で有効な変数としてvar宣言してあるので、Freeした後の保存手続き内でうっかり(Createの有無にかかわらず)記述してしまっても、「未定義の識別子エラー」にはならない。もちろん、コンパイルも警告なしで通る・・・。

【誤りのあるコード】

    //指定された拡張子を付けて保存
    if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
    begin
      bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
    end;

【正しいコード】

    //指定された拡張子を付けて保存
    if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
    begin
      //bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
      dstbmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
    end;

同じ手続き内の最後の部分で、僕は間違えて(というか、おそらくビットマップ変換処理を追加した際に書き換えるのを忘れて)本来、ここでは使えないはずの変数bmpを指定したまま、そのSaveメソッドを使った画像の保存処理を書いてしまっている(正しくは、ビットマップ変換用に用意した変数dstbmpを指定しなければならない)。

論理的に明らかな誤りを含んだこのプログラムは、しかし、記述時に「未定義の識別子エラー」は出ず、実行時のコンパイルも問題なく通る。

(その理由は僕にはわからないが)
さらに恐ろしいことに、かなりの確率でデータの保存にも成功!してしまう。
明示的なエラーが発生するのは、ループを数百回まわして1回程度。

元にした保存処理のコードが確実に動作することは確認済みだから、(間違ってない)ビットマップ変換のどこかに誤りがあることを疑いはしても、まさかSaveメソッドの変数名が「誤り」で、バグの原因になっているとは(そこは絶対!大丈夫)と思い込んでいるから、疑ってもみない・・・。

絶対、大丈夫。
そう思っていた部分に誤りがあったことは、これまでにも無数にあったのに。

5.Createしないで使った場合は・・・

手続き最初の画像読み込み部分をコメント化して実行した場合は、Createしていないからインスタンスのない変数bmpのSaveメソッドを使うことになるので、次のような警告が表示され、さらに、プログラムで保存の手続きを実行した場合は、ほとんどの場合(明示的なエラーは発生せずに)ファイルの保存に成功するが、プログラム終了後に、しばらくしてからエラーメッセージが表示される。

  //Create
  {
  bmp:=TGPBitmap.Create;
  try
    //何らかの処理

  finally
    //解放してしまう
    bmp.Free;
  end;
  }
コンパイルは通っても警告がきちんと表示される。
プログラムを終了してしばらくすると、エラーメッセージが表示される。

6.まとめ

Createして使用後、Freeした変数を再宣言しないで使うと使えてしまうことがあることをこの例から初めて学んだ。この場合は、Delphiのデフォルト設定のままでは、警告も、エラーメッセージも出ない。さらに、その理由はわからないが、多くの場合Saveメソッドは成功し、データは実際に保存される(時々、保存されないこともある)。明らかに誤りのあるロジックを構築したのは僕だから、Delphiのコンパイラにはまったく責任はない。コーディングの決まりを無視して、想定外のコードを書いたのは僕自身だ。今回の問題解決の経験から、あらためて、Delphiのコンパイラが発見困難なバグの真の原因は自分が作り出していることを学んだ。

たまたま、偶然、変数の修正を忘れたままになっていることに気がつけたからよかったが・・・(不幸中の幸いとは、まさにこのこと)。万一、真の原因が解明できないまま、バグの原因究明をあきらめて、誤りを含んだまま、このプログラムをユーザーに配布していたらと思うと・・・。

あらためて、思った・・・。
少しでも不具合がある場合は、徹底的に原因を解明して100%確実に動作する状態であることを確認しなきゃいけないって。僕は、自分自身と大切な約束を交わした。それは・・・

バグ探しのポイントは、(絶対、大丈夫)と思い込んでる場所を重点的に確認すること。

なぜ、MyPCではまったくエラーが起きなかったのに、業務用のPCではそれなりにエラーが起きたのか、それは今でも謎のままなんだけれど・・・(その後、MyPCでもテスト中に明示的なエラーが発生することを1回確認)。

MyPCで動作確認して問題なかったプログラムが、業務用PCで走らせるとエラーを起こす不思議は、これまでにも何回もあった。職場の業務用PCに、明日、(ありがとう)って感謝の気持ちを伝えよう。

7.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

When the date and time display is hidden

「日付と時刻の表示が隠れた時は・・・」

Windows11を使うようになってから、画面右下の日付と時刻の表示が半分隠れて見えなくなってしまう現象を、しばしば目にするようになった。(10の時はなかったけどなー)・・・と思いながら、再起動してみたり、直し方を調べてみたりしたけど・・・。

偶然、発見したいちばんカンタンな、その直し方とは?(※ 僕にとって、です)

1.時々発生する困った現象
2.偶然発見したいちばんカンタンな直し方
3.まとめ
4.お願いとお断り

1.時々発生する困った現象

Windows11になってから、タスクバーの設定の自由度が失われてしまったことを最初の頃はとても残念に感じていたんだけれど、いつの間にか「その仕様」に慣れて、タスクバーの設定はほとんどいじらずに、今はデフォルト状態のまま。

で、時々、発生するのが、次の現象。
気がつくと、いつの間にか、日付と時刻の表示の右側が切れちゃってる・・・。

いつの間にか、日付と時刻の表示が半分になっちゃった・・・
ほんの少しだけ、切れちゃってることも。

2.偶然発見したいちばんカンタンな直し方

Google先生に直し方を尋ねても、「これだ!」みたいな直し方はヒットせず。実害というほどの実害もないし、いつの間にか、直っていたりするから、気にしないでいたんだけど、偶然、走召!カンタンな直し方を発見。

「隠れているインジケーターを表示します」をクリック!

上の図に示したように、画面右下の「隠れているインジケーターを表示します」の「∧」マークをクリックすると、クリックした瞬間に正しい表示に戻ります(※ MyPCでは)。

3.まとめ

Windows11で、画面右下の「日付と時刻の表示」がオカしくなった時は、「隠れているインジケーターを表示します」の「∧」マークをクリックすると、クリックした瞬間に正しい表示に戻る(※ MyPCでは)。

拝啓 Microsoft OS開発ご担当者 様
バグなら、早くなおして欲しい・・・です。

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Vertical alignment of Grid control

「Gridコントロールの縦方向のアライメントを設定したい」

手書き答案を採点するプログラムで、「答案(の各解答欄)画像の高さ」と「得点を入力するStringGridのセルの高さ」が同じになるように設定したら、編集モード時に、データがセルの左上に表示されるのが何だか気になった(実用上は問題ない。あくまでも気分の問題)。編集してない時は、データはセルの中央に表示されてるので、編集中も垂直方向はセルの中央のまま、水平方向のみ左へ移動する形でデータを表示したい・・・と考えた。

セルの水平方向のアライメントはプロパティで設定できることは知ってたが、調べてみると、縦方向のアライメントは標準のStringGridでは設定できない(?)ようだ。なるべくなら、新しくコンポーネントをインストールしてこれを実現することは避けたい(PCを新しくした場合や、Delphi自体のバージョンアップ等の際に、再セットアップが必要なコンポーネントはなるべく少ない方がいい)ので、何とかならないかなーと思って調べてみた。そしたら、Web上に諸先輩が公開してくださっている数々のお知恵にすがりつきまくることで、案外、カンタンに、何とかなっちゃったというお話。

ここで利用させていただいた知恵のすべてを、自分で最初から作るとしたら、きっと途中で挫折するだろうし、もし、挫折しなくても、完成までには、「とほー」もない時間が必要なことだけは間違いありません。思い立ってわずか1時間で希望のプログラムができたのは、参照させていただいた資料を公開してくださっている皆様のおかげです。心から厚く御礼申し上げます。ほんとうにありがとうございました。

1.これをなんとかしたかった!
2.コンポーネントをインストールせずに使う方法
3.画像のスクロールとGridコントロールの連動
4.まとめ
5.お願いとお断り

1.これをなんとかしたかった!

作成した手書き答案採点プログラムの実行時の画像は、以下の通り。

答案画像から設問毎に解答画像をかきあつめて、受験者全員分をまとめて表示している

答案用紙画像から切り出した各解答欄の画像の高さと、StringGridのセルの高さを同じにした方が採点しやすいだろうと考えたので、次のコードでこれを設定。

  StringGrid1.RowHeights[0]:=24;
  for i := 1 to StringGrid1.RowCount-1 do
  begin
    //SrcRectは解答欄画像の矩形
    StringGrid1.RowHeights[i] := SrcRect.Height;;
  end;

で、なんとかしたい部分が、こちら。

編集中の採点欄のデータがセルの左上に表示されている。縦方向のアライメントも真ん中にしたい!

調べた限り・・・のことなので、もしかしたら間違ってるかもしれないが、標準のStringGridでは縦方向のアライメント設定はできないようだ・・・(もしかしたら、できるのかな?)。半分くらい、あきらめモードで(やっぱり、無理かなー? まぁいいかー)って思いつつもあきらめきれず、Web上の多くの資料に目を通していると、Mr.XRAYさんのWebサイトの「055_ドロップダウンリストを実装した TStringGrid コンポーネント」というページの中に、「06_インプレイスエディタの縦方向のアライメントと左右のインデント」という、まさに実現したいこと、そのものずばりの記事を発見。

055_ドロップダウンリストを実装した TStringGrid コンポーネント

http://mrxray.on.coocan.jp/Delphi/plSamples/055_TplDropStringGrid.htm

上記ページで、Mr.XRAYさんがドロップダウンリストの機能付きのTStringGrid コンポーネントとして公開してくださっているplDropStringGrid.pasには、インプレイスエディタ関係のプロパティとイベント類が追加されており、これをインストールすれば、StringGridで編集モード時に起動するインプレイスエディタの縦方向のアライメントが設定できるとのこと。

これで「夢見たことは実現可能であることがわかった」が、もし、できることなら、コンポーネントをインストールせずに使えないか? とさらに欲張りなことを考えてしまった・・・。理由はたった一つ。StringGridのセルの高さを変えるようなプログラムは、今後、たぶん書かないんじゃないかなーって、思ったから。

・・・ということで、今度は「コンポーネントをインストールせずに使う方法」を探してみた(探しつつ、前に見たことがあるような気がした)。

2.コンポーネントをインストールせずに使う方法

こちらも、そのものずばりの方法が次のWebサイトに公開されていました。作者の方に心から感謝申し上げます。

コンポーネントをインストールせずに使う方法

http://delfusa.main.jp/delfusafloor/technic/technic/024_ChangeComponent.html

上記Webサイトにあった情報をもとに、夢を実現。

まず、上記Mr.XRAYさんのWebサイトから「055_TplDropStringGrid.zip」をダウンロードして解凍。中に含まれている「plDropStringGrid.pas」をコピーして、Delphiのプロジェクトファイル(*.dproj)があるフォルダに貼り付け。

プログラムには、次のコードを加えた。

uses
  ・・・ 省略 ・・・
  plDropStringGrid, System.TypInfo;

  //plDropStringGrid, System.TypInfoは、実行時にコンポーネントを交換するために追加
  //-> StringGridの縦のアライメントを設定する目的

{$R *.dfm}

こちらの「コンポーネントを交換する関数」は、記事にあったものをそのまま、コピペ!

//コンポーネントを交換する関数
//usesにTypInfoの追加が必要
function ChangeComponent(Original: TComponent; NewClass: TComponentClass): TComponent;
var
  New: TComponent;
  Stream: TStream;
  Methods: array of TMethod;
  aPPropInfo: array of PPropInfo;
  MethodCount, i: Integer;
begin
  SetLength(aPPropInfo, 16379);
  MethodCount := GetPropList(Original.ClassInfo, [tkMethod], @aPPropInfo[0]);
  SetLength(Methods, MethodCount);
  for i := 0 to MethodCount - 1 do
    Methods[i] := GetMethodProp(Original, aPPropInfo[i]);

  Stream := TMemoryStream.Create;
  try
    Stream.WriteComponent(Original);
    New := NewClass.Create(Original.Owner);
    if New is TControl then
      TControl(New).Parent := TControl(Original).Parent;
    Original.Free;
    Stream.Position := 0;
    Stream.ReadComponent(New);
  finally
    Stream.free
  end;

  for i := 0 to MethodCount - 1 do
    SetMethodProp(New, aPPropInfo[i], Methods[i]);
  Result := New;
end;

この関数を、FormCreate時に呼び出して、実行。

procedure TFormCollaboration.FormCreate(Sender: TObject);
begin
  //コンポーネントを交換する関数を実行
  StringGrid1:= TStringGrid(ChangeComponent(StringGrid1, TplDropStringGrid));
end;

ここまでが準備で、縦のアライメントの設定は、次のたった1行(赤字)を追加するのみ!

procedure TFormCollaboration.StringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: string);
begin

  //縦のアライメントを設定
  TplDropStringGrid(StringGrid1).EditVertAlignment := vaCenter;

  //IMEの制御
  with TEdit(_TGrid(Sender).InplaceEditor) do
  begin
    //ImeMode := imClose;   //日本語入力OFF-> ×
    ImeMode := imDisable;   //日本語入力OFFは imDisable
  end;

  //現在Activeな行番号を取得
  intStringGrid1ActiveRow:=ARow;

end;

実行結果です。

インプレイスエディタ起動時、アライメント設定は「水平方向は左・垂直方向は中央」

旅行先で、ちょっと時間ができたので、前にユーザーと話しをする中で思い立った解答欄画像の高さと採点欄の高さを同じにするコードをちょこちょこっと書いて、動作を確認。そしたら今度は、編集モードでのセルの挙動が気になり、翌朝、早く目覚めたので、まさか旅先で書くとは思わなかったけど、PCは持参していたのでこれ幸いと、お日さまが昇るころまでにここまでの内容を記述(・・・というかほぼ全部コピペ)。

3.画像のスクロールとGridコントロールの連動

次に気になったのがTImageに表示した答案画像と、StringGridのスクロールの連動(同期)。

実はこれも前から気になっていたコトだったんだけれど、いろんな事情から、とりあえずプログラムを使える状態にすることが最優先だったので、ずっと後回しにしてきた課題。

今回、解答欄画像の高さと、採点欄の高さを揃えたら、以前にも増して同期の必要性を痛感。まだ、期待通りの動きになった・・・とは言い難い状態なんだけど、現在のコードは次の通り(こちらもずっと以前にMr.XRAYさんのWebサイトにあった記事を参考にさせていただいて書いたプログラムからコピペしたコードだったような記憶が・・・)。参考にさせていただいたのは、おそらく次のページ。

078_コントロールのマウスホイール操作によるスクロール

http://mrxray.on.coocan.jp/Delphi/plSamples/078_Control_MouseWheel.htm
調整値1-10を設定するComboBox

マウスに関する諸設定は、環境により異なるので、調整値は固定値にしないで、ユーザーが自由に設定できるようにした(つもり)。My PC環境で試したところ、次のコードでは、調整値「7~8」くらいが期待に近い動きをするようだ。

procedure TFormCollaboration.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LDelta:Integer;
  LWinCtrl:TWinControl;
  LCurPos:TPoint;
  //スクロール量の調整(SA:Scroll Amount)
  intSA:integer;
begin

  //マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
  //(解答欄画像を表示しているTImageはTScrollBoxの上に配置)
  LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);
  if PtInRect(ScrollBox1.BoundsRect, LCurPos) then
  begin
    //スクロール量の調整
    if not TryStrToInt(調整値1-10を設定するComboBoxの値, intSA) then
    begin
      intSA:=1;
    end;
    //心配なので、念のために設定その1
    if 調整値1-10を設定するComboBoxの値 ='0' then
    begin
      intSA:=1;
    end;
    //心配なので、念のために設定その2
    if StrToInt(調整値1-10を設定するComboBoxの値) < 0 then
    begin
      intSA:=1;
    end;
    //大きい数値を選ぶとスクロール量も大きくなるように設定
    intSA:=11-intSA;
    LDelta := WheelDelta div intSA;
    if ssCtrl in Shift then
    begin
      ScrollBox1.HorzScrollBar.Position := 
        ScrollBox1.HorzScrollBar.Position - LDelta;
    end else begin
      ScrollBox1.VertScrollBar.Position := 
        ScrollBox1.VertScrollBar.Position - LDelta;
      //StringGridも連動してスクロールさせる
      if LDelta > 0 then
      begin
        StringGrid1.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        StringGrid1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
    end;
  end else begin
    //マウス直下のコントロールを取得
    LWinCtrl:=FindVCLWindow(MousePos);
    //TStringGridの場合
    if LWinCtrl is TStringGrid then
    begin
      if WheelDelta > 0 then
      begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
    end;
  end;
  //この1行を忘れないこと!
  Handled:=True;

end;

テストしたPCのマウス関連の諸設定は、以下の通り。

テストしたPCのマウス関連の諸設定①
テストしたPCのマウス関連の諸設定②
テストしたPCのマウス関連の諸設定③

4.まとめ

StringGridで編集モード時に、縦のアライメントを設定するには、標準のStringGridでは機能的に難しいので、それが可能な標準のStringGridを継承したコンポーネントを利用する。コンポーネントのインストールが難しい場合は、実行時に標準のStringGridと入れ替える形で、そのコンポーネントを動的に生成することで、目的を実現できる可能性がある(実行時の動的な生成で、目的を実現できるか・どうかは、十分なテストを行って確認する)。

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

I also want to enter the triangle mark!

「(採点ソフトで)〇と × だけじゃなく△も入力したい!」

手書き答案を採点するプログラムを書いた。当初の予定では、採点記号は正解(〇)か、不正解(×)のみとして、正解(〇)の場合は、その得点を採点記号の右に表示できるように設定したから、その点数の大小によってそれが完全正解なのか、△(部分点あり)なのかを判別できればイイ、「だから△なんてイラナイ」と、僕は考えていたんだけれど・・・。

今にして思えば、弱い自分への言い訳でした・・・ T_T

ほぼ完成に近づいたMy手書き答案採点プログラムのイメージ。
(この時点で、本人は「完成した」と思っていた・・・)

No,2とNo,6の -5x は完全正解の半分の2点しかあげないけど、でも × じゃないよー。みたいな・・・

でも、そんな時、偶然、Webのニュースで見ちゃったんだけど、東京都が公的に導入した業務改善用の採点ソフトでは・・・

あたりまえのコトですが、
採点記号に△も使ってるんですよ!

僕のプログラムでは、絶対に「表示できない」△マーク。
別に△マークがあったって、エラくなんか、ないもん・・・。うぐぐ。

でも、それって、
走召!ぐやじい!!!
じゃありませんか。

僕のプログラムの完成なんて、誰ひとり、待ってないケド・・・

一般庶民のフツーの感覚で言えば(僕の感覚と常識が正しいとして)、一昨年、
一般庶民には買えない価格のDelphiを、「個人で購入するという暴挙に出た」僕です

それはDelphiが、Object Pascalが好きだから。
出会った時から、ずっと 大好きな・・・Delphiの・・・
この文化が消えないように、この言語がいつまでも残るように、
Delphiと、Object Pascalが、ほんとうに大好きだからやったことなんだけど・・・。

あれだけの初期使用料と、高額な年度ごとのサブスクリプション代金を支払っても・・・。
僕はイイから。

(結婚した時、印鑑といっしょに、彼女に取り上げられた通帳の、今はまったく自由にならない預金口座からの引き落としだから、実は痛くもかゆくもないんだケド・・・ *(^_^)*♪ )


こんなに・・・。
どうしようもない、くらい、こんなに・・・。

こんなに Delphiが好きなのに、
たかが△マークすら表示できない・・・
なんて・・・


許せないよ・・・
絶対に許せない・・・


アマチュアとか、プロとか、関係なく、
△マークの表示が、東京都の御用達プログラムに出来て、
僕に出来ない理由なんて、
それをあきらめる場合以外には、探したくないし、
あきらめなければ、僕にもきっと出来るはずです。

アマチュアとか、プロであるとか、は関係ない。
△マークの有無が問題なのだ。

それが「ない」プログラムは、
決して、良い採点プログラムとは言えない!

なんでこんな大事なコトに今まで気づかなかったんだ・・・
(アンタにとって、それはいつものことでしょ)

よぉぉぉぉぉぉぉぉぉぉっし、
俺はやるぞ!!!

そう思ったら、思い出せました。

よくなりたい、自分を。

(長すぎる前置きですが、どうしても、話したかったことはここから・・・)

【もくじ】

1.△の使用をあきらめた理由
2.マイナスの点数は通常ありえないコトに気づく
3.採点アルゴリズムを改良
4.合計点の計算と印刷
5.まとめ
6.お願いとお断り

1.△の使用をあきらめた理由

手書き答案をスキャナーで読み取り、各設問毎に画像を切り出して合成、素早く・効率よく採点、で、採点記号&得点付き画像を元の答案画像へ書き戻し、合計点を付加(任意の位置に表示)して返却用答案を印刷するプログラムを作成した。

下の画像はその実行時のイメージ。Gridコントロールへ入力した数値に応じて答案画像の上に採点記号(〇 もしくは × )と、〇の場合は得点を表示している。× の場合に得点の表示がないのは、0と〇がよく似ていて、×0という表記は間違いなく混乱を招くと考えたため。いちおう、オプション設定で表示の有無を選択できるようにはしてあるが、デフォルト設定で「得点0は表示しない」のチェックはON。

×0は混乱のもと!(表示する選択肢は提供)
No,2とNo,6には 本当は△を表示 したい・・・

当初は次のような理由から採点記号△の使用を断念してしまった・・・。

ほんとうは 〇・× の他に採点記号として△も使いたかったのだ。が、採点の基本としたアルゴリズムではGridコントロールに「正の数が入力」された場合は正解で採点記号は「 〇 」、「0(ゼロ)が入力」されていたら不正解で採点記号は「 × 」、「空欄」の場合は何もしないと決めていたので、△の入り込む隙が見出せなかった・・・というのが一つ。

また、これは直接△とは関係ないけれど、人間である以上、採点ミスはつきもの!で、答案画像に採点記号と部分点を埋め込むのは最後の最後。返却用答案画像を作成する直前でなければならない。それまでは、Gridコントロールへの得点入力に応じて、採点記号を付加した答案画像をいつでも修正可能な状態にしておく必要がある。

もし、強引に「部分点あり」の採点記号を「△」にするなら、Gridコントロールへの入力値から、この「△」を見分ける手段を考えなければならない。この手段を思いつかなかったというのが一つ(当初から考えなかったわけではないが・・・、スマートな方法をどうしても見いだせなかった)。

さらに得点入力のしやすさを考えると、テンキーがあってもなくても、0(ゼロ)はキーボードの右側にあって、どうにも押しにくい(マウスを操作する右手は、マウスから離したくない & 左手で何回も0を押すのは、かなりめんどくさい)から、数値以外の入力はすべて0(ゼロ)と見なすプログラムを書けば、A・S・Dあたりのキーを押すことで理想的(?)に0(ゼロ)を入力できる。また、答案画像のクリック位置とGridコントロールのフォーカス位置が連動するようにプログラミングすれば、ぱっと見、全体的に出来の良い設問への得点入力は、プログラムから一括で行い、あとは間違いの解答だけ、その画像をクリックしてAキーあたりを押して0(ゼロ)を入力すれば、いちばん効率よく採点できる・・・はず。逆に、ぱっと見、全体的に出来が悪そうなら、一括して0(ゼロ)を入力し、正解の解答だけ選択して得点を入力すればいい。多くの場合、正解の得点は5点未満だろうから、これらのキーはキーボードの左にあり、左手で押しやすい。

百歩ゆずって、あるキー(例:「さんかく」だから「s」キーとか)を押した場合だけ、採点記号を△とするのは容易だが、後々やっかいな問題が生じる。

プログラムは最終的に、Gridコントロール上のデータから、合計点を計算して返却用答案画像のどこかに印刷する仕様。で、その際、データに余計な文字があれば除外して計算することも出来なくはないが、予期せぬ間違いの元になるような要素は、なるべくなら最初から排除しておきたい。かといって、△マークであることを示すなんらかのフラグをデータとして持っていなければ、データを再読み込みした際に、画像上に△記号を表示することはできない・・・。しかし、そのために、Gridコントロール上に「採点記号・部分点」を意味する「s1」みたいな表示をするのは、できるだけ避けたい。Gridコントロール上に数値以外の文字が「ない」のが、最初からの理想なのだ。

実は、見えないGridコントロールをもう一つ、別に準備してここに「〇・△・×」の情報を記録しようか・・・とも考え、実際にやってみたんだけど、これだとアルゴリズム他をかなり修正しないといけないことに気づく。なので、この案は却下。

で、八方塞がり状態に・・・

2.マイナスの点数は通常ありえないコトに気づく

(やっぱり、ダメかぁー)

そう思いながら、それでもあきらめきれずに、なんとなくStringGrid1DrawCell手続きのコードを眺めていて、次のコードを残したままだったことに気づく。

  //正負をチェック
  if StrToInt(StringGrid1.Cells[ACol,ARow])< 0 then
  begin
    StringGrid1.Canvas.Font.Color := clRed;
  end else begin
    StringGrid1.Canvas.Font.Color := clBlack;
  end;

これは、いつか他のプログラムで使用したコードを、このプログラムにコピーした際、そのままになっていたものだ。別に問題を起こすようにも見えなかったし、通常の採点でマイナス点の入力はアリエナイから、誤って? 負の数が入力されたら赤く表示した方が入力ミス?が防げてかえってイイか・・・くらいの気持ちで、消さずに残しておいたのだ。

何度も実行して検証したプログラムコードだけれど、このプログラムでは「負の数の入力」は最初から予定に「ない」ので、負の数は一度も入力したことがなかった・・・し、このコードを消さずに残しておいたこと自体を、その存在に気づくまで、僕は忘れていた。

(こんなコードも入ってたんだ・・・)

その瞬間、何かが、ひらめいた気がした・・・

(そうか! 負の数をフラグに使う手があった☆)

本質的に文字だと計算上、いろいろ問題が起きるけど、負の数なら絶対値をとってしまえば合計点の計算は何の問題もなくできるし、さらに良いことに、これまで何よりも問題だった△を意味するフラグとして、-の記号を利用できる!!

赤で表示する設定になってることも、ユーザーにとって親切だし・・・。僕的に言えば、「△なら部分点に-(マイナス)記号をつけて入力」なんだけど、これを一般的に言えば「部分点を与える場合は、負の数として入力してください」ってことで、これならユーザーに確実に伝わるし、かつ覚えやすい。

さらに採点アルゴリズムも全体の大幅な見直しは不要で、Gridコントロールのデータが負の数であった場合の処理だけを追加すればよさそうだ。

なんで、こんなイイことに最初から気づかなかったのか、それは僕が足りないせいだけど、そんなことはどーでもイイ。なんだがうれしくなってキタ。

やったぁ♪ これで「東京都御用達の採点プログラム」に負けないのが作れる☆☆☆
(ハナから相手にされてないのは十分わかってます・・・)

ただ、純粋によくなろうとした自分が久しぶりに愛しい。

3.採点アルゴリズムを改良

で、採点アルゴリズムを次のように改良。なお、採点マークと設問毎の得点の表示設定は、図の「表示」オプションから採点者が選択する仕様。なお、プログラムは、Gridコントロールが空欄である場合、すなわち、入力値がない場合は、答案画像に対する処理は何も行わない。

※ Captionが「種類」となっているRadioGroupがコード内のRadioGroup4。
※ →X,↓Yが表示位置調整用の各ComboBox。矢印は意味を視覚的に伝える工夫。
※ Sizeで採点記号及び得点のFontの大きさを指定。

表示のデフォルト設定は「採点記号も得点も両方表示する」
//Gridコントロールへの入力値がない場合は「何もしない」
procedure TFormCollaboration.StringGrid1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  ・・・ 必要な変数を宣言 ・・・
  //例
  intValue : integer;
begin

  // 以下、実際のプログラムコードから必要な部分のみ抜粋

  if StringGrid1.Cells[ACol,ARow]<>'' then
  begin
    // 誤入力'00'があれば'0'に変換
    if StringGrid1.Cells[ACol,ARow]='00' then
    begin
      StringGrid1.Cells[ACol,ARow]:='0';
    end;

    // 入力文字数が3文字以上なら'0'に変換
    if Length(WideString(StringGrid1.Cells[ACol,ARow])) > 2 then
    begin
      StringGrid1.Cells[ACol,ARow]:='0';
    end;

    // 入力値が「数値」に変換できなかった場合はすべて'0'に変換
    if not TryStrToInt(StringGrid1.Cells[ACol,ARow], intValue) then
    begin
      StringGrid1.Cells[ACol,ARow]:='0';
    end;

    //背景色を白に設定
    StringGrid1.Canvas.Brush.Color:=clWhite;

    //正負をチェック
    if StrToInt(StringGrid1.Cells[ACol,ARow])< 0 then
    begin
      StringGrid1.Canvas.Font.Color:=clRed;
    end else begin
      StringGrid1.Canvas.Font.Color:=clBlack;
    end;

    //セルを塗りつぶす
    StringGrid1.Canvas.FillRect(Rect);

    //テキストを表示(中央寄せ)
    DrawText(StringGrid1.Canvas.Handle,
      PChar(StringGrid1.Cells[ACol,ARow]),
      //[+1]は数値描画位置の調整のため
      Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE);

  end;

  //Cellの値が0ではなかった場合の処理
  if not (StringGrid1.Cells[ACol,ARow]='0') then
  begin
    //Cellの値が正だった場合(完全正答〇の処理)
    if StrToInt(StringGrid1.Cells[ACol,ARow]) > 0 then
    begin

      //imgAnswerは答案画像を表示するTImage

      //Windows APIのSetBkMode関数でTRANSPARENTを指定
      SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);
      imgAnswer.Canvas.Font.Color := clRed;
      imgAnswer.Canvas.Font.Size  := StrToInt(FontSize指定用ComboBox.Text);

      case RadioGroup4.ItemIndex of
        0:begin
          //cmbX, cmbYは表示位置調節用の値を入力するComboBox
          imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
            DestRect.Top+StrToInt(cmbY.Text), '○');
        end;
        1:begin
          imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
            DestRect.Top+StrToInt(cmbY.Text), StringGrid1.Cells[ACol,ARow]);
        end;
        2:begin
          imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
            DestRect.Top+StrToInt(cmbY.Text), '○'+StringGrid1.Cells[ACol,ARow]);
        end;
      end;

    end else begin

      //Cellの値が負だった場合(△)-> この部分を新規に追加
      if StrToInt(StringGrid1.Cells[ACol,ARow]) < 0 then
      begin
        //Windows APIのSetBkMode関数でTRANSPARENTを指定
        SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);        
        imgAnswer.Canvas.Font.Color := clRed;
        imgAnswer.Canvas.Font.Size  := StrToInt(FontSize指定用ComboBox.Text);

        case RadioGroup4.ItemIndex of
          0:begin
            imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
              DestRect.Top+StrToInt(cmbY.Text), '△');
          end;
          1:begin
            imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
              DestRect.Top+StrToInt(cmbY.Text),
              IntToStr(Abs(StrToInt(StringGrid1.Cells[ACol,ARow]))));
          end;
          2:begin
            imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
              DestRect.Top+StrToInt(cmbY.Text), '△'+
              IntToStr(Abs(StrToInt(StringGrid1.Cells[ACol,ARow]))));
          end;
        end;
      end;
    end;

  end else begin

    //不正解の場合の処理(×)
    //Windows APIのSetBkMode関数でTRANSPARENTを指定
    SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);    
    imgAnswer.Canvas.Font.Color := clRed;
    imgAnswer.Canvas.Font.Size  := StrToInt(FontSize指定用ComboBox.Text);

    case RadioGroup4.ItemIndex of
      0:begin
        imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
          DestRect.Top+StrToInt(cmbY.Text), '×');
      end;
      1:begin
        imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
          DestRect.Top+StrToInt(cmbY.Text), StringGrid1.Cells[ACol,ARow]);
      end;
      2:begin
        //chkZeroはCaption「得点0は表示しない」のCheckBox
        if not chkZero.Checked then
        begin
          imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
            DestRect.Top+StrToInt(cmbY.Text), '×'+StringGrid1.Cells[ACol,ARow]);
        end else begin
          imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
          DestRect.Top+StrToInt(cmbY.Text), '×');
        end;
      end;
    end;
  end;
end;

で、実行結果は・・・(解答はテキトーなので、それ自体に意味はありません。ここでは+5xを正解で得点4点とし、-5xを△で部分点2点としている)。

採点欄への入力が正の数なら〇、ゼロなら×、負の数なら採点記号は△を表示

今、こうしてコードを眺めて見れば、別に変わったコトなんてなぁーんにもしてない、ほんとに単純なif文のネストにすぎないんだ・・・けど。

ここに、たどり着くまでは、ほんとうに長かったなぁ

あらためて(あたりまえのことですが)、処理の基礎となる考え方・・・アルゴリズムの重要性がわかった気がしました。

こんな、なんでもないような工夫で、自分の中ではかなり大きかった(△マークが使えない)という問題を解決できるんだ。ただ、そこにたどり着くためには、残念ながら、僕にはすごく「時間」がかかるんだ。でも、あきらめずに(時間はかかるけど)出来るまで頑張れば、プロが書いたプログラムと同じことが、僕にもできるんだ・・・って。

多くの人にとって、おそらく、まったく参考にならない、こんなことを、お金までかけて公開するのは、つまり、もしかしたら、どこかにいる、かもしれない、僕と同じような気持ちでいる誰かに、(あきらめないで)って伝えたかったから・・・かも、しれない。

あなたの夢を、あきらめないで・・・って。

4.合計点の計算と印刷

続いて、合計点の計算・その印刷位置の指定から返却用答案画像の印刷へと繋げる部分。まず、絶対値に換算して合計を計算するようにコードを修正。ただ、Abs( )を追加しただけで、あんなに悩んだ△マークの処理が実現できるなんて、なんだか、夢のよう。

var
  i,j,k : integer;
begin
  //合計点を入れる変数kを初期化
  k := 0;
  //合計点を計算
  for i := 1 to StringGrid1.RowCount-1 do
  begin
    for j := 1 to StrToInt(解答欄数.Text) do
    begin
      if StringGrid1.Cells[j,i] <> '' then
      begin
        //△に非対応
        //k := K + StrToInt(StringGrid1.Cells[j,i]);
        //△は負の数で入力しているから絶対値で計算
        k := K + Abs(StrToInt(StringGrid1.Cells[j,i]));
      end;
    end;
    //合計点を保存(StringGrid.Cells[列, 行])
    StringGrid1.Cells[StrToInt(解答欄数.Text)+1, i] := IntToStr(k);
    //合計点を初期化
    k := 0;
  end;
end;

返却用答案画像の印刷にあたっては、合計点表示の有無を選択しないと印刷ボタンをクリックできない仕様として・・・。ユーザーが合計点「有り」を選択した場合は、合計点を上記コードで計算後、返却用答案画像をTImageに表示し、このTImageへのMouseDownイベントを利用して、ユーザーに合計点印刷位置を指示してもらい、合計点入りのサンプル画像を提示(合計点の印刷位置の修正は、ユーザーが納得できるまで何回でも可能)。最終的に位置が決まったら印刷ボタンへフォーカスを移して、クリックで印刷という流れ。

合計点の印刷の有無を指定し、「有り」の場合は必要な処理を行わないと、印刷ボタンはクリックできない。
ユーザーのクリックした位置を左上座標(0,0)として合計点を挿入&返却用答案のサンプルを提示。
(サンプル画像にある矩形は、実際には印刷されない)
「いいえ」をクリックすれば何回でも位置指定のやり直しが可能。

以下のコードが合計点の印刷位置決め部分。「いいえ」を選択した場合は、合計点サンプルを表示したのと同じ場所に、同じ内容を「赤」ではなく、「白」で再描画して消去したように見せかけている(よく見ると若干、先に赤で表示した合計点の輪郭が残っているのがわかる。その原因は不明。今後、原因を調べたい)。

「いいえ」を選択した場合の画像(白で上書きした合計点の輪郭が残ってしまう)
//合計点VCLはLabel
//フォントサイズ指定VCL、解答欄数VCLはComboBox
//変数bSumは、合計点印刷の有無を確認するBoolean型変数
procedure TFormCollaboration.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  MyPath : string;
  TempBmp : TBitmap;
  //MessageDlgの押されたボタンを知る
  Ans : Word;
  //BalloonHintの表示
  LTitle : string;
  LText  : string;
  LhIcon : HICON;
  LPos   : TPoint;
  LArrow : TBalloonArrow;

  //普通の四捨五入を行う関数を設定
  function Roundoff(X: Extended): Longint;
  begin
    if x >= 0 then Result := Trunc(x + 0.5)
              else Result := Trunc(x - 0.5);
  end;

  procedure GetXY(iX,iY:Integer);
  begin
    //合計点印刷位置の座標を取得
    iX:=Roundoff(iX/(TrackBar1.Position/100));
    iY:=Roundoff(iY/(TrackBar1.Position/100));

    //Imageに画像をセットする際、自動でサイズ調整を行っている
    合計点の位置X:=iX;
    合計点の位置Y:=iY;

    //矩形を描画
    with Image1 do
    begin
      //Canvas.Brush.Style:=bsClear;  //Pythonを使っていない時はこれでOK!
      //Pythonを使っている時は明示的に書く必要がある
      //(Python.pasにもbsClearが定義されている)
      Canvas.Brush.Style:=Vcl.Graphics.bsClear;
      Canvas.Pen.Color:=clRed;
      Canvas.Pen.Width:=3;
      //矩形を描画
      合計点VCL.Font.Size:=StrToInt(フォントサイズ指定VCL.Text);
      Canvas.Rectangle(合計点の位置X, 合計点の位置Y, 
        合計点の位置X+合計点VCL.Width, 合計点の位置Y+合計点VCL.Height);
      Canvas.Font.Color:=clRed;
      Canvas.Font.Size:=StrToInt(フォントサイズ指定VCL.Text);
      //LabelにStringGridから合計点を取得しておく
      合計点VCL.Caption:=StringGrid1.Cells[StrToInt(解答欄数VCL.Text)+1, 1];
      Canvas.TextOut(合計点の位置X, 合計点の位置Y, 合計点VCL.Caption);
    end;
  end;

begin

  if bSum then
  begin

    //合計点の印刷位置の座標を指定&取得
    //Imageをクリックするたびに、GetXY(X,Y)が呼び出される(実行される)
    GetXY(X,Y);

    Ans:= MessageDlg('印刷位置は、この位置でよろしいですか?'+#13#10+#13#10+
      '(左寄せで印刷。矩形は印刷されません。)',
      mtInformation, [mbYes, mbNo, mbCancel], 0);

    if Ans = mrYes then
    begin

      //[はい]が選ばれた時

      //案内
      MessageDlg('印刷ボタンをクリックしてください。', mtInformation,[mbOK],0);

      //バルーンヒントのタイトルとヒントの内容
      LTitle := '印刷ボタン';
      LText  := 'ココです!' + sLineBreak + 'クリックしてください';

      //バルーンヒントの表示のとスタイル
      LArrow:= baTopLeft;       //VCLの上・左へ向けて表示
      //LArrow:= baTopCenter;     //VCLの上・中央
      //LArrow:= baTopRight;        //VCLの上・右へ向けて表示
      //LArrow := baBottomRight;  //VCLの下・右へ向けて表示
      //LArrow := baBottomCenter; //VCLの下・中央
      //LArrow := baBottomLeft;   //VCLの下・左へ向けて表示

      //バルーンヒントの吹き出しの始点
      LPos:=印刷ボタン.ClientToScreen(Point(Trunc(印刷ボタン.Width div 2), 0));

      //システムのInfoアイコンを使用
      LhIcon := LoadIcon(0, IDI_INFORMATION);

      try
        //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
        BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 5000);
      finally
        DestroyIcon(LhIcon);
      end;

      //カーソルを元に戻す
      Screen.Cursor:=crDefault;
      Image1.Visible:=False;
      Image1.Picture.Assign(nil);
      //SetFocus
      印刷ボタン.Enabled:=True;
      印刷ボタン.SetFocus;
    end;

    if Ans = mrNo then
    begin
      //[いいえ]が選ばれた時
      with Image1 do
      begin
        //Canvas.Brush.Style:=bsClear;  //Pythonを使っていない時はこれでOK!
        //Pythonを使っている時は明示的に書く必要がある
        //(Python.pasにもbsClearが定義されている)
        //クリック位置に同じ内容を「白で上書き」してサンプルを消去
        Canvas.Brush.Style:=Vcl.Graphics.bsClear;  
        Canvas.Pen.Color:=clWhite;
        Canvas.Pen.Width:=3;
        合計点VCL.Font.Size:=StrToInt(フォントサイズ指定VCL.Text);
        Canvas.Rectangle(合計点の位置X, 合計点の位置Y, 
          合計点の位置X+合計点VCL.Width, 合計点の位置Y+合計点VCL.Height);
        Canvas.Font.Color:=clWhite;
        Canvas.Font.Size:=StrToInt(フォントサイズ指定VCL.Text);
        Canvas.TextOut(合計点の位置X, 合計点の位置Y, 合計点VCL.Caption);
      end;
    end;

    if Ans = mrCancel then
    begin
      //キャンセルが選ばれた時
      //カーソルを元に戻す
      Screen.Cursor:=crDefault;

      //その他の処理

    end;
  end;
end;

5.まとめ

数値のみを用いて、〇・△・× を表現する。解決までに2ヶ月近くを要した課題だった。最終的には、「Gridコントロールへの入力が、正の数なら〇、負の数なら△(マイナス記号はフラグとして利用)、0(ゼロ)なら × 、空欄なら何もしない。」として解決。

この単純なアルゴリズムにたどり着くまで、僕はあきらめかけたり、再びチャレンジしたり、様々に思い悩んだ。夢見た通り、プログラムはよくなったが、果たして僕自身は成長したのだろうか・・・

僕は天才でも、なんでもない。
特別なことなんて何一つできない。
他の誰かより優れたモノなんて
何ひとつ、持たない・・・。

何をやらせてもトロいし、
物事の理解にかける時間は、ヒトの何倍も必要だけど、
でも、時間さえかければ、
僕にも、かたちにできるものは、ある・・・

いつか、TVで見たんだ。

若き日の山中 伸弥先生が、利根川 進先生に質問してた。
「日本では研究の継続性が大切だと言われますが、先生はどうお考えですか?」 と。

利根川先生は即答してた。
「重要で、面白い研究であれば何でもいいじゃないか」と。

人々に、社会に、貢献「したか・しなかったか」が、すべてなんだと。

RFKも、同じ言葉を残してる。

The purpose of life is to contribute in some way to making things better.
「人生の目的は、ものごとを良くすることに対してなんらかの貢献をすることだ。」

さらに・・・

You’re happiest while you’re making the greatest contribution.
「最高の貢献を成そうとする時、あなたは最高の幸福を知る。」

とも(命の使い方を、彼自身の人生が代弁している気がするけど・・・)。

ようやくカタチにできた、僕の夢を、
職場のみんなに自由に使ってもらえるプログラムとして公開する。
たったひとり、でもいい。
このプログラムでしあわせを手にする人が、どうか、いてほしい。

それをもし、貢献と呼んでもらえるなら、
どんなにか、うれしいだろう・・・

そして、僕がこの世界から消えた後まで、
これまでにかたちにしたいくつかの夢を・・・もし、残せたら
どんなにか、しあわせだろう・・・

Delphiといっしょに、
Object Pascalで組んだ、
夢のかたち。

そう、夢のかたち・・・。

この胸にずっと、思い描いてきた
僕の夢のかたちを。

6.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Organize items displayed in recently opened files

「最近開いたファイルに表示される項目を整理する」

不要になったプロジェクトをバックアップ後、フォルダごと削除したり、プロジェクトファイルを入れたフォルダの名前そのものを変更してしまったりすると、Delphi起動直後に表示される「ウェルカムページ」の「最近開いたファイル」の項目も整理したくなる。その方法を調べた。これはその覚え書き。

1.「最近開いたファイル」の項目の整理方法
2.「ウェルカムページ」そのものを表示しない
3.まとめ
4.お願いとお断り

1.「最近開いたファイル」の項目の整理方法

最新のバージョン11.2の場合、次のように操作する。IDEの[ファイル]->[最近開いたファイル]->[プロパティ](旧バージョンの場合は、[ファイル] -> [開き直す] -> [プロパティ]の順のようだ)。

[ファイル] -> [最近開いたファイル] -> [プロパティ]の順にクリック

[開き直す]メニューのプロパティが表示される。

「存在しないファイルの削除」をクリックすれば、(Pathの有無を確認しているのでしょう)全自動で項目を整理してくれる。これはすごい便利!!

任意の項目を選んで「削除」したり、「クリア」ボタンで履歴を全部消すこともできる。ちなみに「クリア」ボタンをクリックした場合は・・・

確認メッセージが表示される

「はい」をクリックすると・・・

全部消えた!

2.「ウェルカムページ」そのものを表示しない

ウェルカムページの必要性を感じない場合は、IDE起動時に「表示しない」ように設定することもできるようだ。

Delphiへのショートカットを右クリックしてプロパティを表示し、「ショートカット」タブのリンク先(T):「”C:\Program Files (x86)\Embarcadero\Studio\22.0\bin\bds.exe” -pDelphi」の「-pDelphi」の後ろに「(半角スペース)-np」を追加して、「”C:\Program Files (x86)\Embarcadero\Studio\22.0\bin\bds.exe” -pDelphi -np」にする。

Delphi 11.2 Alexandriaの場合

「OK」もしくは「適用」をクリックすると、確認のメッセージが表示される。

あなたの責任だよ!ってコト?

「続行」をクリック。で、次回の起動時からは・・・

すっきりー!

ウェルカムページを表示する設定に戻すには、Delphiへのショートカットを右クリックしてプロパティを表示し、先ほど追加した「(半角スペース)-np」を削除して「OK」をクリック。表示されるメッセージの「続行」をクリックすれば、次回のIDE起動時からウェルカムページが再び表示されるようになる。

3.まとめ

(1)ウェルカムページに表示される項目の整理方法は、次の通り。

 ・[ファイル] -> [開き直す] -> [プロパティ]から項目の整理ができる。

(2)ウェルカムページそのものを表示しない設定も可能。

 ① Delphiへのショートカットを右クリックしてプロパティを表示。
 ② ショートカットタブのリンク先(T)末尾に「 -np」を追加。

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Delphi 11.2 Alexandria has arrived!

「アレキサンドリアがやってきた!」

2022年9月17日(土)早朝、てか、普通のヒト的には深夜、MyPCにDelphi 11.2 Alexandriaがやってきた。わぁーい*(^_^)*♪ インストールに時間がかかりそうだから、土曜日を待ってたんだ。きゃっほー♪ isoファイルをDLして、マウントして、インストーラを起動。しばらく待って無事インストール完了。それから、My Secret Weapon、大好きなPython4Delphiも入れて、今、作ってるプログラムを読み込んで実行したら・・・。

あれー? バルーンヒントが指定したVCLじゃなくて、マウスのポインタ位置に表示されるんだけど・・・。ふーん、今度からそうなったんだ。Delphi すごーい。でも、なんでー? みたいな・・・ T_T

1.11.2でバルーンヒントが大変なコトに
2.VCLの位置をTPointでGet!
3.まとめ
4.お願いとお断り

1.11.2でバルーンヒントが大変なコトに

MyPCだけで起きていることカモしれないけど、Delphi 11.2 Alexandriaをインストールして、以前のバージョンで作ったプログラムを読み込んで実行したら、バルーンヒントの表示される位置が・・・、んー。設定と・・・かなり「違う」。みたいな・・・

早速、検証用プログラムを作って、動作確認。

Button3をクリックしたら・・・ の手続きの中で、
(※注意:バルーンヒントにアイコンを表示する方法は、この下で解説)

procedure TForm1.Button3Click(Sender: TObject);
begin
  //バルーンヒントを表示
  BalloonHint1.Title := 'ヒント';
  BalloonHint1.Description := 'ここをクリックしてください';
  BalloonHint1.HideAfter := 12000; //表示時間(単位:ms)
  BalloonHint1.ShowHint(button2.ClientToScreen(CenterPoint(button2.ClientRect)));
  //案内アイコンも追加
  BalloonHint1.ImageIndex := 0;
end;

バルーンヒントを表示するのは、「button2」の真ん中だよって、ちゃんと指定してるのに・・・

なぜか Button2ではなく、マウスポインタ位置にバルーンヒントが表示・・・される

これでは役に立たないけれど、案内アイコンを付けてバルーンヒントを表示する方法をいちおうメモ(11.2より前のバージョンのDelphiなら、期待通りに動くはず)。

(1)FormにImageList1を置いて、HeightプロパティとWidthプロパティ両方に「32」を設定。

ImageList1のHeightプロパティとWidthプロパティ両方に「32」を設定。

(2)BalloonHint1のImagesプロパティにImageList1を指定。

BalloonHint1のImagesプロパティにImageList1を指定。

(3)IconExplorerをDLして、インストール。

Icon Explorer

https://www.mitec.cz/iconex.html

(4)IconExplorerを起動し、c:\Windows\System32\Shell32.dllをクリックするとアイコン一覧が表示されるので、その中から目的のIconを探して、以下のように操作。

c:\Windows\のSystem32フォルダをクリック
Shell32.dllをクリック
目的のアイコンをさがしてクリック
32×32を右クリック

で、表示されるサブメニューから、「Save to Bitmap」を選択し、任意のフォルダに保存する(PNGだと背景が透明になる・・・。Jpegは試していない)。

(5)TImageListをダブルクリックして表示されるWindowの「追加」をクリックして、上で任意のフォルダに保存したInfoアイコンを選択して「OK」をクリックする。

「追加」をクリックして、上で任意のフォルダに保存したInfoアイコンを選択してOKをクリック

(6)上で紹介したコードを記述して実行すれば、11.2より前のバージョンのDelphiなら期待した通りに動作するはず。バルーンヒントが表示される位置が、目的のVCLコントロールの上だったり、下だったり、その表示位置を自由に制御できないのがもどかしかったり、ヒントの色が背景と同じで、実際に使ってみると思ったほどヒントが目立たなかったり・・・ みたいな不満は、正直ずっとあったけど。少なくても「そこに出せ!」とコードで指示したVCLを無視するようなことだけはなかった・・・。11.2より前のバージョンのDelphiなら・・・

でも、もう前のバージョンには戻せない。

何回コンパイルしても、頑なまでに、指示を無視する11.2。
生まれたてなのに、イイ根性してます・・・。

でもね。

Delphiを心から信じ、愛している人間は、きっとこう思うはずなんですよ。

これは11.2で「バルーンヒントの表示位置は、マウスポインタがアクティブな場合、プログラム内容よりポインタの現在位置を優先する」仕様へとDelphiが進化したため・・・。

一瞬、そう思いたくもなったのですが。次の瞬間、

こんなプログラム。フツーのヒトは、
壊れてるとしか思わねーだろ!

・・・という声が聞こえ(た気がする)、僕は自分を取り戻した次第です。

そう言えば、ある冬の寒い朝、これと似た出来事がありました。

ハナが冷たくて目が覚めた僕は、
となりでまどろんでる彼女に、小さな声でききました。

『ねぇ 今日もさむいー?』

想像を絶する大音量で、返事が。

冬だから寒いに決まってんだろ!

おまけに、

冬をなめとんのか? オマエは

はい。すみません。

ですが、そこまで言わなくても・・・。
クー。クー。眠ってたはずなのに。もしかして、寝言?

こんな、違うだろ・・・みたいな出来事は、たくさんあって、僕は彼女が大好き。

パスタが大好きな僕ですが、ある晩、無茶苦茶美味しいパスタを彼女が作ってくれて・・・。ほんとに美味しかったから、翌朝、夢で味わったようなパスタを思い出して

『ねぇ まだおかわり、あるー?』って、やっぱり夢の中にいる彼女にきいたら、

ヨーシ、髪の毛で増量!

この人と結婚してよかったぁ☆

彼女とのことは、これでよくても、プログラムは、良くないです。
もし、本当に仕様変更であったにしても、この設定は受け入れられません。

で、Google先生に、どうしたらイイかを、いっぱい訊ねて得た僕なりの結論は・・・

現段階で、どうしてもバルーンヒントを表示したい。・・・なら
自前で作ったバルーンヒントを表示するしかない(したい)。

VCLコントロールのHintプロパティに「言い訳」的に何かを入力して、ShowHintプロパティをTrueに設定。で、実行時、マウスポインタがそのVCLコントロールをポイントしたら、操作方法のヒントを表示するみたいな「控えめ」なユーザーへの案内でなく、何かVCLをクリックしたら、プログラムを初めて使うユーザーにも「こっちだよー!」と手招きするような案内を、僕は表示したくて・・・。

普通のヒントでなく、バルーンヒントを表示させたいだけなら、こちらのWebサイトで紹介されていた方法もあるけど。

Delphi2010 バルーンヒント(BalloonHint)

http://afsoft.jp/program/del2010/p11_047.html

Mr.XRAYさんのWebサイトに完璧な答えが掲載されていました。
以下、その記事を引用して書いたプログラムです。

06_バルーンヒントウィンドウを自作

http://mrxray.on.coocan.jp/Delphi/Others/BalloonHintWindow.htm

上記サイトからDLできるplBalloonHint.pasをdprojファイルがあるのと同じフォルダに入れて、usesに次のように記述。

implementation

uses
  plBalloonHint;

{$R *.dfm}

Button1Click手続きに、以下のコードを記述。

procedure TForm1.Button1Click(Sender: TObject);
var
  LTitle : string;
  LText  : string;
  LhIcon : HICON;
  LPos   : TPoint;
  LArrow : TBalloonArrow;
begin

  //バルーンヒントを表示

  //タイトルとヒントの内容
  LTitle := 'ヒント';
  LText  := 'バルーンヒントを表示' + sLineBreak + '2行目'+ sLineBreak + '3行目';

  //表示のスタイル
  //LArrow:= baTopLeft;       //VCLの上・左へ向けて表示
  //LArrow:= baTopCenter;     //VCLの上・中央
  LArrow:= baTopRight;        //VCLの上・右へ向けて表示
  //LArrow := baBottomRight;  //VCLの下・右へ向けて表示
  //LArrow := baBottomCenter; //VCLの下・中央
  //LArrow := baBottomLeft;   //VCLの下・左へ向けて表示

  //吹き出しの始点
  GetCursorPos(LPos);   //マウスでクリックした位置に表示

  //システムのInfoアイコンを使用
  LhIcon := LoadIcon(0, IDI_INFORMATION);

  try
    //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
    BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);
  finally
    DestroyIcon(LhIcon);
  end;

end;

で、実行すると・・・

これくらい目立って欲しかった! Mr.XRAYさん、ほんとうにありがとうございます。

2.VCLの位置をTPointでGet!

んじゃ、Button1をクリックしたら、Button2の上に「こっちだよー」みたいにバルーンヒントを表示できたらいいなーっと思って、コードを書こうとしたら、なんと! その書き方を知らないことに気がつきました。

とりあえず、Button2の位置が取得できればいいわけですから、イロイロ調べた結果、次のstack overflow の記事を発見。

How can I get the X,Y position of a TWinControl (relative to the screen)

https://stackoverflow.com/questions/290000/how-can-i-get-the-x-y-position-of-a-twincontrol-relative-to-the-screen

で、以下のコードで、Button2の位置をLabel1に表示できることを確認。
(Pointを使うためにusesにSystem.Typesを追加)

implementation

uses
  plBalloonHint,
  System.Types;

  //System.TypesはButtonの位置を取得するPointを使用するために追加

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
var
  LPos: TPoint;
begin
  //Button2の左上座標を取得して表示
  LPos := Button2.ClientToScreen(Point(0,0));
  Label1.Caption := Format('Screen: %d, %d', [LPos.X, LPos.Y]);
end;

で、Button1Click手続きのコードを次のように変更。

procedure TForm1.Button1Click(Sender: TObject);
var
  LTitle : string;
  LText  : string;
  LhIcon : HICON;
  LPos   : TPoint;
  LArrow : TBalloonArrow;
begin

  //バルーンヒントを表示

  //タイトルとヒントの内容
  LTitle := 'ヒント';
  LText  := 'バルーンヒントを表示' + sLineBreak + '2行目'+ sLineBreak + '3行目';

  //表示のスタイル
  //LArrow:= baTopLeft;       //VCLの上・左へ向けて表示
  //LArrow:= baTopCenter;     //VCLの上・中央
  LArrow:= baTopRight;        //VCLの上・右へ向けて表示
  //LArrow := baBottomRight;  //VCLの下・右へ向けて表示
  //LArrow := baBottomCenter; //VCLの下・中央
  //LArrow := baBottomLeft;   //VCLの下・左へ向けて表示

  //吹き出しの始点
  //GetCursorPos(LPos);   //マウスでクリックした位置に表示
  //Button2の上・幅の1/2の位置に吹き出しの始点がくるように表示
  LPos := Button2.ClientToScreen(Point(Trunc(Button2.Width div 2), 0));

  //システムのInfoアイコンを使用
  LhIcon := LoadIcon(0, IDI_INFORMATION);

  try
    //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
    BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);
  finally
    DestroyIcon(LhIcon);
  end;

end;
実現したかったのは、まさにコレ!

バルーンヒントを表示する位置によっては、ヒントが画面からはみ出して見えなくなってしまうことがあるので、表示位置の上下・表示する向きは実際の場面に合わせて調整する必要があるけれど、表示位置はDelphiまかせで制御できない(・・・と思ってるのは私だけ?)TBalloonHintより、見た目もくっきり・はっきりしていて目立つし、plBalloonHint.pasを公開してくださったMr.XRAYさんに心から感謝です。

うまく動かなかったTBalloonHintのコードの一部を使って、次のコードにすれば、

  //LPos := Button2.ClientToScreen(Point(Trunc(Button2.Width div 2), 0));
  LPos := Button2.ClientToScreen(CenterPoint(button2.ClientRect));

ボタンの中心に吹き出しの始点を持ってくることもできます。

ほんとに微妙な違いですが・・・僕はButtonのCaptionが全部見える方が好きです。

バルーンヒント表示対象のVCLコントロールの大きさや位置によって、VCLの周囲に表示するか、内部に表示するか、その判断が異なってくると思うので、ClientRectで座標を取得する方法も覚えておいた方が賢明かと。

3.まとめ

MyPCだけで発生する現象なのかもしれないが、Delphi 11.2 をインストールしたらバルーンヒントの表示位置がオカしくなった。

Mr.XRAYさんが配布してくださっている「自作のバルーンヒント」が表示可能なplBalloonHint.pasを使用すれば、この問題は解決でき、さらに「より良く目立つ」バルーンを表示できる。

バルーンヒントを表示するターゲット(VCL)の左上座標は、

  LPos := ターゲットとするVCLの名称.ClientToScreen(Point(0,0));

上のコードで取得できるので、結果をTPoint型の変数に代入して、バルーンヒントの引数に指定(必要に応じてX、Y座標の値が増加するような式を付加する)。また、VCLコントロールの大きさによっては、ClientRectで座標を取得した方がよい場合もありそう。

LPos := ターゲットとするVCLの名称.ClientToScreen(Point(VCLの名称.ClientRect));

で、表示するコードは、

  //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
  BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Management of Printing Equipment

「プリンタの管理で悩む」

1.Windows10のプリンタ管理方法の変更で困ったこと
2.AD環境下で管理者として実行するとネットワークプリンタが見えない!
3.プログラムから「デバイスとプリンター」設定画面を呼び出し
4.まとめ
5.お願いとお断り

1.Windows10のプリンタ管理方法の変更で困ったこと

Windows10になって、いちばん困ったのはプリンタの管理方法の変化だった。デフォルト設定で、最後に使ったプリンタが通常使うプリンタと見なされるようになってから、職場のあちこちで「印刷ができない!」という声が上がることが多くなった。駆け付けてみると、出力先プリンタはいつも「Microsoft Print to PDF」みたいな・・・。

そのたびに「Windowsで通常使うプリンターを管理する」のチェックをOFFにして、AD環境下に置かれた最も近いネットワークプリンタを「通常使うプリンタに設定」する作業を繰り返してきた。

プリンタ設定の方法を文書にして配布しても、どこかへなくしてしまったり、設定方法を忘れた頃にWindows Updateがあってプリンタの設定が勝手に(?)変更されたり・・・、

一般的ユーザーにとっては、「設定やコントロールパネルを開いて操作する」というのは、やはりどこか嫌な感じがする作業のようで、AD環境下でのプリンタ設定は、もうずっと前から思い出すと悩ましい、あまり考えたくないことのひとつだった。

2.AD環境下で管理者として実行するとネットワークプリンタが見えない!

そのように状況が変化する中で、僕は上司から要請されて、出張・休暇関係の申請文書を処理するシステムを組んだ。職員がPCで申請手続きを行うと、申請内容がそのままデータベース化され、管理職が電子決済を行い、出張・休暇を承認する。で、日報や週報のカタチで出張・休暇者の一覧が帳票形式で出力できる、そんなシステムだ。手続きの全部を電子データで行えば「紙」は必要ないと思うのだが、僕が所属する業界では(最終的には本社へ)事務方から「紙」のカタチで様々な報告がなされるようで、どうしても「印刷」作業が必要とのこと(ほぼ同時期に、某公的機関が全県一斉に出退勤時刻の記録方式を改めたことに追随するよう、これまた上司から要請され、新規にICカードとICカードリーダーを用いた勤務記録の管理システムも組んだが、こちらは本社への報告を含め、全て電子データでの処理となっている)。

OSをめぐる状況の変化から、当然、「Windowsで通常使うプリンターを管理する」のチェックがONで、通常使うプリンタが明示的に設定されておらず、出力先プリンタが「Microsoft Print to PDF」になっていて、印刷が「できない」PCが出現することは予測できた。

AD環境下なので、PCごとにグループポリシーでプリンタの割り当ては行ってあるのだが、そのプリンタはADにログオンした時、ネットワークプリンタとして「見える」だけで、通常使うプリンタに明示的に設定されているわけではない。

「通常使うプリンタに設定」するには、どうしても「誰か」が手動でこれを設定しなければならない。しかし、現在動かしている〇〇プログラムとは別に、「設定」もしくは「コントロールパネル」を開いてプリンタの設定を変更する方法が「組織全体の記憶」としてなかなか定着しないのだ・・・。

困った僕は次の方法で、この問題を解決しようとした。それは・・・

プリンターの選択ダイアログを表示して、設定を変更!

印刷の際にプリンターの選択ダイアログを「必ず」表示し、もし「通常使うプリンタに設定」されているプリンタがなかった場合は、出力先プリンタを右クリックして表示されるサブメニューから「通常使うプリンタに設定」を選んでクリックしてもらい、そのプリンタへ出力してもらうというもの(クリックして単に選択しただけでは出力されない)。

この方法をとれば、設定やコントロールパネルをいちいち呼び出す必要がないし、プリンタ名を右クリックすれば簡単に「通常使うプリンタに設定」できるから、PCの操作に自信のないユーザーにも敷居が低いのではないか? と考えたのだ。

こうして、職場にある多くのノートPCで、通常使うプリンタの指定がなされていない場合(=Windowsに管理を任せている場合)に、印刷データが「Microsoft Print to PDF」に出力され、紙に印刷できなくなってしまう問題をなんとか回避することができた。

ちなみに、この方法は次のWebサイトで紹介されていた情報から考案。
Mr.XRAYさんに心より感謝申し上げます。

015_プリンタ設定関係ダイアログ API の使用方法

http://mrxray.on.coocan.jp/Delphi/plSamples/015_PrintDlgAPI.htm#01

Mr.XRAYさんのサイトの情報に援けられて、なんとかその場はしのいだけれど、僕自身の中ではずっと「しこり」のようなものが残って・・・。

たまたま印刷ダイアログに表示されたプリンタ名を右クリックしたら通常使うプリンタに設定できた!」のではなくて、「① ComboBoxの選択肢から通常使うプリンタに設定したいプリンタ名を選び、ボタンクリックで設定」もしくは「② 最初から通常使うプリンタに設定することを目的にワンクリックでコントロールパネルの『デバイスとプリンター』を開きたい」みたいな想いが・・・。

あれからずっと・・・、僕の中に。

そこで今回、自分自身の勉強も兼ねて、さらにいろいろ調べて最初に①の方法が実現できないか、試してみた。コードは次の通り。

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FDevice : array[0..MAX_PATH - 1] of Char;
    FDriver : array[0..MAX_PATH - 1] of Char;
    FPort : array[0..MAX_PATH - 1] of Char;
    FDeviceMode : THandle;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Printers,
  Winapi.WinSpool,
  System.Win.ComObj,
  Vcl.ComCtrls;

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
  APP : Variant;
  str : String;
begin
  //ネットワークプリンタに接続
  str := ComboBox1.Text;
  APP := CreateOleObject('WScript.Network');
  try
    APP.SetDefaultPrinter(str);
    ShowMessage(str + 'を既定のプリンタに設定しました');
  except
    ShowMessage('既定のプリンタへの設定に失敗しました');
  end;
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  //選択したプリンタを現在のプリンタとする
  Printer.PrinterIndex := ComboBox1.ItemIndex;
  //ここで取得するFDeviceMode1には,変更前のプリンタの情報が格納されている
  //その他の値は現在(変更後)のプリンタの情報となっている
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
  //FDeviceMode初期化
  Printer.SetPrinter(FDevice, FDriver, FPort, 0);
  //FDeviceModeが新しいプリンタドライバの値となる
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Items.Clear;
  ComboBox1.Items.Assign(Printer.Printers);
  ComboBox1.ItemIndex := Printer.PrinterIndex;
  //選択したプリンタを初期化
  //ここでは通常使うプリンタとなっている
  ComboBox1Select(nil);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  //Formを画面の中央に表示
  Left:=(Screen.Width-Width) div 2;
  Top:=(Screen.Height-Height) div 2;
end;

実行すると・・・

ネットワークプリンタを選んで、設定ボタンをクリックする
MyPCでは、問題なく設定できた!

管理者権限でログオンしているMyPCでは上の例のように「何の問題もなく」動作する。が、AD環境下ではどうだろうか? 通常、ADにログオンする場合は、何でもできるネットワーク管理者権限ではなく、誰もが一般制限ユーザーとしてログオンする。この管理者でないユーザーが果たしてプリンタの設定を、このプログラムで変更可能か・どうか、試してみた。

結論から先に。
動作したり・しなかったりで、挙動が不安定だった。なぜ、Aパソコンでは動作するのに、Bパソコンでは動作しないのか。明示的に通常使うプリンタを設定したAでは、「設定しました」というメッセージが出て、コントロールパネルのデバイスとプリンターの画面にも反映される。が、明示的に通常使うプリンタを設定していないBでは「設定しました」というメッセージは出ても、コントロールパネルのデバイスとプリンターの画面には反映されない。「Windowsで通常使うプリンターを管理する」のチェック状態でこの違いは生まれるのか? (ちなみにAもBもT社製のまったく同じ時期に導入したリース機材)。

このBパソコンではさらに不思議なことが発生。僕の書いたDelphiのプログラムのプリンタ選択画面では「ユーザーが通常使うプリンタに明示的に指定したプリンタが緑のチェックマーク付きで表示されている」のに、コントロールパネルの「デバイスとプリンター」を開くと、そこでは「通常使うプリンタの設定がない」状態で表示され、さらに変更を加えようとすると「このプリンターを通常使うプリンターに設定すると、Windowsは通常使うプリンターの管理を停止します。」の注意メッセージが表示されてしまった・・・。これに関しては、もう、わけがわかりません・・・。が、結論として、①案は、今回はちょっとダメかなーみたいな・・・。

では、これを管理者権限で実行したらどうなるのか?

管理者権限でログオンしているPCであれば、このプリンタ設定プログラムは何の問題もなく動く。それならばということで、ネットワークプリンタがデバイスとプリンターに表示されているAD環境下で、プログラムのアイコンを右クリックして表示される「管理者として実行」を試してみた。すると・・・

ComboBoxの選択肢からは、ネットワークプリンタが全部きれいに・・・

消えたー!!

いとをかし。
ローカルPCにログオンするカタチになるからなのでしょうか・・・?

そんなこんなで、①的アプローチは「今回は」あきらめることに決定。
でもまだ心は折れてないので、②「ワンクリックでデバイスとプリンターを表示する」にチャレンジ!

3.プログラムから「デバイスとプリンター」設定画面を呼び出し

Mr.XRAYさんのWebサイトに、そのものズバリの答えがありました!!

468_各種システム設定ダイアログ表示

http://mrxray.on.coocan.jp/Delphi/plSamples/468_ShowDialog_System.htm

さまざまなシステム設定ダイアログの表示方法の詳細を学ぶことができました。
またまたお世話になり、本当にありがとうございました!!

で、紹介されていたコードをワンクリック用に書き換えたものがこちら。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;  //基本的に必要なVCLはこれだけ
    EditPath: TEdit;  //確認用に置いてあるだけで絶対に必要なわけではない
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Winapi.ShellAPI, System.StrUtils;

{$R *.dfm}

//ワンクリックでデバイスとプリンターを表示する
procedure TForm1.Button1Click(Sender: TObject);
var
  RetCode : Integer;
  strList : TStringList;
  OrgCmd : string;
  EnvPath : string;
  strPath : string;
  CmdPath : string;
  CmdParam : string;

  //環境変数を含む(%等の文字を含む)を実際のパス名に変換
  function ExpandEnvironmentString(S: String): String;
  var
    LDstChar:array [0..MAX_PATH - 1] of Char;
  begin
    ExpandEnvironmentStrings(PChar(S), LDstChar, MAX_PATH);
    Result := LDstChar;
  end;

begin

  //コントロールパネルの「デバイスとプリンター」を表示
  strPath := '%SystemRoot%\System32\control.exe /name Microsoft.DevicesAndPrinters';

  //選択中のItems文字列を取得してコマンド文字列を作成
  OrgCmd := Trim(strPath);
  EnvPath := ExpandEnvironmentString(OrgCmd);

  //実行ファイル名とパラメータに分解
  strList := TStringList.Create;
  try
    strList.Delimiter := ' ';
    strList.StrictDelimiter := True;
    strList.DelimitedText := EnvPath;

    if strList.Count = 1 then
    begin
      CmdPath := Trim(EnvPath);
      CmdParam := '';
    end else begin
      CmdPath := Trim(strList[0]);
      CmdParam := Trim(StringReplace(EnvPath, CmdPath, '', [rfIgnoreCase]));
    end;
  finally
    FreeAndNil(strList);
  end;

  //パス名の空白までをパスと認識してしまうのでダブルクォーテーションで囲む
  //パラメータはそのままとする
  if Pos(' ', CmdPath) > 1 then begin
    if LeftStr(CmdPath, 1) <> '"' then begin
      CmdPath := AnsiQuotedStr(CmdPath, '"');
    end;
  end;

  //Pathを確認用に表示
  EditPath.Text := CmdPath;

  //ShellExecute
  RetCode := ShellExecute(Handle, '', PChar(CmdPath), PChar(CmdParam), nil, SW_SHOW);

  //エラー対策
  if RetCode <= 32 then begin
    MessageBox(Handle, PChar(SysErrorMessage(RetCode)), '情報', MB_ICONINFORMATION);
  end;

end;

end.
設計時の画面
実行時の画面(ボタンをクリックした直後の状態)
Button1クリックで、デバイスとプリンターの画面が表示された

Mr.XRAYさんのおかげで無事目的を達成することができた!
(もちろん、このプログラムが、AD環境下、一般制限ユーザーとしてログオンしている状態でも完全に動作することを確認)

・・・ということで、このButton1をクリックした時の手続きを、業務に使用するプログラムへコピーしてコンパイル、職場のネットワーク上に「新しい更新プログラムとして公開」すれば、クライアントPCのプログラムは自動更新されるように組んであるから、いちばん最初に夢見たカタチで、カンタン・明示的なプリンタ設定の変更が実現できる・・・。

4.まとめ

AD環境下で、自主開発した業務用ソフトウェアを操作する「PC操作にあまり詳しくない」ユーザーに「通常使うプリンタに設定」等の作業をお願いしなければならない時は、コントロールパネルの「デバイスとプリンター」の画面をワンクリックで表示できるプログラムを、その業務用ソフトウェア内に埋め込んで提供するのがいちばんイイ(・・・と今回の経験から僕は思った。あくまでも個人的感想です)

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Global And Local Variables

「グローバル変数とローカル変数」

ずっとDelphiを使ってきて、今回初めて「アレっ?」と思ったことがあり、そんなことも知らなかったの? って、バカな自分にあらためて驚愕したという、大変恥ずかしいお話。

1.代入済みの文字列型グローバル変数がなぜか空欄に
2.原因はすぐに判明
3.まとめ
4.お願いとお断り

1.代入済みの文字列型グローバル変数がなぜか空欄に

あるプログラムの中で、あるファイルまでのフルパスを入れておくグローバル変数を宣言した。

  private
    { Private 宣言 }
    strFilePath : string;

Button1をクリックしたら、あるファイルまでのフルパスを取得し、Button2をクリックしたら、そのプロシージャの中で取得済みのパスを使用するつもりだった。

実は、Button2側のプロシージャの中にも、Button1クリックで行ったのと同じ、あるファイルまでのフルパスの取得作業があり、既にButton1クリックで取得済みであれば、Button1をクリックした後、必ずButton2をクリックする設計なので、既に取得済みのパスがある場合は、そのまま使うコードでプログラミングした・・・はずだった。

コードを書いて、実行してみる。
順調に動き始めたように見える。

Button1をクリック。エラーなし。

Button1Clickでファイルまでのパスは取得済みだから、
Button2Clickではファイル選択のダイアログは出ないはず・・・

procedure TForm1.Button2Click(Sender: TObject);
begin
  ・・・略・・・
  if strFilePath='' then
  begin
    ・・・ファイル選択のダイアログを表示・・・
  end;
end;

Button2をクリック。
ファイル選択のダイアログが・・・表示・・・

される。

なんでー!?

取得済みのパスはどこへ消えた?

確認すると、Button2クリックの段階で、取得したはずのパスは、なぜか空欄に。

2.原因はすぐに判明

Button1Clickのプロシージャの先頭にある変数の初期化コード strFilePath:= ” を選択して、Ctrl+Fで検索を実行。で、ここにしか strFilePath:= ” が「ない」ことを確認。

続いて strFilePath だけを選択して再び Ctrl+F

全プログラムコード中にある strFilePath を1つずつ確認して行く・・・。

最優先されるのは、ローカル変数。で、Button1クリックの処理が実行されて、その処理が終わった時点で、Var宣言されたButton1Clickプロシージャ内でのみ有効なローカル変数は破棄される・・・。Google先生から教えてもらった「新」知識を胸に刻みつつ、検索を繰り返すこと、数回・・・

procedure TForm1.Button1Click(Sender: TObject);
var
  ・・・省略・・・
  strFilePath:string;
  ・・・省略・・・
begin

あ、れ?
ナンでこんなところにキミが!?

グローバル変数に、ローカル変数と同じ名前の変数があっても、ローカル変数から自動で代入なんかされない!!・・・ってコトを、今回初めて知りました。たぶん、変数をローカルに宣言した時は、何にも考えていなかったか、ローカル変数に入れた値がそのまま自動でグローバル変数に代入されるって思って(信じて)いたのでしょう。

つまり、グローバル変数の strFilePath は最初からずっと、空欄のまま・・・。

Var宣言の strFilePath : string。書いたのは、誰? はぁーい。ボクです。T_T

3.まとめ

似たような変数名を使いたい時は、例えばグローバル変数ならG_strFilePathのように最初に G_ を付け、ローカル変数なら最初は L_ から始めるとか、そういうほんのちょっとした自分自身との約束があれば起こるはずのないミスでした。今度からは、こんなことが起きないように気を付けたいと思います!

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

TDirectory.GetFiles Function

「特定ファイルの名称をフルパス付きで取得したい!」

例えば、特定のフォルダ内にある拡張子が「jpg」のファイルの名称と、そのファイルまでのフルパスをイッキに全部!取得したい・・・なんて場合の覚書。

1.特定のフォルダ内にあるJpeg画像名を全部取得
2.サブフォルダがあったらその中も探す
3.ListBoxに高速で項目を追加する方法
4.まとめ
5.お願いとお断り

1.特定のフォルダ内にあるJpeg画像名を全部取得

ある特定のフォルダにある拡張子が「jpg」のファイル全てについて、そこまでのフルパスを取得してListBoxに表示する方法は次の通り。

FormにButtonとListBoxを一つずつ追加して、以下を記述。

implementation

uses
  System.Types,
  System.IOUtils,
  System.StrUtils,
  System.Masks,
  Vcl.FileCtrl,
  System.UITypes;

  //System.TypesはTStringDynArrayを使うために追加
  //System.IOUtilsはTDirectory.TFilterPredicateを使うために追加
  //System.StrUtilsはSplitStringを使うために追加
  //System.MasksはMatchesMaskを使うために追加
  //Vcl.FileCtrlはSelectDirectoryを使うために追加
  //System.UITypesはMessageDlgを使うために追加

{$R *.dfm}

procedure TForm1.ButtonXClick(Sender: TObject);
var
  //フォルダの選択
  iStartFolder: string;
  iDirectories: TArray<string>;
  //ファイルリストの取得
  FileNames: TStringDynArray;
  strFileName: String;

  //ファイルを検索
  function MyGetFiles(const Path, Masks: string): TStringDynArray;
  var
    MaskArray: TStringDynArray;
    Predicate: TDirectory.TFilterPredicate;
  begin
    MaskArray := SplitString(Masks, ';');
    Predicate :=
      function(const Path: string; const SearchRec: TSearchRec): Boolean
      var
        Mask: string;
      begin
        for Mask in MaskArray do
          if MatchesMask(SearchRec.Name, Mask) then
            exit(True);
        exit(False);
      end;
    Result := TDirectory.GetFiles(Path, Predicate);
  end;
begin
  //フォルダを選択
  iStartFolder:=ExtractFilePath(Application.ExeName);
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
  begin
    FileNames:=MyGetFiles(iDirectories[0], '*.jpg');
    for strFileName in FileNames do
    begin
      ListBox1.Items.Add(strFileName);
    end;
  end else begin
    //確認(キャンセルされた時に何かしたい場合)
    MessageDlg('キャンセルされました', mtInformation, [mbOk] , 0);
  end;
end;

たくさんのファイルを扱う場合には、ファイルへのPathとそれぞれに異なるファイル名の処理がまず問題になるが、上記の方法を用いれば、用意したListBoxに指定した拡張子のファイルのみ、フルパス付きでリストが作成される。TListBoxを表示する必要がなければVisibleプロパティをFalseにしておけば、その存在はまったく気にならないし、あとは、使いたい時にItemIndexやItems.Countを参照するだけでOKだから、Pathとファイル名の取得についてはもうなぁーんにも気にすることがなくなり、非常に便利!

例えば、以下の通り。

  //ファイルの数だけLoopする
  for i := 0 to ListBox1.Items.Count-1 do
  begin
    ShowMessage(ListBox1.Items[i]);
  end;

2.サブフォルダがあったらその中も探す

上の例のTDirectory.GetFiles関数では検索する際、サブフォルダを無視しているが、引数の指定を次のように変更すれば、サブフォルダ内も検索できる。

procedure TForm1.ButtonXClick(Sender: TObject);
var
  //フォルダの選択
  iStartFolder: string;
  iDirectories: TArray<string>;
  //ファイルリストの取得
  FileNames: TStringDynArray;
  strFileName: String;
  //検索するファイルの拡張子を指定
  SearchPattern: string;
  //サブフォルダも検索
  Option: TSearchOption;
begin
  //初期化
  ListBox1.Items.Clear;
  //フォルダを選択
  iStartFolder:=ExtractFilePath(Application.ExeName);
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
  begin
    SearchPattern:= '*.jpg';
    //検索モード
    //Option:= TSearchOption.soTopDirectoryOnly; //指定フォルダ直下のみ
    Option:= TSearchOption.soAllDirectories; //サブフォルダ内も検索
    //指定拡張子のファイル名をフルパス付きで取得
    FileNames:= TDirectory.GetFiles(iDirectories[0], SearchPattern, Option);
    for strFileName in FileNames do
    begin
      ListBox1.Items.Add(strFileName);
    end;
  end else begin
    //確認(キャンセルされた時に何かしたい場合)
    MessageDlg('キャンセルされました', mtInformation, [mbOk] , 0);
  end;
end;

どうやらTDirectory.GetFiles関数はいろんな引数を指定できるらしい。
せっかくだから調べてみた。

System.IOUtils.TDirectory.GetFiles

https://docwiki.embarcadero.com/Libraries/Sydney/ja/System.IOUtils.TDirectory.GetFiles
以下、上記Webサイトより引用

class function GetFiles(const Path: string): TStringDynArray;
class function GetFiles(const Path: string;  const Predicate: TFilterPredicate): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string;  const Predicate: TFilterPredicate): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string;  const SearchOption: TSearchOption): TStringDynArray; overload; static;
class function GetFiles(const Path, SearchPattern: string;  const SearchOption: TSearchOption; const Predicate: TFilterPredicate): TStringDynArray; overload; static;
class function GetFiles(const Path: string;  const SearchOption: TSearchOption; const Predicate: TFilterPredicate): TStringDynArray; overload; static;

こんなにあったんだ。びっくり☆

もし、検索対象フォルダが決まっているのであれば、さらに簡単に・・・
(サブフォルダまで検索するか・どうかはOptionを切り替えて指定)

procedure TForm1.ButtonXClick(Sender: TObject);
var
  Path:string;
  SearchPattern:string;
  Option:TSearchOption;
  FileNames:TStringDynArray;
  FileName:String;
begin
  //初期化
  ListBox1.Items.Clear;
  //検索先のPathは指定
  Path:=ExtractFilePath(Application.ExeName) + 'Data';
  //ファイル名に一致する検索パターン
  SearchPattern:='*.jpg';
  //検索モード
  //Option:=TSearchOption.soTopDirectoryOnly; //指定フォルダ直下のみ
  Option:=TSearchOption.soAllDirectories; //サブフォルダ内も検索
  //ファイルのリストを作成
  FileNames:=TDirectory.GetFiles(Path, SearchPattern, Option);
  for FileName in FileNames do
  begin
    ListBox1.Items.Add(FileName);
  end;
end;

3.ListBoxに高速で項目を追加する方法

ファイルのリスト作成をより一層高速化するには、以下のようにリストをAddするfor文の前後にListBox1.Items.BeginUpdate / EndUpdateを入れると良いそうで・・・
(TListBoxのStyleプロパティがlbStandardの場合)

  ListBox1.Items.BeginUpdate;
  for FileName in FileNames do
  begin
    ListBox1.Items.Add(FileName);
  end;
  ListBox1.Items.EndUpdate;

あくまでもMyPC環境での値だが、1000枚のJpeg画像の名称を取得するのに、UpDate命令なしの場合が5回平均で120ms、UpDate命令ありの場合が同じく5回平均で17ms。

たった1000枚でこれだけの差。ファイルの数が増えれば増えるほど、その差が大きくなるのは自明の理。

これはTListBoxだけでなく、TMemo等のDelphiのコンポーネントに多数の項目を追加または変更する際に共通して起きる現象で、発生理由は、変更のたびに画面が再描画されるためとのこと。例えば、今回のようにListBoxに多数の項目を追加すると追加項目数分の再描画が発生し、項目数が多いほど処理時間が必要に。

そこでアイテムに変更を加える前に、 BeginUpdateを呼び出し、すべての変更が完了したら、EndUpdateを呼び出して変更を画面に表示するように指定すると画面の再描画が抑止され、処理時間は大幅に短縮される・・・ということで、大量の項目の追加・変更を行うときは忘れずにUpDate命令を使ったほうがよさそう。

ちなみにTMemoの場合であれば・・・

  Memo1.Lines.BeginUpdate;
  for i := 1 to 5000 do
  begin
    Memo1.Lines.Add('あいうえお');
  end;
  Memo1.Lines.EndUpdate;

つまり、BeginUpdateが画面更新の停止で、EndUpdateが再開ってことでいいのかな?
私はそんなふうに理解しました☆

4.まとめ

ある特定のフォルダ内にある、特定の拡張子を持つファイルのリストを作成したい場合は、TDirectory.GetFiles関数が便利。
取得したフルパス付きのファイル名はListBoxに入れておけば、ItemIndexやItems.Countを参照するだけで具体的な名前やPathを気にせずに使えてこれも便利。
ListBoxに大量に項目を追加する時は、BeginUpDateとEndUpDateを忘れずに使おう! というお話でした。

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

InputQuery Where Only Numeric Values Can Be Entered

「数値のみ入力可能なInputQuery」

ユーザーからの数値入力を受け取って動作するプログラムを作成した。このような場合には、以前からInputQueryを使用してきた(自前のDialogを作成したこともあった)が、今回、「数値だけ入力可能」なInputQueryを作成してみた。これは、その覚書。

1.入力をチェックして数値のみの入力を実現
2.MyInputQueryを作る
3.まとめ
4.お願いとお断り

1.入力をチェックして数値のみの入力を実現

Delphiでユーザーからの入力を受け取るプログラムを作る時、戻り値がString型のInputBox関数や、Boolean型のInputQuery関数を使う。僕はこれまでユーザーが「どのボタンを押したのか?」がはっきりわかるInputQuery関数を多用してきた(対し、InputBox関数ではデフォルトで設定しておいた文字列が返る)。

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret:string;
begin
  if InputQuery('InputQuery', '値を入力:', Ret) then
  begin
    //OKボタンがクリックされた時

  end else begin
    //キャンセルボタンがクリックされた時(ESCキーで閉じた場合もFalseになる)

  end;
end;
InputQuery実行時の画面

今回、多くの画像の印刷を実行するプログラムの中で、何ページめの画像を印刷するのか、ユーザーに指定してもらう必要があり、そこで、やはりInputQuery関数を利用した。

以前から、このようなシーンで「数値のみ入力可能」なInputQuery関数が欲しいなー、とずっと思ってきたんだけど、とりあえず、プログラムの完成を急ぎたくて、そのたびに、この問題は先送りにされてきた。 僕の中で、もう長いこと ずっと・・・。

Excel VBAで帳票印刷を行う時は、「ちゃっちゃ」っと次のようなFormを作成して

コード書いてないのにEnterキーでFocusまで移動する・・・

「ちゃっちゃ」っと次のコードを書いて・・・

Private Sub CommandButton1_Click()

    Dim PrintNo1 As Integer
    Dim PrintNo2 As Integer
    Dim i As Integer
    
    If UserForm1.TextBox1.Text = "" Then
        MsgBox ("開始番号を半角数字で入力してください。")
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If UserForm1.TextBox2.Text = "" Then
        MsgBox ("終了番号を半角数字で入力してください。")
        TextBox2.SetFocus
        Exit Sub
    End If
    
    PrintNo1 = UserForm1.TextBox1.Text
    PrintNo2 = UserForm1.TextBox2.Text
    i = PrintNo1

    For i = PrintNo1 To PrintNo2
        Range("A2").Select
        ActiveCell.FormulaR1C1 = i
        Range("B6:AB38").Select
    
        ActiveSheet.PageSetup.PrintArea = "$B$6:$AB$38"
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next i
    
    Range("A2").Select

End Sub

Private Sub CommandButton2_Click()
    'キャンセルボタンがクリックされた場合
    Unload UserForm1
    Exit Sub
End Sub

で、FormのTextBoxをクリックして・・・

TextBox1を選択

IME ModeプロパティをDisableに設定。

IMEは絶対利用できないようにDisableを指定

あとは実行!
サク・・・っと印刷して終わり。みたいな感じで、VBAならカンタンなんだけど、これをDelphiでやるとなると、全然できるんだけど、でも、ちょっと・・・めんどくさい。

今回も、「数値のみ入力可能なInputQuery」は(現時点で)実現できないから、とりあえず、ユーザーが入力した値をチェック(数値であるか・どうか)して対応してしまった・・・。

それが次のコード。

implementation

uses
  System.UITypes;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret: string;
  intNum: integer;
  //全角 -> 半角に変換
  Chr: array [0..255] of char;
begin
  if InputQuery('印刷', 'ページを指定', Ret) then
  begin
    //OKボタンがクリックされた時
    //全角->半角変換
    //全角だった場合は半角数字に変換、すでに半角のものは半角のまま
    //半角にできない文字、たとえばひらがな等は変換されない
    Winapi.Windows.LCMapString(
      GetUserDefaultLCID(),
      LCMAP_HALFWIDTH,
      PChar(Ret),  //変換する文字列
      Length(Ret)+1,  //サイズ
      chr,  //変換結果
      Sizeof(chr)  //サイズ
      );
      Ret := Chr;
    //数値であるかチェック
    if TryStrToInt(Ret, intNum) then
    begin
      //数値である
      j := StrToInt(Ret);
      //本当に使える数値か、さらにチェック
      if (j = 0) or (j > 印刷ページの上限値) then
      begin
        MessageDlg('入力された値は印刷できない番号です。'+#13#10+
        '処理を中止します。', mtInformation, [mbOk] , 0);
        Exit;
      end else begin
        // j の値を使って印刷実行
        ・・・ 省略 ・・・
      end;
    end else begin
      MessageDlg('入力された値は数値ではありません!'+#13#10+
        '処理を中止します。', mtInformation, [mbOk] , 0);
      Exit;
    end;
  end;
end;

まぁ、確かにこれで目的は実現できてるから、イイっちゃイイんだけど・・・。
なんか、スマートじゃない・・・気がして。
あと出しジャンケンみたいで・・・

そこで、今回だけは逃げずに自分と戦うことにしました☆

2.MyInputQueryを作る

とりあえずの目標はVBAでやったように、InputQueryのテキストボックスのIMEモードをDisableに設定すること。

Google先生に訊いたら、次の情報を教えてくれた。

Vcl.StdCtrls.TCustomEdit.NumbersOnly

https://docwiki.embarcadero.com/Libraries/Sydney/ja/Vcl.StdCtrls.TCustomEdit.NumbersOnly

Delphi2009からNumbersOnlyプロパティがTEditに実装されたとのこと。で、さらに、そのTEditを内部に抱えているInputQueryの正体については、次のサイト他で情報をGet!

InputQueryについて

https://www.petitmonte.com/bbs/answers?question_id=4867

どうやらいちばんの問題解決方法は、InputQueryのソースコードをそのままコピペして(挙動不審にならないように)名前を変更し、それぞれの目的が実現できるようにコードを修正することのようだ。

上記Webサイト他に掲載されていたInputQueryのコードを読むと、自分でもなんとかなりそうだったので、さっそくやってみることにした。

で、書いたのが次のコード(ほとんどコピペですが・・・)。

//Formのメンバーにはしていません。
//名前は MyInputQuery に変更
function MyInputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;

  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;

begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do begin
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;

        //Password入力用にInputQueryを使用するための設定(Password Mask)
        //EditコントロールではPasswordCharに設定した文字が
        //入力した文字の代わりに表示される(デフォルトは'#0')
        //パスワードマスクするなら
        //PasswordChar:= '*';
        //これでマスクしなくなる('#0'として文字列化しないこと)
        PasswordChar := #0;

        //Delphi2009からTEditにNumbersOnlyプロパティ(数字だけを入力可能にする)が
        //実装されているそうなので、せっかくだからTrueにしてみた!
        //全角文字の「123」も「数値である」と判断してくれます・・・
        NumbersOnly := True;

        //IMEは使用不可(この1行がどうしても書きたかった!)
        ImeMode := imDisable;

        //文字位置
        //Alignment := taCenter;
        Alignment := taLeftJustify;
        //Alignment := taRightJustify;

      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'OK';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'キャンセル';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
  end;
end;

このInputQueryをボタンクリックで呼び出します。

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret:string;
begin
  if MyInputQuery('Dialog Caption', 'Please Enter the number:', Ret) then
  begin
    ShowMessage('Entered: '+ Ret);
  end else begin
    ShowMessage('False!');
  end;
end;

上のコードを実行すると・・・

InputQueryのTextBoxではIMEモードは変更できない
Form上のEditコントロールではIMEモードの切り替えが可能

これで、ずっと夢だった「数値のみ入力可能な」InputQueryが完成しました☆
さらに工夫すれば、入力できる数値の範囲を制限したりすることもできると思います。

また、次のWebサイトではマウスポインタの近くにInputQueryを表示させるという技も紹介されていました。

.InputQueryのポップアップ位置

https://www.petitmonte.com/bbs/answers?question_id=6520

3.まとめ

数値のみ入力可能なInputQueryを実現するには、InputQueryのソースコードをコピペして、名前を変更したInputQuery関数(例:MyInputQuery)を作成し、その中でやりたいことを書いていけばイイということ。

ここでは、「IMEModeの設定」を主に、それに加えて「パスワードマスク、NumbersOnlyプロパティ、文字位置(Alignment)」等の設定を行ってみた。

4.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Mouse Down Event Usage Example

「MouseDownイベントの活用例」

手書き答案をスキャナーで読み込んで採点するプログラムを書いた。Gridコントロールへの入力に対し、各々の解答欄の画像に ○ や × や得点を表示できるようにしたら、合計点がなければ採点済み答案とは言えないコトに気付いた。でも、それを「どこ」に記入するかは答案ごとに違うし、採点ミスがあった場合は個別の修正に対応する必要もある。そこでMouseDownイベントが役に立ったというお話。

1.合計点はいつ・どこに書く?
2.画像に ○ や × それから得点も表示
3.「やっぱりココ!」に対応
4.まとめ
5.お願いとお断り

1.合計点はいつ・どこに書く?

多くの場合、それは答案の右上か、右下に書かれている。左上や左下、まして「ど真ん中」ってのはまず見たコトない・・・ケド。とりあえず、合計点を書く場所は、まったく採点者の自由で、法的に「ココじゃなきゃダメ」って、決められているなんて話は聞かない。だから、合計点を書く(プログラム的には「置く」の方がしっくりするが)場所は、採点者が「ココ!」ってクリックした位置にすることにした。100%自由ってステキ。

それから採点者も人間である以上、当然のように間違える。採点ミスがあれば、もちろん合計点も変わる。・・・ってコトは、PCと協働作業する以上、合計点の計算はPCに任せるからイイとして、それを答案画像に「二度と修正できない」カタチで「埋め込んで」しまうわけにはいかない。合計点は、返却用の答案画像を印刷するときに、「どっかから持ってきて」、答案画像の上に一時的に「置く」くらいがちょうどイイ。

・・・ということで、基本方針だけを決め、新しいチャレンジがはじまった!

2.画像に や × それから得点も表示

最初は正誤の表示(○と×)だけだったけれど、得点も表示することにした

上のような画面に、スキャンした答案画像から設問ごとにかき集めた解答欄を表示してイッキに採点する。上のように全員が同じ解答なら得点の一括入力も可能だ。採点が済んだら、読み込み元の答案画像とは別に用意した返却用の答案画像に、集めてきた時とは逆のアルゴリズムで書き戻す。

答案に書き戻してみたところ(もっとズレるかと思ったが案外ずれてない)

で、決定的に足りないモノがあることに気づく・・・。ここまでやって「合計点がない」というのは、仏作って魂入れず & 画竜点睛を欠く & ツメが甘い & 九仞の功を一簣に虧く 以外の何者でもない。日本語の豊かさに感動しつつ、もっと簡単な言い方をすれば、プログラムは、どう考えても不完全。元よりこれを売るつもりはまったくナイけど(買うヒトがいるとも思えない)、合計点が「出ない」採点プログラムなんて詐欺だ。

なにより、この答案は、なんだかさみしい・・・

恐るべし。合計点の存在感。

・・・ということで、合計点も入れることに。

3.「やっぱりココ!」に対応

StringGridに見えない列を1つ追加して、ここに計算した合計点を書き込んでおけばいつでも印刷に使える。合計点の計算そのものはカンタン。何も問題はない。

var
  i, j, k:integer;
begin
  //初期化
  k:=0;
  //合計点を計算
  for i := 1 to StringGrid1.RowCount-1 do
  begin
    for j := 1 to ( 解答欄の数 ) do
    begin
      if StringGrid1.Cells[j,i] <> '' then
      begin
        k := K + StrToInt(StringGrid1.Cells[j, i]);
      end;
    end;
    //StringGrid.Cells[, ]
    StringGrid1.Cells[( 解答欄の数 ) + 1, i]:= IntToStr(k);
    //初期化
    k:=0;
  end;

これで合計点の準備はOK!
あとは「いつ」印刷するか・・・ってか、採点ミスがあった時、カンタンに合計点も修正できるようにしなければならない。これは結構、難しい。合計点を答案画像に画像データとして埋め込んでしまうと、まず修正はできない。どぉーするか・・・

よく考えたら(よく考えなくても)、この解答用紙には合計点を記入する場所すらない。まぁもともとがマークシートで、そこに無理やり手書き用の解答欄を付け加えたのがほんとうだから、ないのが当然なんだが。

こうなったらもう、面倒なことは全部やめて、答案画像を印刷する直前に、採点者が適当に「ココ!」ってクリックした場所に合計点を置いて、印刷はするけど、その後、画像は保存しない仕様で行こう。

印刷日が異なると、ビミョー(ヒトによっては大きく)に合計点印刷位置がズレる・・・という問題?は、「気にしない」ことにしよう。法的には何の問題もない。返却された答案に合計点が「ある」ことが大切なのだ。

フォントの大きさは、得点入力のところで使った指定をそのまま使えばイイ。

FontのSizeは50

これでアルゴリズムは決まり。あとは採点者に「ココ!」って指定してもらうプログラムをDelphiで書くだけ。でも、その「ココ!」はきっと、やっぱりもぉちょっと上とか、左とか、位置指定をやり直したい場合が絶対あるよなー。どぉするか・・・

TImageの上でマウスのボタンを押すたびにMouseDownイベントが起こるから、コレをうまく活用すればイイ。きっとそれだなー。で、書いたのがコレです。

合計点を印刷したい場所をクリックするとサンプル99を表示
procedure TFormCollaboration.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  //表示倍率
  rate:Double;
  ・・・ 省略 ・・・

  //普通の四捨五入を行う関数を設定
  function Roundoff(X: Extended): Longint;
  begin
    if x >= 0 then Result := Trunc(x + 0.5)
              else Result := Trunc(x - 0.5);
  end;

  //合計点印刷位置の座標を取得する手続き
  procedure GetXY(iX,iY:Integer);
  begin
    //合計点印刷位置の座標を取得
    iX:= Roundoff(iX/(TrackBar1.Position/100));
    iY:= Roundoff(iY/(TrackBar1.Position/100));
    //表示倍率を計算(答案画像は縮小してWidth1000にセットしている)
    rate:= 1000/Image1.Picture.Bitmap.Width;
    合計点のX座標:= Trunc(iX/rate);
    合計点のY座標:= Trunc(iY/rate);
    //矩形を描画
    with Image1 do
    begin
      //Canvas.Brush.Style:= bsClear;  //Pythonを使っていない時はこれでOK!
      //Pythonを使っている時は明示的に書く(Python.pasにもbsClearが定義されている)
      Canvas.Brush.Style:= Vcl.Graphics.bsClear;  
      Canvas.Pen.Color:=clRed;
      Canvas.Pen.Width:=3;
      //矩形を描画
      (サンプル99はLabelのCaption).Font.Size:=StrToInt(ComboBox.Text);
      Canvas.Rectangle(合計点のX座標, 
                       合計点のY座標, 
                       合計点のX座標 + Label.Width, 
                       合計点のY座標 + Label.Height);
      //サンプル合計点を描画
      Canvas.Font.Color:=clRed;
      Canvas.Font.Size:=StrToInt(ComboBox.Text);
      Canvas.TextOut(合計点のX座標, 合計点のY座標, Label.Caption);
    end;
  end;

begin
  //座標を指定する手続きを呼び出し
  GetXY(X,Y);
  //Information
  if MessageDlg('印刷位置は、この位置でよろしいですか?' + #13#10 + #13#10 +
    '(左寄せ・数字はサンプル。矩形は印刷されません。)', 
    mtInformation, [mbYes, mbNo], 0) = mrYes then
  begin
    //[はい]が選ばれた時
    //案内
    MessageDlg('印刷ボタンをクリックしてください。', mtInformation,[mbOK],0);
    //バルーンヒントを表示
    BalloonHint1.Title := '印刷ボタン';
    BalloonHint1.Description := 'ココです!';
    BalloonHint1.HideAfter := 3000; //表示時間(単位:ms)
    BalloonHint1.ShowHint(button.ClientToScreen(CenterPoint(button.ClientRect)));
    //案内アイコンも追加
    BalloonHint1.ImageIndex := 0;
    //カーソルを元に戻す
    Screen.Cursor:=crDefault;
    Image1.Visible:=False;
    Image1.Picture.Assign(nil);
    //SetFocus
    button.Enabled:=True;
    button.SetFocus;
  end else begin
    //[いいえ]が選ばれた時
    with Image1 do
    begin
      //Canvas.Brush.Style:=bsClear;  //Pythonを使っていない時はこれでOK!
      //Pythonを使っている時(Python.pasにもbsClearが定義されている)
      Canvas.Brush.Style:=Vcl.Graphics.bsClear;  
      Canvas.Pen.Color:=clWhite;
      Canvas.Pen.Width:=3;
      //矩形を描画
      (サンプル99はLabelのCaption).Font.Size:=StrToInt(ComboBox.Text);
      Canvas.Rectangle(合計点のX座標, 
                       合計点のY座標, 
                       合計点のX座標 + Label.Width, 
                       合計点のY座標 + Label.Height);
      //サンプル合計点を描画
      Canvas.Font.Color:=clWhite;
      Canvas.Font.Size:=StrToInt(ComboBox.Text);
      Canvas.TextOut(合計点のX座標, 合計点のY座標, Label.Caption);
    end;
  end;
end;

ユーザーが「ココ!じゃない」=「いいえ」を選択した場合は、サンプルとして表示した合計点を消去しなければならない。Undoの実装方法をいろいろ調べてみたのだが、よくわからない。で、思いついたのが上の方法。「いいえ」が選択された場合は、サンプルを「赤」じゃなくて「白」で書いちゃう。正直、完全に消えるわけじゃなくて、なぜか、よく見るとうっすらと赤が残っているけれど、気にしない。これで全然イケます。

合計点も印刷できるようになりました!

【追記 20221003】

合計点はサンプル「99」ではなく、個々の合計点を取得して表示できるよう、プログラムを修正しました。下のリンク先をご参照ください。

4.まとめ

そこにTImageがあれば、彼はいつでも OnMouseDown を待ち続けているから、このイベントをうまく利用すれば、再帰的な処理(?)が実現できてしまう。画像として保存したくは「ない」んだけれど、印刷時には「ちょっとイジりたい」時にはこんな方法もあります・・・というお話でした。

5.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

To Be Broken

その一瞬で、君に夢中になったんだ。
今でも、忘れない・・・。
初めて君を見た、あの日。

あれから、もう20年が過ぎた。

カタログを手にしただけでうれしかった。
毎晩、何度も、眺めた。

思い出のカタログは、今も、手元にある。

開発責任者を務めた湯川伸次郎さんが、『2002年、「奇跡の名車」フェアレディZはこうして復活した』(講談社+α新書)を出版してくださった。

こんなすごい、ハードカバーのカタログが、タダで、何冊ももらえた理由を
ずっと知りたかった僕は、湯川さんの本を、即日、入手して読んだ。

命を削るような苦悩の中で、湯川さんがご自身と戦ったことを初めて知った。
僕の中で、謎だったことは、全部、「感謝」に変わった。

Yearモデルを出すってことすら、とてつもなく大変なことだったんだ・・・。
僕はずっと、ドキドキしていただけ・・・だった・・・のに。

振り返れば、僕のクルマ人生は NISSAN とともにあった。
初めて乗ったクルマは Skyline Japan(譲ったトモダチが今も乗ってる)。
その後の430セドリックも、思い出は深いけれど・・・、

人生の1/3をともに過ごした z33 は、「最高のパートナー」。
彼女は酔って吐いたりしてたけど、それは僕の運転のせい。

君のカタチは「スポーツカー」の Rule そのもの。でも、その輝きは・・・ 違ったんだ。

Rule is existing.
それに頼りそうになる時もあるけど・・・

君が教えてくれた輝きは・・・
To Be Broken.

君こそが・・・
Best of The Best.

z33
いつも、君と。

今も・・・
そして、 いつまでも。

風の中 君を探して

きれいな空
夏を忘れたみたいに
空気が乾いてる・・・

今日は風になりたいって、思った。
16の頃から、ずっと
憧れていた 風に。

だから握った Key は、z33 じゃなくて
古いバイクの Key.

若かった あの日。
KAWASAKI が創ってくれた ・・・
夢をカタチにしたようなオートバイ。

30年が、一瞬のように過ぎてしまって
今があるけれど・・・
夢のカタチは、何にも変わらない。

もう、ラインアップされることのない
空冷4気筒DOHCエンジンの咆哮が
僕は、たまらなく好き・・・。

きらめく 風の中
君を 探して ・・・