2024/09/29

TRichEdit.SelAttributes.Name の欠落

 さて「TRichEdit.SelAttributes.Name の欠落」

という事柄に何日も悩まされていたわけですが、どうやら一段落ついたようなので覚え書き。


Delphi2009 前後の RichEdit で「UD デジタル 教科書体 N-B」など少し長い名前の日本語名を持つ文字列をドラッグ＆ドロップ或いはクリップボードから貼り付けた場合にフォント名の最後の方が欠落してしまうという問題。

Delphi XE でも発生して、Delphi 11 以降では、TRichEditコンポーネントが、RichEdit 4.1 に変わっているので問題ないらしい。

Delphi5 では問題ないので最初は Delphi が内部で UniCode に対応した時のせいかと思ったんだけど、オリジナルの NanaTree でもおかしくなるので（多分 Delphi6 製）これは結構深い問題かなと、ChatGPT らと話し合いながら色々と探索。


■UniCode 方面から攻めたので最初は「型」と「エンコード」を重点に調べる。

昔から RichEdit くんは、ASCII でずっと頑張っていたから……

VCL ソースを D5 と比較しながら、ちょっと修正してはコンパイル→ここでもない→一旦閉じて→またいじって……

■自分でドラッグ＆ドロップやってみれば同じようなことを GREP して探せるのでは？

■どうやってドラッグ中のデータを参照するの？ > ChatGPT

ほーん

なる

■どうせなら RichEdit 自身のドラッグ＆ドロップ無効にして自分で処理してしまえ！

■出来たんじゃね？

■ペーストも処理しなくちゃだわ

■出来たんじゃね？


満足して微調整（移動する場合元の文字列を削除したりするのもやらなくちゃいけないから SelStart より前にドロップしたとか色々ややこしい）



【実際には TJvRichEdit 使っているので】

■画像とかファイルとかの外部からのドラッグ＆ドロップが出来なくなってるじゃん！

これは今までやってきたことすべてリセットやん！


■TJvRichEdit には OnQueryAcceptData イベントがあってここで唯一「IDataObject」を参照することが出来る。

ここに今までやってきたことを全部詰め込めばええやんか


多分これでファイナルアンサー

サンプル♪ヘ(^^ヘ)(ノ^^)ノヘ(^^ヘ)(ノ^^)ノ♪
フォームに TRichEdit 貼り付けて Form.OnCreate で適当に文字列入れてフォント変更。
TRichEdit の OnSelectionChang でフォント名を参照出来るようにする。
uses に（無かったら）ComCtrls, RichEdit, ActiveX の3つを追加。

以下ソース
  
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JvExStdCtrls, JvRichEdit, ComCtrls, RichEdit, ActiveX;

type
  TForm1 = class(TForm)
    JvRichEdit1: TJvRichEdit;
    procedure JvRichEdit1QueryAcceptData(Sender: TObject;
      const ADataObject: IDataObject; var AFormat: Word;
      ClipboardOperationKind: Cardinal; Really: Boolean; IconMetaPict: Cardinal;
      var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure JvRichEdit1SelectionChange(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function InsertRTF(Target:TRichEdit;RTF:string):Boolean;
var
  SL:TStringList;
  ES:TEditStream;
  Rich:TRichEdit;
  MS:TMemoryStream;

  // コールバック関数
  function myCallback(dwCookie:DWORD; pbBuff:PByte;
    cb:Longint; var pcb:Longint):DWORD; stdcall;
  var
    MS:TMemoryStream;
  begin
    Result:=0;
    MS:=TMemoryStream(dwCookie);
    pcb:=MS.Read(pbBuff^, cb);
  end;

begin
  SL:=TStringList.Create;
  try
    SL.Add(RTF);

    Rich:=TRichEdit.Create(nil);
    try
      Rich.Visible:=False;
      Rich.Parent:=Application.MainForm;
      Rich.PlainText:=False;//.StreamFormat:=sfRichText;

      MS:=TMemoryStream.Create;
      try
        MS.Position:=0;
        SL.SaveToStream(MS,TEncoding.ASCII);
        MS.Position:=0;
        ES.dwCookie:=DWORD(MS);
        ES.dwError:=0;
        ES.pfnCallback:=@myCallback;

        Target.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, LParam(@ES));

      finally
        MS.Free;
      end;
    finally
      Rich.Free;
    end;
  finally
    SL.Free;
  end;
  Result:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  TestText='ABCDE';
  FontName='UDデジタル教科書体 N-B';
begin
  Font.Size:=12;//←我、老眼なので
//ここだけわからん何故かデフォのTahomaだとD&Dのあと日本語が文字化けする
  Font.Name:='ＭＳ ゴシック';

  JvRichEdit1.Lines.Text:=TestText;
  JvRichEdit1.SelStart:=0;
  JvRichEdit1.SelLength:=1;
  JvRichEdit1.SelAttributes.Name:=FontName;
  JvRichEdit1.SelAttributes.Color:=clRed;
  JvRichEdit1.SelAttributes.Style:=[fsBold];
end;

procedure TForm1.JvRichEdit1SelectionChange(Sender: TObject);
begin
  Caption:=JvRichEdit1.SelAttributes.Name;
end;

procedure TForm1.JvRichEdit1QueryAcceptData(Sender: TObject;
  const ADataObject: IDataObject; var AFormat: Word;
  ClipboardOperationKind: Cardinal; Really: Boolean; IconMetaPict: Cardinal;
  var Handled: Boolean);
var
  FormatEtc: TFormatEtc;
  RtfText: string;
  Medium: TStgMedium;
  GlobalMem: HGlobal;
  pText: PAnsiChar;
  CF_RTF: UINT;
begin
  if Really then
  begin
// IDataObjectからデータを取得
    CF_RTF:=RegisterClipboardFormat('Rich Text Format');
    FormatEtc.cfFormat := CF_RTF;  // CF_RTFを登録
    FormatEtc.ptd := nil;
    FormatEtc.dwAspect := DVASPECT_CONTENT;
    FormatEtc.lindex := -1;
    FormatEtc.tymed := TYMED_HGLOBAL;
//リッチエディタ上でのD&D
    if ADataObject.GetData(FormatEtc, Medium) = S_OK then
    begin
      GlobalMem := Medium.hGlobal;
      pText := GlobalLock(GlobalMem);
      SetString(RtfText, pText, GlobalSize(GlobalMem));
      GlobalUnlock(GlobalMem);
      ReleaseStgMedium(Medium);
      Handled:=True;//これがきも！
      InsertRTF(TRichEdit(JvRichEdit1),RtfText);
    end;
  end;
end;

end.


そして出来上がったのがこちらです。

ドラッグ＆ドロップで移動しても他のソフトから貼り付けても「UD デジタル 教科書体 N-B」のフォント名は壊れていない
（ちなみに Ctrl+ でコピードラッグです）

ここまでやって凄く不思議な現象が。
今、上で追加したソースの InsertRTF と QueryAcceptData の部分を削除して実行したらフォント名の欠落は起きないんだよなー。
まあ最新の開発環境を使えってはなしなんだけどそれはそれで最初のリンク先読んで貰ったらわかるけど
RichEdit 4.x がウンチなんよね
投稿者 時刻: 0 件のコメント:
登録: 投稿 (Atom)