さて「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」を参照することが出来る。
ここに今までやってきたことを全部詰め込めばええやんか
多分これでファイナルアンサー
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 がウンチなんよね
