フローティングパネル | Object Pascalと僕と

浮かんだままがいいときもあったりして！

【もくじ】

１．フローティングパネル
２．ドッキングさせたくない
３．メモリが解放できない
４．メモリが解放できた（その１）
５．メモリが解放できた（その２）
６．まとめ
７．お願いとお断り
８．【追記】

１．フローティングパネル

手書き答案の採点プログラムで、常にフォーム上に浮かべたまま、自由にその位置を変更可能な、作業補助用のGUI（フローティングパネル）が欲しくなった。

前回、縦書き答案の採点用に作成した横スクロールのフローティングGUIはControlBarの上にToolBarを置いて、その上にToolButtonやBevelを並べたけれど、今回はその名の通り、ベースとなるVCLはTPanelを選択。この上に効率よく採点作業を行うために最低限必要なButton他を置いて、ユーザーの視線やマウスの移動量を極めて限られた範囲に限定。操作に払う注意とストレスをできるだけ軽減して、より快適な作業環境を実現したい･･･。

そう考えて作成したGUIがコレ。

画面をタッチして操作することも考え、各Buttonの高さは44ピクセルに設定。
これを設問毎に、答案画像から切り抜いた画像を並べて表示したTImageのとなりに表示する。

フローティング状態だとTPanelの上に「閉じる」ボタンのあるタイトルバー？（キャプションバー？）が表示される。この部分をクリックして、そのままドラッグすれば、TPanelをForm上の任意の位置へ移動できる。ただし、Formにドッキング（FormのDockSiteプロパティをTrueに設定）した瞬間、タイトルバー？はかき消されたかのように消えてしまう･･･

Formにドッキングしない状態ではPanelの上部にタイトルバーのようなものが表示される

以前作った（縦書き答案の採点を効率よく行うために左右方向のスクロールを行う）ドッキング・コントロールは、ドラッグ＆ドロップでFormにドッキングするように設計。必要であれば、Bevelをクリックしてそのままドラッグすることでドッキングを解除。任意の位置へ移動できる仕様とした。そんなに頻繁に位置を変更するようなモノでもなかったし。

ところが、今回はFormにドッキングさせると、いろいろ不都合が起きることが判明。

例えば、解答欄の大きさ（特に幅）に合わせて、この入力補助Toolの位置を頻繁に変えるような場合、クリックしてそのままドラッグできる「タイトルバー（キャプションバー）」がないと極めて不便。Formにドッキングした瞬間にこれが消えてしまうと、掴みどころがなくてほんとうに困るのだ。

Formにドッキングして、掴みどころがなくなった状態（フローティング**してない**パネル）

それから、Formへドッキングしている状態から、引きはがしてフローティング状態になるときの挙動がとにかく急で！うまく文字に表現できないのだけれど、感覚的には「うわっ」て感じ。GUIをクリックした瞬間に、「びっくりして飛び起きる」イメージでフローティングするのだ。

（数学風？に言えば、GUI上のクリックした位置が、GUIの左上の座標原点（0,0）の位置になるように、Button等のコントロールを載せているPanelの左上隅が瞬時にクリックした位置へ移動する）

また、最初の解答欄を表示している場合、１つ前に戻る「◀」ボタンはEnabledプロパティをFalseに設定し、クリックできないようにしてあるが、この Enabled:= False 状態のボタンをクリックすると上で述べたGUIが「びっくりして飛び起きる」ように瞬間移動する現象がおきてしまう。

さらに（原因はわからないけれど）、縦書き答案の採点時にFormにドッキングさせると、解答欄の表示が部分的にずれて二重に表示されてしまう（ドッキングさせなければ、この現象は起こらない）。

あれや、これやで、どぉーにもドッキング時の挙動が気に入らない。

じゃあ、
ドッキングさせなければいいじゃん！

･･･

そのとおり･･･

そのとおり、なんだけど･･･

そうすると･･･　コレが　･･･

コレが･･･　どぉーしても　消えなくて･･･

T_T

２．ドッキングさせたくない

メモリーリークの原因はわかってる。フローティングさせたTPanelをドラッグし始めた時に発生するStartDock手続きでCreateしているTToolDockObjectだ。

procedure TFormXXX.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  DragObject:= TToolDockObject.Create(Sender as TPanel);
end;

実は、これがなくても、フローティング動作は出来る。出来るんだけど、見た目に問題があって、高解像度画面で表示倍率を200％拡大のように設定している場合、ドラッグ（＝移動）中は灰色の枠だけのフローティングパネルのゴースト？が現れる。（画面のハードコピーがうまくとれなかったので）ゴースト？は、次の図のような感じ。

ドラッグ時に現れるフローティングパネルのゴースト？
（これは練習用に作ったプログラムの実行時画面）

そして、このゴーストが目に痛い感じでちらつきながら移動する。さらに困ったことに、ドラッグ中はフローティングパネルの本体（ゴースト？でない方）は表示されない。ドラッグしてドロップした瞬間に、まるでテレポーテーションしたかのように（突如として）ドロップした位置にパネルが出現するのだ。

ただし、メモリーリークは起きない。
（なんにもCreateしていないから、起きるわけがない）

一方、メモリーリークを起こすとわかっていても、ドッキング可能なコントロールのドラッグ操作を専門的に管理するTToolDockObjectをCreateして動かすと、動きがたいへんスムーズ！気持ちイイ☆

だから、どうしてもドッキングさせたくない！
フローティングさせたまま、使いたい！！

  DragObject:= TToolDockObject.Create(Sender as TPanel);

そうなると、この１行はどうしても削れない･･･。

ただし、裏側では「メモリーリーク」がフローティングさせたパネルをドラッグする（＝位置を変える）度に、発生･･･

表面的には何事もなく、静かなんだけど。

３．メモリが解放できない

解決策はただひとつ。

ドラッグが終了した時点で、StartDock時に確保したメモリを解放すればいい。

ところが、FormのDockSiteプロパティがFalseのままだと
それが、どうにも、こうにも、難しい･･･

ちなみに次のように書いてみたんだけど、上の条件下では、これは、どうやら無効！！！のよう。

procedure TFormXXX.FormDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
begin
  if IsDragObject(Source) then
  begin
    Source.Free;
  end;
end;

procedure TFormXXX.FormDockOver(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
begin
  Accept:=IsDragObject(Source);
end;

OnDockDropは、「別のコントロールがコントロールにドッキングした際に発生」つまり「DockSite が True の際にのみ、発生する」ということで、そもそもFormのDockSiteプロパティは意図的にFalseに設定してあるんだから、OnDockDropイベントが起きるわけがない。

OnDockOverもおんなじで、「DockSite が True の際にのみ、発生する」とのこと。１００万回ドラッグしようとFormのDockSiteプロパティがFalseである限り、OnDockOverイベントも絶対に起きない。

ダメ元で、OnDragDrop手続きと、OnDragOver手続きを作成して上と同じコードを書いてみたんだけど、手続きの引数をよく見たら･･･

procedure TFormXXX.FormDragDrop(Sender, Source: TObject; X, Y: Integer);

Sourceが、TDragDockObjectじゃなくて、TObjectになってる･･･。ってコトは、こっちで受け取るためには、型キャストが必要ってコト？なのかなーって思いつつ、FormのDockSiteプロパティをFalseに設定したまま、型キャストなしで次のコードを書いてみたが、Panelをドロップしても反応がない。どうやら、この２つのイベントは、FormのDockSiteプロパティがFalseだとTToolDockObjectのドロップに対しては発生しないようだ。⇦ 間違いだったら、ごめんなさい！

procedure TFormXXX.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if IsDragObject(Source) then
  begin
    Source.Free;
  end;
end;

procedure TFormXXX.FormDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := IsDragObject(Source);
end;

その他、FormのDockSiteプロパティをFalseに設定したまま、フローティングさせたPanelをドッキングさせずにドロップ時にメモリを解放する方法はないかとさんざん悩んだが、解決策が見つからない。まさに七転八倒。終いには、ナニをどういじったらそうなったのか、自分でもわからないのだけれど、フローティング状態のパネルをクリックしただけで一般保護違反のエラーが出るようになり、元に戻せなくなってしまった･･･。

フローティング部品がない状態のバックアップをとっていて、ほんとうによかった。

【これが間違いであっても、前に進むために出した、自分なりの結論】

TToolDockObjectを使いたいならOnDockDropとOnDockOverイベント側で、ドラッグ＆ドロップを受け取るしかない。

４．メモリが解放できた（その１）

何かをCreateして使うプログラムを書くとき、FormCreate時に、次のようにメモリーリークがあれば検出する設定を僕は付け加えることに決めている。多数の画像を読み書きする答案処理のプログラムを書いた際に、Createしたオブジェクトの解放を書き忘れ、あとからCreateしている箇所を全部点検することになった「痛い経験」から学んだ予防的措置だ。

procedure TFormXXX.FormCreate(Sender: TObject);
begin
  //メモリーリークがあれば検出
  ReportMemoryLeaksOnShutdown:=True;
end;

メモリーリークがあった場合、実行（F9）したプログラムを終了させると（メインフォームを閉じると）、次の画面がリークを起こした回数付きで表示される。

丸１日がんばって、（この方法じゃダメなんだ）ということがはっきりわかったところで、少し休もうと思い、ベッドに倒れて･･･そのまま、眠ってしまったようだ。

なんにも考えない時間が数時間あって･･･

目覚めたのは日付が変わる直前。眠って疲れがとれたからか？その原因はわからないけど、目覚めた瞬間に、あることを思いついた。それは何かと言うと･･･

FormのDockSiteプロパティをTrueに設定すれば、OnDockDropとOnDockOverの２つのイベントが間違いなく？ Panelのドラッグ＆ドロップに反応してくれるから･･･

ドラッグしてるときだけ、FormのDockSiteプロパティをTrueに切り替えて、ドロップした瞬間の位置座標を取得し、そこへPanelをManualFloatさせて、最後にメモリを解放、DockSiteプロパティをFalseに戻せばいいんじゃない？ってこと。

いろいろ実験的に書いていて（プロパティをあちこち変更）、設定忘れがあると困るので、ドラッグ開始時、コードの中でFormのDockSiteプロパティをTrueに設定。

procedure TFormXXX.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  //これでちらつかなくなった
  DragObject:= TToolDockObject.Create(Sender as TPanel);
  //設定し忘れないための予防的措置
  if not FormXXX.DockSite then
  begin
    FormXXX.DockSite:=True;
  end;
end;

ドロップ時のOnDockDropイベントは･･･

procedure TFormXXX.FormDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
var
  r:TRect;
begin
  if IsDragObject(Source) then
  begin
    r.Left:=X;
    r.Top:=Y;
    r.Right:=X+PanelX.Width;
    r.Bottom:=Y+PanelX.Height;
    PanelX.ManualFloat(r);
    //解放
    Source.Free;
    if FormXXX.DockSite then
    begin
      FormXXX.DockSite:=False;
    end;
  end;
end;

FormのDockSiteプロパティはFalseに設定。

実行（F9）して、フローティングパネルをドラッグ＆ドロップ。ちょっと気になったのはドロップ時のManualFloat(r)時の挙動。ドロップした場所でなく、ドロップ時にマウスポインタのカーソルがあった位置へ移動して表示されてしまう。次の画像の上がドロップ時、下がマウスの左ボタンを離した際にフローティングパネルが表示される位置。

マウスのカーソル位置を取得しているから、パネルのドロップ位置から少しずれて表示される。

ドロップ時、XにはPanelのLeftの値、YにはPanelのTopの値を取得するよう、プログラムを修正。


    r.Left:=PanelX.Left;
    r.Top:=PanelX.Top;
    r.Right:=r.Left+PanelX.Width;
    r.Bottom:=r.Top+PanelX.Height;
    PanelX.ManualFloat(r);
    //解放
    Source.Free;

これで表示位置に関する問題は解決できたが、今度は表示される際の挙動が気に入らない。ドロップ位置でPanelの画像が一瞬、最小化され（閉じるボタンだけになり）、それから全体が表示されるので、ドロップするたびにPanelが１回点滅するように見えるのだ。

それはそれで何とかするとして、いちばん何とかしなきゃいけないのはメモリーリーク。

恐る恐るプログラムを終了。

DelphiのIDE画面だけが表示され、リークの警告画面は出ない！
ようやく問題を解決できた･･･。

ただし、一難去ってまた一難。
表示方法を何とかしなきゃ･･･

５．メモリが解放できた（その２）

点滅の原因はわかっている。ドロップ時の ManualFloat(r) だ。

  DragObject:= TToolDockObject.Create(Sender as TPanel);

メモリーリークは起きるけど、上の一行だけでフローティングさせ、ドラッグ＆ドロップしている時は点滅なんてしなかった。要は ManualFloat させなければいいのだ。

（かならず、解決方法はある）

そう信じて、OnStartDockイベントの手続き部分でShift＋Ctrl＋1、OnDockDropイベントの手続き部分でShift＋Ctrl＋2を実行して、Ctrl＋1、Ctrl＋2でそれぞれの手続きへ移動できるように設定。

２つの手続き間を行きつ戻りつしながら解決方法を考える･･･

どう考えてみても、OnDockDropイベント側でなんとかするのは無理そう･･･

TToolDockObjectをCreateして移動させてる時は、ドロップ時に点滅しなかった･･･

表示された位置も、ドロップした場所だった･･･だから、ManualFloat は不要？

確保したメモリを最後に解放すれば、メモリーリークは起こらない･･･

『最後に解放』？

そうだ「 try　･･･　finally　･･･　end; 」があった。

プロシージャを思った通りに書き換える。

procedure TFormCollaboration.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  DragObject:= TToolDockObject.Create(Sender as TPanel);
  try
    if not FormXXX.DockSite then
    begin
      FormXXX.DockSite:=True;
      Application.ProcessMessages;  //おまじない
    end;
  finally
    DragObject.Free;  //メモリの解放
  end;
  FormXXX.DockSite:=False;
end;

実行（F9）

フローティングパネルは快適に移動し、ドロップ時の挙動もごく自然･･･

祈りながらFormをClose.

見慣れたIDEだけが現れる。

メモリーリークは起きてない。

やっと、思っていたとおりの･･･プログラムになった？

･･･ってか、ちょっと待て。オレ、OnDockDrop手続きの ManualFloat 消してないぞ。

もしかして･･･ OnDockDrop手続き呼ばれていないんじゃないか？

自分の書いたプログラムを、もう一度、よく読んで考える･･･

  DragObject:= TToolDockObject.Create(Sender as TPanel);
  try
    if not FormXXX.DockSite then
    begin
      FormXXX.DockSite:=True;
      Application.ProcessMessages;  //おまじない
    end;
  finally
    DragObject.Free;  //メモリの解放
  end;

DragObject を、最後に Free してるから、ドロップ時にはもう TToolDockObject は消えてる･･･。
消えてるんだから･･･　もう、『ない』んだから、呼ばれてないんじゃなくて･･･

OnDockDropイベントは起こらない！

･･･ってコトは、もしかして

DragObject:= TToolDockObject.Create(Sender as TPanel);
try
  //何もしない
Finally
  DragObject.Free;
end;

Createして、Freeするだけで

よかったの？

６．まとめ

今回の状況を何かに例えるならそれはナニ？って、生成AIに訊ねたところ、

　“Still waters run deep”

そう答えてくれました。深く、静かに、感動。

７．お願いとお断り

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

８．【追記】

  finally
    //DragObject.Free;  //メモリの解放のみ->インスタンス（オブジェクトの実体）はあるので参照可能
    FreeAndNil(DragObject);  //インスタンスも消える！
  end;

.Freeでなく、FreeAndNilすると、何もしなかったコトと同じになってしまいます。
注意してください！！