∵ なぜならば

映画とかネットとかパソコンとかコミックとか音楽とか……

自分自身の全身が見えているのか

2023-10-01 16:07:55 | Delphi

ちょっと必要があって書いてみたんだけど

もしかしたら他に方法があって車輪の再発明かも知れない

procedure TForm1.Timer1Timer(Sender: TObject);
  function IsShowFullBody:Boolean;
    function IsShowForm(P:TPoint):Boolean;
    var
      PosHandle:HWND;
    begin
      PosHandle:=WindowFromPoint(P);
      Result:=Handle=PosHandle;
    end;
  begin
    Result:=(IsShowForm(Point(Left+1,Top+1)))and
            (IsShowForm(Point(Left+1,Top+Height-1)))and
            (IsShowForm(Point(Left+Width-1,Top+1)))and
            (IsShowForm(Point(Left+Width-1,Top+Height-1)));

  end;
begin
  if IsShowFullBody then Caption:='IsShowFullBody' else Caption:='No';
end;

#真ん中だけ隠れてたら False 返しちゃうぢゃん(T▽T)当たり前だけど


今更 Abort

2023-08-16 16:23:16 | Delphi

普段 Abort 手続き自体使うことは無かったんだけどオリジナルで使っていたから調べてみたら何十年も思い違いをしていた
(というのを何年か前に調べてたんだけど記録してないから忘れてた)

Abort 手続き
Abort は,エラーを報告せずに処理を終了します。
Abort は,特殊な「サイレント例外」を生成します。サイレント例外は他の例外(EAbort)と同じように動作しますが,「サイレント例外」の場合,エンドユーザーにはエラーメッセージは表示されません。Abort は,try .. finally ブロックの最後に制御を移します。

というDelphi5 時代のヘルプを読んでいたので単純に exit と同じような扱いだと思っていたら普通に「Delphi abort Exit 違い」ってサジェストがあった

TMemo と TSpeedButton (新規作成 NewDocumentSpeedButton)一個ずつのテスト

  private
    { Private 宣言 }
    function QuerySaveDocument:Boolean;
    function SaveExecute:Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Modified:=False;
end;

function TForm1.QuerySaveDocument: Boolean;
begin
  Result:=False;
  if Memo1.Modified then
  begin
    case MessageDlg('現在編集中の文書を保存しますか?', mtWarning, mbYesNoCancel, 0) of
      mrYes   :Result:=SaveExecute;
      mrNo    :Result:=True;
      mrCancel:Abort;//※1 ここが mrCancel:exit; だと例外は起きずQuerySaveDocumentを抜けるだけ
    end;
  end else Result:=True;
end;

function TForm1.SaveExecute: Boolean;
begin
  Result:=True;//本当は保存処理
end;

procedure TForm1.NewDocumentSpeedButtonClick(Sender: TObject);
begin
  QuerySaveDocument;
//  if not QuerySaveDocument then exit; が必要だと思っていたが
  Memo1.Lines.Clear;//Cancel:Abort だとこの行は実行されない(例外発生)
end;

end.


※1 の時点で例外(Abort)が起こっているのでサイレントで無い普通の例外の場合を考えると処理されないのは当たり前だった
(ここで「エラーメッセージ」が出るはず)

情けない

 

いやでもやっぱり「保存します(Yes)」を選んでそこで「名前をつけて保存」的なモノをユーザがキャンセルしたら?
ああ function SaveExecute の方もセーブしなかった時に Abort すればいいのか
いやいやそれはそれで管理しにくいんじゃないか?
Abort は Abort で基本押さえておいて
if QuerySaveDocument then
にしておいた方がいいか

難しい

 

結局グデグデじゃねーか


const の呪縛

2022-07-07 20:58:07 | Delphi
function OpenFile(const Path: TFileName):Boolean;
という関数がオリジナルの時から存在する(中身は結構肥大化させてしまった)
おいらは普段(邪魔くさいので)const はつけないんだけどまあついてるモノをわざわざ外したりはしない

FFileName は現在開いているファイル名が入っているグローバル変数(FFileName: TFileName;)
これもまたオリジナルソースからある

OpenFile(FFileName);で現在開いているファイルを開き直す

これだけなら問題は無いんだけれど
多重起動で同じファイルを開く + 上書き禁止にする などの諸条件が加わった時アプリケーションエラーとなる
ソースを追っていくと
CompareText 関数→の中で使われている UpperCase や LowerCase の基本関数で例外が出てて Delphi がヘニョヘニョ状態になってる
もうここだけで二週間くらい悩んでた

んでタイトルの通り const が問題だったようで
OpenFile 関数の中でグローバル変数 FFileName を空にしたり開くことが確定した時にファイル名を代入していたため
静かなアクセス違反が溜まっていく
const は「Path」にかかってるので
Path:= とか直接さわるときだけの制限だと思っていたが
Path として渡された中身が実は FFileName だと気づいてしまう時に不整合を起こしてしまうのか
まるで AI がアンビバレンツで機能停止してしまう話みたいだ

一旦他の変数に入れて呼び出すか
S:=FFileName;
OpenFile(S);

引数の const を外せば問題ない
function OpenFile(Path: TFileName):Boolean;

まあそんな感じの制限もあるのかなという結果ではある

それでも
OpenFile(FFileName);
この関数を単体で呼び出すだけではエラーが起きなかったのが最後までわからない
そっちでも不具合あったのならもっと早く解決してたのに

そのキーはプログラムに予約されています

2022-04-10 09:00:31 | Delphi


キー割り当てダイアログでユーザーが使えないキーを知らせるのにどうやっていたっけって
NanaTerry のソース調べたら「おいら天才じゃね?」ってなった

Action 一つ作って Create 時に登録しておいたら HotKey でキー押した時点で横取りしてメッセージを出す

SecondaryShortCuts.CommaText はカンマテキストでいくつでも登録出来るから今回作ったソフトでは
    for i:=0 to 9 do
      SecondaryShortCuts.CommaText:=SecondaryShortCuts.CommaText+','+
        'Ctrl+'+IntToStr(i)+','+'Shift+Ctrl+'+IntToStr(i);

Ctrl+0 ~ Ctrl+9 と Shift+Ctrl+0 ~ Shift+Ctrl+9 まで一気に追加した

結論:やはりソースは読むもんだ

2021-12-22 22:09:27 | Delphi
NanaTerry はオリジナルからの流れで Window のドッキングを JVCL に任せている
ググっても英語かロシア語中国語で結局欲しい情報に行き当たらなかったりする

今回はドッキングした状態ではサイズを変えられないようにしたかったので
各々の Constraints を変えればいいと高をくくっていたところ上手くいかなかった

んで JvDockControlForm.pas から JvDockSupportControl.pas に飛んだら Splitter を生成してて
そこにはちゃんと OnCanResize イベントがあったので制御することが出来た
最初は例の type ごまかしで protected メソッドにアクセスしたりして苦労したんだけど
そんなにたいした問題でも無かった


FixedSize:Boolean;//サイズ固定

procedure TNanaMainForm.SplitterCanResize(Sender: TObject; var NewSize: Integer;
  var Accept: Boolean);
begin
  if FixedSize then Accept:=False;
end;

procedure TNanaMainForm.FormCreate(Sender: TObject);
begin
  with JvDockServer do
  begin
    Splitter[JvDockControlForm.dpRight].OnCanResize:=SplitterCanResize;
    Splitter[JvDockControlForm.dpLeft].OnCanResize:=SplitterCanResize;
    Splitter[JvDockControlForm.dpTop].OnCanResize:=SplitterCanResize;
    Splitter[JvDockControlForm.dpBottom].OnCanResize:=SplitterCanResize;
  end;
end;

正規表現ライブラリ SkRegExp

2021-11-13 16:54:07 | Delphi
NanaTerry で正規表現検索がおかしいと娘からクレームが入った

.(な|無)く
で検索して

それが無くなって
ン無くなって
らなくなるよ
が無くなって

↑の一つもヒットしない
.(な|無)
.(な|無)く.

とかならおk

まず秀丸や https://regex101.com/ で実際にヒットする事を確認後
自分が余計なことをやらかしてるのを前提にソースを確認したがわからない
最小限のコードで確認する
正規表現エンジンの SkRegExp ソースを読む
https://ht-deko.com/tech053.html#TRAINER_SKREGEXP に練習ツールがあったので確認するとヒットするが
ソースを自分の Delphi でコンパイルするとヒットしない
「もしかして SkRegExp のバージョン違い?」「2.5.3 でいけるのに 3.0.8 でおかしくなってる?」
小宮さんの配布サイトって確か随分前になくなっていたのでは?





GitHub にあった
3.1.12 2015/11/7
履歴読んでもわからんけど治ったっぽい
エンバグだったのか……


結論:GitHub は凄い

Application.MainFormOnTaskbar

2021-09-11 12:24:51 | Delphi
Delphi2007 以降に搭載されたプロジェクトファイル内の
Application.MainFormOnTaskbar := True;
(新しいプロジェクトには、この行が自動的に追加)

特殊な構造をしていた Delphiを Windows のエアロ対応にするために歪な方法?で実現した(と私は受け取った)
しかしその副作用のため「Show」したサブフォームがメインフォームより前面に出てしまい見た目が「ShowModal」状態になってしまう問題は現在でも解消されていない(らしい)
https://docwiki.embarcadero.com/Libraries/Sydney/ja/Vcl.Forms.TApplication.MainFormOnTaskBar
『このプロパティに依存するアプリケーションでは、このプロパティが MainForm の Z 順序に影響を与える点に注意してください。』

わざとわかりにくく書いているのか?
要するにこう
「メインフォームから表示したフォームが常にメインフォームの上に表示されてしまう」

こちら↓でも「MainFormOnTaskbar はコメントアウトしようぜ」になってる(記事は古いけど)
フォームの重なり順序を変更する方法は?


おわかりいただけただろうか……
Form1 のタイトルバーがアクティブ色なことに……


Application.MainFormOnTaskbar を False にするとこれは解消されるが Aero が機能せずタスクバーにマウスを持って行った時サブフォームがプレビュー(サムネイル)として表示されたりする





ググった結果くろねこさんがファイナルアンサーを出しているっぽいんだけど
[Delphi] MainFormOnTaskBarとタスクバーボタン
[Delphi] MainFormOnTaskBarとタスクバーボタン2


「ITaskbarList インターフェイス」が Delphi 2010 で実装でそれ以前の Delphi ではタイプライブラリを作成
712_タスクバーへの追加・削除とプログレス表示
というのが邪魔くさかったのともっとわかりやすくて安易な方法を求めて彷徨った結果こちらにたどり着く

「How to allow Delphi secondary forms behind the main form」

つまり姿を隠したスプラッシュフォームをメインフォームに設定してサブフォームの親はすべてこいつにする
本来のメインフォームを閉じる( = アプリケーションの終了)時にスプラッシュフォームを閉じるようにすればユーザーにはわからない

『町娘を嫁にしたいからいったん他の武家の養女にする』みたいな感じ

このままではエアロ対応にはならず
・Application.MainFormOnTaskbar は True のまま

更にはタスクバーに登録されないので
・タスクバーへの登録は自分でやる




※最近の Delphi なら{Winapi.}のコメントを外してください

プロジェクトソース
program TestMainFormOnTaskbar;

uses
  Forms,
  TestMainFormOnTaskbarMainFormUnit in 'TestMainFormOnTaskbarMainFormUnit.pas' {RealMainForm},
  Form2Unit in 'Form2Unit.pas' {SubForm},
  SplashFormUnit in 'SplashFormUnit.pas' {SplashForm};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TSplashForm, SplashForm);
  Application.CreateForm(TRealMainForm, RealMainForm);
  Application.Run;
end.

スプラッシュフォームユニット
unit SplashFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TSplashForm = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure CloseApplication;
  end;

var
  SplashForm: TSplashForm;

implementation

uses
  TestMainFormOnTaskbarMainFormUnit;//本来のメインフォーム

{$R *.dfm}

procedure TSplashForm.CloseApplication;
begin
  Close;
end;

procedure TSplashForm.FormCreate(Sender: TObject);
begin
  BorderStyle:=bsNone;
  Height:=1;//見せない方向で……
//  Show;
//  BringToFront;
end;

procedure TSplashForm.Timer1Timer(Sender: TObject);
begin
  if Assigned(RealMainForm) then
  begin
    Visible:=False;

//この部分がないとタスクバーに登録されない
    {Winapi.}Windows.SetWindowLong(RealMainForm.Handle, GWL_EXSTYLE,
      {Winapi.}Windows.GetWindowLong(RealMainForm.Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
    {Winapi.}Windows.SetParent(RealMainForm.Handle, GetDesktopWindow);

    RealMainForm.Show;
    Timer1.Enabled:=False;
  end else Timer1.Interval:=10;//スプラッシュ画面を見せるならここを長くする
end;

end.

【リアル】メインフォームユニット
unit TestMainFormOnTaskbarMainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TRealMainForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  RealMainForm: TRealMainForm;

implementation

uses
  Form2Unit,    //SubForm
  SplashFormUnit;//Close 手続き

{$R *.dfm}

procedure TRealMainForm.Button1Click(Sender: TObject);
begin
  TSubForm.Create(Self).Show;
end;

procedure TRealMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SplashForm.CloseApplication;
end;

end.

サブフォームユニット
unit Form2Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TSubForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params:TCreateParams); override;
  public
    { Public 宣言 }
  end;

var
  SubForm: TSubForm;

implementation

{$R *.dfm}

procedure TSubForm.CreateParams(var Params: TCreateParams);
begin
//Show されるフォーム
  inherited;
  Params.WndParent:=Application.MainForm.Handle;
end;

procedure TSubForm.FormCreate(Sender: TObject);
begin
  Color:=clRed;//わかりやすいように色つける
end;

end.


これでいけると思うが NanaTerry では多重起動処理で「Application.MainForm」あたり使いまくってるのでキチンとテストしなくてはいけない

Rtf2HTML

2021-08-12 22:55:41 | Delphi
Rtf2HTML を日本語で扱えるようにガリガリ書いてる

Android OS で Shift-JIS コード処理するのまんどくせぃ……
何が面倒くさいって 4Byte 2Byte 半角カナの判断だけでも WindowsAPI 使えないんだからたまらん

「NanaTreeのエディタには一応、画像やOLE」がこう↓
NanaTree\'82\'cc\'b4\'c3\'de\'a8\'c0\'82\'c9\'82\'cd\'88\'ea\'89\'9e\'81\'41\'89\'e6\'91\'9c\'82\'e2OLE

なにしろベースにしてるライブラリが何十年も前に異人さんが作って公開してくれたものなので
おいらと癖も違うしコメントも英語だし素ではリストカウントエラー出るし
後々画像も取り出して表示しようと思って一端その部分を無視しようとしたらアプリケーションエラー出まくるしぃ
吐き出す文字コードにも癖があるのかちょっとでも条件式で期待するものになってなければタグ閉じ判断出来なかったり例外出たり

勤め人のプログラマたちっていつもこんな苦労してるんだねー
まあつっても Pascal だから読みやすいっちゃ読み易いんだけどね


うん
楽しいよ
趣味だから(はーと)

TNotePadのSelectionLength 2

2021-03-13 12:16:37 | Delphi
以前 TNotePadのSelectionLength という記事でマイナス値になるのはおかしいと訂正したんだけどどうやら作者は意図的にしていたらしい

私が訂正した状態だと
エディタで IME「Shift+変換」の再変換したとき文字選択を右から左に選択していると選択部分が右にずれる


procedure TNotePad.WMImeRequest(var Msg: TMessage);
のなかで
//カーソル位置を変換位置先頭に持って行くため、右から左に選択されるようにする
とコメントがあって処理してる

???
では普段選択文字列の長さを取るときにこそそのたびに
Abs(SelectionLength)
とするべきということだったのか
それなら確かに選択方向も知ることが出来るけど(必要になったことはないが)
もちろん
Memo1.SelLength
とかはそうならない
やっぱりそこは VCL に合わせた仕様にして欲しかった

覚え書き:UniCode 混じりの文字列長さ

2020-10-24 10:54:27 | Delphi

その昔日本語(Shift-JIS)は半角と全角しかなかったので「半角文字か2バイト文字」とか判別していた
「半角かな」も混じっていたし当時のコンパイラの長さを求める関数も「あいう」なら「6」と返していた
(秀丸マクロは互換性のためいまでも全角文字は2文字として数えます)
UniCode が広まってもうその考えもほぼほぼ不要になってきて全ての種類を判断して「文字」として数えてくれるようになった
ただ簡単で便利になった反面場合によってはそんな仕様がかえって困ることになる


今回の
┌―――┐
|あいう|
└―――┘
選択文字を罫線で囲むというだけの簡単なマクロでも罫線「―」は全角なので
┌―――┐
|aいう|
└―――┘
の様な場合に判別して後ろに半角スペースを追加しなければならない
このとき UniCode が混ざると昔ながらの方法で単純に「AnsiString」に変換して長さを測るとかは出来ない
┌―――┐
|আ¶£|
└―――┘
とかなるときにどう判断すればいいのかと考えた結果単純な方法でやっつけた



//半角英数字の長さなら何文字か返す
//KiriAge が True なら小数値は切り上げ False なら四捨五入
function ASCIILength(S:string;KiriAge:Boolean):integer;
var
  F:Extended;
begin
  F:=Canvas.TextWidth(S)/Canvas.TextWidth('q');//Canvas が等幅フォント前提
  if KiriAge then
  begin
    if  Frac(F)<>0 then Result:=Trunc(F)+1 else Result:=Trunc(F);
  end else
  begin
    if F>=0 then Result:=Trunc(F+0.5) else Result:=Trunc(F-0.5);
  end;
end;

それは半角英数字の何文字相当なのかという関数
中でやってることは「とりあえず書いたらどれだけの長さになるのか」だけ

多分これで解決したんだけれどもそんなことをやっているとき秀丸を見て気づいたんだけど
同じフォントにしても微妙に違うの笑う