unit uEdit; { Unicode対応入力ボックス。 WindowsのRichEditコントロールを利用。 テキストの修飾には非対応。 } interface uses Classes, Controls, Grids, Messages, StdCtrls, Windows, Graphics; //Windowsより下でないとTBitmapで不都合が出る場合あり。 type T_MyBkValue = record SelStart : Integer; SelLength : Integer; Text : WideString; Tabs : array of Longint; Color : TColor; Rect : TRect; AutoFont : Boolean; end; { TMyCustomEditControl } TMyCustomEditControl = class(TObject) private { Private 宣言 } FiLeft : Integer; FiTop : Integer; FiWidth : Integer; FiHeight : Integer; FhEditHandle : HWND; FParent : TWinControl; FFont : TFont; FclTextColor : TColor; FclBkColor : TColor; FTabs : array of Longint; FBkValue : T_MyBkValue; FbReadOnly : Boolean; FbHideSelection : Boolean; FbFindForward : Boolean; FbFindIgnoreCase : Boolean; FbFindWholeWord : Boolean; procedure FSetLeft(iLeft: Integer); procedure FSetTop(iTop: Integer); procedure FSetWidth(iWidth: Integer); procedure FSetHeight(iHeight: Integer); function FGetClientRect: TRect; function FGetBoundsRect: TRect; procedure FSetTabStops; //配列FTabsの内容でタブをセットする procedure FSetTabs(iTabStop: Longint); //タブの幅をiTabStop文字にする function FGetTabs: Longint; function FGetModified: Boolean; procedure FSetModified(Value: Boolean); function FGetCanUndo: Boolean; function FGetCanRedo: Boolean; procedure FSetFont(Value: TFont); procedure FFontChange(Sender: TObject); procedure FSetColor(Value: TColor); function FGetSelStart: Integer; procedure FSetSelStart(iIndex: Integer); function FGetSelLength: Integer; procedure FSetSelLength(iCount: Integer); function FGetText: WideString; procedure FSetText(sText: WideString); function FGetSelected: Boolean; function FGetSelText: WideString; procedure FSetSelText(sStr: WideString); function FGetCaretIndex: Integer; //カーソル位置の文字の0ベースのインデックス procedure FSetCaretIndex(iIndex: Integer); procedure FSetReadOnly(bReadOnly: Boolean); procedure FSetHideSelection(bHide: Boolean); procedure FSetAutoFont(Value: Boolean); virtual; protected procedure CreateWnd(iStyle: Longint); virtual; procedure RecreateWnd(iStyle: Longint); virtual; procedure BackupValue; virtual; procedure RestoreValue; virtual; function GetAutoFont: Boolean; virtual; procedure SetAutoFont(Value: Boolean); virtual; procedure SetTabs(Tabs: array of Longint); overload; property Left : Integer read FiLeft write FSetLeft; property Top : Integer read FiTop write FSetTop; property Width : Integer read FiWidth write FSetWidth; property Height : Integer read FiHeight write FSetHeight; property Text : WideString read FGetText write FSetText; property Font : TFont read FFont write FSetFont; property Tabs : Longint read FGetTabs write FSetTabs default 0; property Color : TColor read FclBkColor write FSetColor default clWindow; property AutoFont : Boolean read GetAutoFont write SetAutoFont default True; property HideSelection : Boolean read FbHideSelection write FSetHideSelection default True; property FindForward : Boolean read FbFindForward write FbFindForward default True; //後方検索 property FindIgnoreCase : Boolean read FbFindIgnoreCase write FbFindIgnoreCase default True; //大文字小文字を区別しない property FindWholeWord : Boolean read FbFindWholeWord write FbFindWholeWord default False; //単語検索ではない public { Public 宣言 } constructor Create(winParent: TWinControl); overload; constructor Create(winParent: TWinControl; iStyle: DWORD); overload; destructor Destroy; override; procedure Show; procedure Hide; function Focused: Boolean; procedure SetFocus; procedure SetBounds(iLeft, iTop, iWidth, iHeight: Integer); overload; procedure SetBounds(rcRect: TRect); overload; procedure ScrollCaret; procedure Clear; procedure ClearUndo; procedure Undo; procedure Redo; procedure CutToClipboard; procedure CopyToClipboard; procedure PasteFromClipboard; procedure ClearSelection; procedure SelectAll; procedure Insert(sText: WideString); function CanPaste: Boolean; function Empty: Boolean; virtual; function Length: Integer; function StrCopy: WideString; overload; virtual; function StrCopy(iCount: Integer): WideString; overload; virtual; function StrCopy(iIndex, iCount: Integer): WideString; overload; virtual; function FindText(sStr: WideString): Integer; procedure Find; overload; procedure Find(sStr: WideString); overload; procedure SaveToFile(sFile: WideString); procedure LoadFromFile(sFile: WideString); property Handle: HWND read FhEditHandle; property ClientRect: TRect read FGetClientRect; property BoundsRect: TRect read FGetBoundsRect; property CaretIndex: Integer read FGetCaretIndex write FSetCaretIndex; property CanUndo: Boolean read FGetCanUndo; property CanRedo: Boolean read FGetCanRedo; property Modified: Boolean read FGetModified write FSetModified; property Selected: Boolean read FGetSelected; property SelStart: Integer read FGetSelStart write FSetSelStart; property SelLength: Integer read FGetSelLength write FSetSelLength; property SelText: WideString read FGetSelText write FSetSelText; property ReadOnly: Boolean read FbReadOnly write FSetReadOnly; end; {TMyEditControl} TMyEditControl = class(TMyCustomEditControl) // public published property Left; property Top; property Width; property Height; property Color; property Text; property Tabs; property Font; property AutoFont; property HideSelection; property FindForward; property FindIgnoreCase; property FindWholeWord; end; {TMyMemoControl} TMyMemoControl = class(TMyCustomEditControl) private FParent : TWinControl; FScrollBars : TScrollStyle; FbWordWrap : Boolean; FbLineHeight : Boolean; function FGetCount: Integer; function FGetCurrentLine: Integer; function FGetColumn: Integer; function FGetTopIndex: Integer; procedure FSetTopIndex(iIndex: Integer); procedure FSetLineHeight; protected procedure CreateWnd(iStyle: Longint); override; procedure RestoreValue; override; procedure SetScrollBars(Value: TScrollStyle); procedure SetWordWrap(Value: Boolean); procedure SetLineHeight(Value: Boolean); public { Public 宣言 } constructor Create(winParent: TWinControl); overload; constructor Create(winParent: TWinControl; iStyle: DWORD); overload; function GetLine(iIndex: Integer): WideString; //0ベース function Empty: Boolean; override; function StrCopy(iCount: Integer): WideString; overload; override; function StrCopy(iLine, iIndex, iCount: Integer): WideString; overload; property Count: Integer read FGetCount; property CurrentLine: Integer read FGetCurrentLine; //0ベース property Column: Integer read FGetColumn; //0ベース property TopIndex: Integer read FGetTopIndex write FSetTopIndex; published property Left; property Top; property Width; property Height; property Text; property Tabs; property Font; property AutoFont; property Color; property HideSelection; property FindForward; property FindIgnoreCase; property FindWholeWord; property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; property LineHeight: Boolean read FbLineHeight write SetLineHeight default False; //行間を開ける property WordWrap: Boolean read FbWordWrap write SetWordWrap default False; //折り返し end; const GT_SELECTION = 2; GT_RAWTEXT = 4; const IMF_AUTOKEYBOARD = $00000001; IMF_FORCENONE = $00000001; IMF_AUTOFONT = $00000002; IMF_FORCEENABLE = $00000002; IMF_IMECANCELCOMPLETE = $00000004; IMF_FORCEDISABLE = $00000004; IMF_CLOSESTATUSWINDOW = $00000008; IMF_IMEALWAYSSENDNOTIFY = $00000008; IMF_AUTOFONTSIZEADJUST = $00000010; IMF_UIFONTS = $00000020; IMF_VERTICAL = $00000020; IMF_FORCEACTIVE = $00000040; IMF_DUALFONT = $00000080; IMF_FORCEINACTIVE = $00000080; IMF_FORCEREMEMBER = $00000100; IMF_MULTIPLEEDIT = $00000400; implementation uses // myDebug, CommDlg, Forms, RichEdit, TypInfo, SysUtils, uCode; var lhRichEditModule : THandle; const {$DEFINE RICHEDITVER4} {$IFDEF RICHEDITVER4} lcsMODULENAME = 'Msftedit.dll'; lcsCLASSNAME = 'RICHEDIT50W'; {$ELSE} lcsMODULENAME = 'Riched20.dll'; lcsCLASSNAME = RICHEDIT_CLASSW; {$ENDIF} // 汎用関数 -------------------------------------------------------------------- //Unicode const CP_SHIFTJIS = 932; CP_JIS = 50220; //半角カナは全角に変換される。 // CP_JIS = 50221; //半角カナOK。 // CP_JIS = 50222; //漢字SI/SO // CP_EUC = 51932; //MultiByteToWideCharとWideCharToMultiByteではエラーになる。 CP_EUC = 20932; //変わりにこちらを使うとOK。 const WC_NO_BEST_FIT_CHARS = $00000400; function gfnbIsUnicode(sSrc: WideString): Boolean; //sSrcにウムラウトのようなUnicode文字があればTrueを返す var lb_Bool: LongBool; begin WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, nil, @lb_Bool); Result := lb_Bool; end; //WideString⇒AnsiString function gfnsWideToAnsi(sSrc: WideString): AnsiString; //合成文字をきちんとあつかってAnsiStringに変換。 //例)「が」→「が」みたいな感じで。 const lcs_DEF = ''; var li_Len: Integer; lp_Buff: PAnsiChar; begin //WC_COMPOSITECHECKが肝 li_Len := WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, nil, 0, nil, nil); Inc(li_Len); lp_Buff := AllocMem(li_Len); try WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil); Result := AnsiString(lp_Buff); finally FreeMem(lp_Buff); end; end; //UTF-16LE⇔UTF-8 function gfnsWideToUTF8(sSrc: WideString): UTF8String; { WideStringをUTF-8にエンコードして返す。 サロゲートペアにも対応。 UTF8Encodeの方が速い。 } var li_Len: Integer; lp_Buff: PAnsiChar; begin li_Len := WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, nil, 0, nil, nil); lp_Buff := AllocMem(li_Len + 1); try WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil); Result := UTF8String(lp_Buff); finally FreeMem(lp_Buff); end; end; function gfnsUTF8ToWide(sSrc: UTF8String): WideString; { UTF-8でエンコードされている文字列をWideStringにして返す。 サロゲートペアにも対応。 UTF8Decodeの方が速い。 } var li_Len: Integer; lp_Buff: PWideChar; begin li_Len := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, nil, 0); lp_Buff := AllocMem((li_Len + 1) * 2); try MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; //UTF-16LE⇔UTF-7 function gfnsWideToUtf7(sSrc: WideString): AnsiString; //WideStringをUTF-7にエンコードして返す var li_Len: Integer; lp_Buff: PAnsiChar; begin //WC_COMPOSITECHECKはNG li_Len := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, nil, 0, nil, nil); lp_Buff := AllocMem(li_Len + 1); try WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil); Result := AnsiString(lp_Buff); finally FreeMem(lp_Buff); end; end; function gfnsUtf7ToWide(sSrc: AnsiString): WideString; //UTF-7でエンコードされている文字列をWideStringにして返す var li_Len: Integer; lp_Buff: PWideChar; begin li_Len := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, nil, 0); lp_Buff := AllocMem((li_Len + 1) * 2); try MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; //JIS⇔WideString function gfnsJisToWide(sSrc: AnsiString): WideString; var li_Len: Integer; lp_Buff: PWideChar; begin li_Len := MultiByteToWideChar(CP_JIS, 0, PAnsiChar(sSrc), -1, nil, 0); lp_Buff := AllocMem((li_Len + 1) * 2); try MultiByteToWideChar(CP_JIS, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; function gfnsWideToJis(sSrc: WideString): AnsiString; var li_Src : Integer; li_Len : Integer; lp_Buff : PAnsiChar; begin //http://www.gesource.jp/weblog/?p=738 //http://ht-deko.minim.ne.jp/ft0909.html#090927 li_Src := Length(sSrc); li_Len := (li_Src * 5) + 4 - (li_Src div 2); lp_Buff := AllocMem(li_Len + 1); try WideCharToMultiByte(CP_JIS, 0, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil); Result := AnsiString(lp_Buff); finally FreeMem(lp_Buff); end; end; //EUC⇔WideString function gfnsEucToWide(sSrc: AnsiString): WideString; var li_Len: Integer; lp_Buff: PWideChar; begin li_Len := MultiByteToWideChar(CP_EUC, 0, PAnsiChar(sSrc), -1, nil, 0); lp_Buff := AllocMem((li_Len + 1) * 2); try MultiByteToWideChar(CP_EUC, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; function gfnsWideToEuc(sSrc: WideString): AnsiString; var li_Len: Integer; lp_Buff: PAnsiChar; begin li_Len := WideCharToMultiByte(CP_EUC, WC_COMPOSITECHECK, PWideChar(sSrc), -1, nil, 0, nil, nil); lp_Buff := AllocMem(li_Len + 1); try WideCharToMultiByte(CP_EUC, WC_COMPOSITECHECK, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil); Result := AnsiString(lp_Buff); finally FreeMem(lp_Buff); end; end; //------------------------------------------------------------------------------ //クリップボード function gfnsStrFromClipboard: WideString; //クリップボードの文字列を取得して返す var li_Format: array[0..1] of Integer; li_Text: Integer; lh_Clip, lh_Data: THandle; lp_Clip, lp_Data: Pointer; begin Result := ''; li_Format[0] := CF_UNICODETEXT; li_Format[1] := CF_TEXT; li_Text := GetPriorityClipboardFormat(li_Format, 2); if (li_Text > 0) then begin if (OpenClipboard(Application.Handle)) then begin lh_Clip := GetClipboardData(li_Text); if (lh_Clip <> 0) then begin lh_Data := 0; if (GlobalFlags(lh_Clip) <> GMEM_INVALID_HANDLE) then begin try if (li_Text = CF_UNICODETEXT) then begin //Unicode文字列を優先 lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip)); lp_Clip := GlobalLock(lh_Clip); lp_Data := GlobalLock(lh_Data); lstrcpyW(lp_Data, lp_Clip); Result := WideString(PWideChar(lp_Data)); GlobalUnlock(lh_Data); GlobalFree(lh_Data); GlobalUnlock(lh_Clip); //GlobalFreeはしてはいけない end else if (li_Text = CF_TEXT) then begin lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip)); lp_Clip := GlobalLock(lh_Clip); lp_Data := GlobalLock(lh_Data); lstrcpy(lp_Data, lp_Clip); Result := AnsiString(PAnsiChar(lp_Data)); GlobalUnlock(lh_Data); GlobalFree(lh_Data); GlobalUnlock(lh_Clip); //GlobalFreeはしてはいけない end; finally if (lh_Data <> 0) then GlobalUnlock(lh_Data); CloseClipboard; end; end; end; end; end; end; procedure gpcStrToClipboard(sText: WideString); //クリップボードへ文字列をセットする //Unicode文字列としてセットすると同時に（Unicodeでない）プレーンテキストとしてもセットする var li_WLen, li_Len: Integer; ls_Text: AnsiString; lh_Mem: THandle; lp_Data: Pointer; begin li_WLen := (Length(sText) + 1) * 2; ls_Text := gfnsWideToAnsi(sText); li_Len := Length(ls_Text) + 1; if (sText <> '') then begin if (OpenClipboard(Application.Handle)) then begin try EmptyClipboard; //CF_UNICODETEXT lh_Mem := GlobalAlloc(GHND or GMEM_SHARE, li_WLen); lp_Data := GlobalLock(lh_Mem); lstrcpyW(lp_Data, PWideChar(sText)); GlobalUnlock(lh_Mem); SetClipboardData(CF_UNICODETEXT, lh_Mem); //CF_TEXT lh_Mem := GlobalAlloc(GHND or GMEM_SHARE, li_Len); lp_Data := GlobalLock(lh_Mem); lstrcpy(lp_Data, PAnsiChar(ls_Text)); GlobalUnlock(lh_Mem); SetClipboardData(CF_TEXT, lh_Mem); finally CloseClipboard; end; end; end; end; // 数値 ------------------------------------------------------------------------ function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer; begin if (iMin = iMax) then begin Result := iMin; end else begin if (iNum < iMin) then begin Result := iMin; end else if (iNum > iMax) then begin Result := iMax; end else begin Result := iNum; end; end; end; // Unicode読み書き ------------------------------------------------------------- procedure gpcFileWriteText(sFile, sText: WideString); //Unicode対応のファイル書き込み。 //Unicodeな文字があればBOMありのUTF-8で、そうでなければShift-JISで書き込む。 var li_Count : DWORD; lb_Unicode : Boolean; ls_Str : AnsiString; lh_Handle : THandle; begin if (gfnbIsUnicode(sText)) then begin //自動判別でsTextにUnicode文字があればUtf-8で書き込み lb_Unicode := True; // ls_Str := Utf8Encode(sText); //D6のUtf8Encodeはサロゲートペアに非対応 ls_Str := gfnsWideToUtf8(sText); end else begin //Shift-JIS lb_Unicode := False; ls_Str := gfnsWideToAnsi(sText); end; lh_Handle := CreateFileW( PWideChar(sFile), //ファイル名 GENERIC_WRITE, //アクセスモード 0, //共有モード nil, //セキュリティ CREATE_ALWAYS, //作成方法 FILE_ATTRIBUTE_NORMAL, //ファイル属性 0 //テンプレート ); try if (lb_Unicode) then begin WriteFile(lh_Handle, #$EF#$BB#$BF, 3, li_Count, nil); //BOM付加。 end; WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil); finally CloseHandle(lh_Handle); end; end; function gfniFileSizeGet(sFile: WideString): Int64; //sWFileのサイズをByte単位で返す。 var lh_File: Cardinal; lr_Info: TWin32FindDataW; begin Result := 0; lh_File := FindFirstFileW(PWideChar(sFile), lr_Info); try if (lh_File <> INVALID_HANDLE_VALUE) then begin repeat if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin Result := lr_Info.nFileSizeHigh * (Int64(MAXDWORD) + 1) + lr_Info.nFileSizeLow; Break; end; until not(FindNextFileW(lh_File, lr_Info)); end; finally Windows.FindClose(lh_File); end; end; function gfnsFileReadText(sFile: WideString): WideString; //Unicode対応テキストファイル読み込み。 //文字コードは自動判定 //http://www.xmleditor.jp/blog/archives/40 var lh_Handle : THandle; lp_Buff : PAnsiChar; li_Count : DWORD; li_Size : DWORD; li_Len : Integer; lp_Endian : PWideChar; begin li_Size := gfniFileSizeGet(sFile); lp_Buff := AllocMem(li_Size +2); //WideString(lp_Buff)としても問題ないように+2 try lh_Handle := CreateFileW( PWideChar(sFile), //ファイル名 GENERIC_READ, //アクセスモード FILE_SHARE_READ, //共有モード nil, //セキュリティ OPEN_EXISTING, //作成方法 FILE_ATTRIBUTE_NORMAL, //ファイル属性 0 //テンプレート ); ReadFile(lh_Handle, lp_Buff^, li_Size, li_Count, nil); CloseHandle(lh_Handle); if (li_Count <= 0) then begin Result := ''; end else begin case gfniCodePageGet(lp_Buff, li_Count) of 65001 //UTF-8 :begin Result := gfnsUtf8ToWide(Utf8String(PAnsiChar(lp_Buff))); end; 1200 //UTF-16 LE (リトルエンディアン) :begin Result := WideString(PWideChar(lp_Buff)); end; 1201 //UTF-16 BE (ビッグエンディアン) :begin Result := WideString(PWideChar(lp_Buff)); //ビッグエンディアンなのでエンディアン入れ替え li_Len := LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(Result), -1, nil, 0); lp_Endian := AllocMem((li_Len +1) * 2); try LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(Result), -1, lp_Endian, li_Len); Result := WideString(lp_Endian); finally FreeMem(lp_Endian); end; end; 65000 //UTF-7 :begin Result := gfnsUtf7ToWide(AnsiString(lp_Buff)); end; 50220, //日本語 (JIS) iso-2022-jp 50221, //日本語 (JIS 1 バイト カタカナ可) csISO2022JP 50222, //日本語 (JIS 1 バイト カタカナ可 - SO/SI) iso-2022-jp 50225, //韓国語 (ISO) iso-2022-kr 50227 //簡体字中国語 (ISO-2022) x-cp50227 :begin Result := gfnsJisToWide(AnsiString(lp_Buff)); end; 20932, //日本語 (JIS 0208-1990 および 0212-1990) EUC-JP 51932, //日本語 (EUC) euc-jp 51936, //簡体字中国語 (EUC) EUC-CN 51949 //韓国語 (EUC) euc-kr :begin Result := gfnsEucToWide(AnsiString(lp_Buff)); end; else begin //その他はShift-JISとして処理する Result := AnsiString(lp_Buff); end; end; //BOMがあれば取り除く if (PAnsiChar(PWideChar(Result))[0] = #$FF) or (PAnsiChar(PWideChar(Result))[1] = #$FE) then begin Result := Copy(Result, 2, MAXINT); end; end; finally FreeMem(lp_Buff); end; end; //============================================================================== { TMyCustomEditControl } procedure TMyCustomEditControl.CreateWnd(iStyle: Longint); begin Create(FParent, iStyle); end; procedure TMyCustomEditControl.RecreateWnd(iStyle: Longint); begin BackupValue; DestroyWindow(Handle); //一旦破棄 CreateWnd(iStyle); //再作成 RestoreValue; end; //文字列を読み直す場合にカーソル位置や選択状態を退避する procedure TMyCustomEditControl.BackupValue; var i: Integer; begin FBkValue.Text := Text; //テキストを退避 FBkValue.SelStart := CaretIndex; //カーソル位置を退避 FBkValue.SelLength := SelLength; //選択されている範囲を退避 FBkValue.Rect := BoundsRect; //Rectを退避 FBkValue.AutoFont := GetAutoFont; //オートフォントの値を退避 SetLength(FBkValue.Tabs, High(FTabs)+1); for i := 0 to High(FTabs) do begin FBkValue.Tabs[i] := FTabs[i]; end; end; //↑で退避した設定値を戻す procedure TMyCustomEditControl.RestoreValue; var i: Integer; begin SetBounds(FBkValue.Rect); //Rectを復元 SetLength(FTabs, High(FBkValue.Tabs)+1); for i := 0 to High(FBkValue.Tabs) do begin FTabs[i] := FBkValue.Tabs[i]; end; FSetTabStops; //タブの復元 //SetAutoFontはNG FSetAutoFont(FBkValue.AutoFont); //オートフォントの設定を復元 Text := FBkValue.Text; //テキストを復元 CaretIndex := FBkValue.SelStart; //カーソル位置を復元 if (FBkValue.SelLength > 0) then begin SelLength := FBkValue.SelLength; //選択されている範囲を復元 end; ScrollCaret; //カーソルが見えるまでスクロール SetFocus; end; constructor TMyCustomEditControl.Create(winParent: TWinControl); begin Create(winParent, ES_AUTOHSCROLL); end; constructor TMyCustomEditControl.Create(winParent: TWinControl; iStyle: DWORD); begin if (lhRichEditModule = 0) then begin lhRichEditModule := LoadLibrary(lcsMODULENAME); if (lhRichEditModule <= HINSTANCE_ERROR) then begin lhRichEditModule := 0; end; end; FbReadOnly := False; FbHideSelection := True; FbFindForward := True; //後方検索 FbFindIgnoreCase := True; //大文字小文字を区別しない FbFindWholeWord := False; //単語検索ではない FclTextColor := clWindowText; FclBkColor := clWindow; SetLength(FTabs, 1); FTabs[0] := 0; FParent := winParent; with FParent do begin FiLeft := 0; FiTop := 0; FiWidth := ClientWidth; FiHeight := ClientHeight; //エディットボックス FhEditHandle := CreateWindowW( lcsCLASSNAME, nil, WS_CHILD or WS_VISIBLE or iStyle, FiLeft, FiTop, FiWidth, FiHeight, Handle, //親ウィンドウ 0, 0, nil ); end; //最大入力文字数 SendMessageW(FhEditHandle, EM_EXLIMITTEXT, 0, LPARAM(-1)); //イベントマスクセット SendMessageW(FhEditHandle, EM_SETEVENTMASK, 0, LPARAM( ENM_CHANGE //EN_CHANGE 通知を送ります。 or ENM_UPDATE //EN_UPDATE 通知を送ります。 or ENM_SCROLL //EN_HSCROLL 通知および EN_VSCROLL を送ります。 or ENM_SCROLLEVENTS //マウスホイールイベントに対して EN_MSGFILTER 通知を送ります。 or ENM_DRAGDROPDONE //EN_DRAGDROPDONE 通知を送ります。 or ENM_KEYEVENTS //キーボードイベントに対して EN_MSGFILTER 通知を送ります。 or ENM_MOUSEEVENTS //マウスイベントに対して EN_MSGFILTER 通知を送ります。 or ENM_REQUESTRESIZE //EN_REQUESTRESIZE 通知を送ります。 or ENM_SELCHANGE //EN_SELCHANGE 通知を送ります。 or ENM_DROPFILES //EN_DROPFILES 通知を送ります。 or ENM_PROTECTED //EN_PROTECTED 通知を送ります。 or ENM_CORRECTTEXT //EN_CORRECTTEXT 通知を送ります。 or ENM_LINK //マウスポインタが CFE_LINK 属性を持ったテキストの上にあり、あるマウスイベントが発生したときに EN_LINK 通知を送ります。 )); //親ウィンドウがpublishedにFontプロパティを持っていればそれを引き継ぐ if (IsPublishedProp(FParent, 'Font')) then begin FFont := TFont(GetObjectProp(FParent, 'Font')); FFont.OnChange := FFontChange; end else begin FFont := nil; end; FSetFont(FFont); end; destructor TMyCustomEditControl.Destroy; begin DestroyWindow(FhEditHandle); FhEditHandle := 0; inherited; end; //------------------------------------------------------------------------------ // サイズ --- procedure TMyCustomEditControl.FSetLeft(iLeft: Integer); begin FiLeft := iLeft; SetWindowPos(FhEditHandle, HWND_TOP, FiLeft, FiTop, FiWidth, FiHeight, SWP_NOACTIVATE or SWP_NOZORDER); end; procedure TMyCustomEditControl.FSetTop(iTop: Integer); begin FiTop := iTop; SetWindowPos(FhEditHandle, HWND_TOP, FiLeft, FiTop, FiWidth, FiHeight, SWP_NOACTIVATE or SWP_NOZORDER); end; procedure TMyCustomEditControl.FSetWidth(iWidth: Integer); begin FiWidth := iWidth; SetWindowPos(FhEditHandle, HWND_TOP, FiLeft, FiTop, FiWidth, FiHeight, SWP_NOACTIVATE or SWP_NOZORDER); end; procedure TMyCustomEditControl.FSetHeight(iHeight: Integer); begin FiHeight := iHeight; SetWindowPos(FhEditHandle, HWND_TOP, FiLeft, FiTop, FiWidth, FiHeight, SWP_NOACTIVATE or SWP_NOZORDER); end; procedure TMyCustomEditControl.SetBounds(iLeft, iTop, iWidth, iHeight: Integer); begin FiLeft := iLeft; FiTop := iTop; FiWidth := iWidth; FiHeight := iHeight; SetWindowPos(FhEditHandle, HWND_TOP, FiLeft, FiTop, FiWidth, FiHeight, SWP_NOACTIVATE or SWP_NOZORDER); end; procedure TMyCustomEditControl.SetBounds(rcRect: TRect); begin with rcRect do begin SetBounds(Left, Top, Right - Left, Bottom - Top); end; end; function TMyCustomEditControl.FGetClientRect: TRect; begin GetClientRect(FhEditHandle, Result); end; function TMyCustomEditControl.FGetBoundsRect: TRect; var lpt_Pos : TPoint; begin GetWindowRect(FhEditHandle, Result); lpt_Pos := Point(0, 0); ClientToScreen(FParent.Handle, lpt_Pos); OffsetRect(Result, -lpt_Pos.X, -lpt_Pos.Y); end; //スクロール procedure TMyCustomEditControl.ScrollCaret; begin SendMessageW(FhEditHandle, EM_SCROLLCARET, 0, 0); end; //オートフォントの設定 procedure TMyCustomEditControl.FSetAutoFont(Value: Boolean); var li_Opt : Integer; begin //ウムラウトのような文字があるとフォントが変わってしまうことがある場合へ対処 li_Opt := SendMessageW(FhEditHandle, EM_GETLANGOPTIONS, 0, 0); if (Value) then begin li_Opt := li_Opt or IMF_AUTOFONT; end else begin if ((li_Opt and IMF_AUTOFONT) <> 0) then begin Dec(li_Opt, IMF_AUTOFONT); end; end; SendMessageW(FhEditHandle, EM_SETLANGOPTIONS, 0, LPARAM(li_Opt)); end; function TMyCustomEditControl.GetAutoFont: Boolean; begin Result := (SendMessageW(FhEditHandle, EM_GETLANGOPTIONS, 0, 0) and IMF_AUTOFONT) <> 0; end; procedure TMyCustomEditControl.SetAutoFont(Value: Boolean); begin FSetAutoFont(Value); BackupValue; RestoreValue; end; //フォントセット procedure TMyCustomEditControl.FSetFont(Value: TFont); var lb_Modified: Boolean; begin if (FhEditHandle <> 0) then begin lb_Modified := FGetModified; FFont := Value; if (FFont <> nil) then begin FFont.Assign(Value); if not(Assigned(FFont.OnChange)) then begin FFont.OnChange := FFontChange; end; SendMessageW(FhEditHandle, WM_SETFONT, WPARAM(FFont.Handle), 0); FFontChange(nil); end else begin //デフォルトのフォントをセット SendMessageW(FhEditHandle, WM_SETFONT, WPARAM(GetStockObject(DEFAULT_GUI_FONT)), 0); end; if not(lb_Modified) then begin FSetModified(False); end; end; end; //文字色 procedure TMyCustomEditControl.FFontChange(Sender: TObject); //http://www.interq.or.jp/chubu/r6/masm32/tute/tute033_Jp.html var lr_Info : TCharFormatW; lb_Modified : Boolean; begin // if (FFont.Color <> FclTextColor) then // begin lb_Modified := FGetModified; FclTextColor := FFont.Color; FillChar(lr_Info, SizeOf(lr_Info), 0); lr_Info.cbSize := SizeOf(lr_Info); lr_Info.dwMask := CFM_COLOR; lr_Info.crTextColor := ColorToRGB(FclTextColor); SendMessageW(FhEditHandle, EM_SETCHARFORMAT, SCF_ALL, LPARAM(@lr_Info)); if not(lb_Modified) then begin FSetModified(False); end; // end; end; //背景色 procedure TMyCustomEditControl.FSetColor(Value: TColor); begin if (FclBkColor <> Value) then begin FclBkColor := Value; SendMessageW(FhEditHandle, EM_SETBKGNDCOLOR, 0, LPARAM(ColorToRGB(FclBkColor))); end; end; //ReadOnly procedure TMyCustomEditControl.FSetReadOnly(bReadOnly: Boolean); begin if (FbReadOnly <> bReadOnly) then begin FbReadOnly := bReadOnly; if (FbReadOnly) then begin SendMessageW(FhEditHandle, EM_SETREADONLY, 1, 0); end else begin SendMessageW(FhEditHandle, EM_SETREADONLY, 0, 0); end; end; end; //HideSelection procedure TMyCustomEditControl.FSetHideSelection(bHide: Boolean); var li_Style : Longint; begin if (FbHideSelection <> bHide) then begin FbHideSelection := bHide; li_Style := GetWindowLongW(FhEditHandle, GWL_STYLE); if (FbHideSelection) then begin //選択状態を保たない外観 if (LongBool(li_Style and ES_NOHIDESEL)) then Dec(li_Style, ES_NOHIDESEL); end else begin //選択状態を保ったままの外観 li_Style := li_Style or ES_NOHIDESEL; end; RecreateWnd(li_Style); end; end; //タブ設定 procedure TMyCustomEditControl.SetTabs(Tabs: array of Integer); //複数のタブ幅をセット可能 var i : Integer; begin SetLength(FTabs, High(Tabs)+1); for i := 0 to High(Tabs) do begin FTabs[i] := Tabs[i] * 4; end; FSetTabStops; end; //タブ設定 procedure TMyCustomEditControl.FSetTabStops; //F_Tabsを元に複数のタブ幅をセット可能 begin SendMessageW(FhEditHandle, EM_SETTABSTOPS, High(FTabs)+1, LPARAM(@FTabs[0])); end; //タブ設定 procedure TMyCustomEditControl.FSetTabs(iTabStop: Longint); //単一幅 begin SetTabs([iTabStop]); end; //タブ幅取得 function TMyCustomEditControl.FGetTabs: Longint; //戻り値が-1のときはタブ位置が複数セットされている begin if (High(FTabs) > 0) then begin Result := -1; end else if (High(FTabs) = 0) then begin Result := FTabs[0]; end else begin Result := 0; end; end; //------------------------------------------------------------------------------ // Show --- //表示 procedure TMyCustomEditControl.Show; begin ShowWindow(FhEditHandle, SW_SHOW); end; //非表示 procedure TMyCustomEditControl.Hide; begin ShowWindow(FhEditHandle, SW_HIDE); end; //フォーカスがあるか function TMyCustomEditControl.Focused: Boolean; begin Result := (Windows.GetFocus = FhEditHandle); end; //フォーカスをセットする procedure TMyCustomEditControl.SetFocus; begin Windows.SetFocus(FhEditHandle); end; //------------------------------------------------------------------------------ //テキストを返す function TMyCustomEditControl.FGetText: WideString; //http://72.14.235.132/search?q=cache:5lXXXH76vWcJ:jet2.u-abel.net/program/tips/re_uni.htm+%E3%83%AA%E3%83%83%E3%83%81%E3%82%A8%E3%83%87%E3%82%A3%E3%83%83%E3%83%88+CR+LF&cd=7&hl=ja&ct=clnk&client=opera var lr_Info : TGetTextEx; li_Len : Integer; lp_Buff : PWideChar; begin li_Len := (Length * 2) +2; FillChar(lr_Info, SizeOf(lr_Info), 0); lr_Info.cb := li_Len; lr_Info.flags := GT_USECRLF; lr_Info.codepage := 1200; lp_Buff := AllocMem(li_Len); try SendMessageW(FhEditHandle, EM_GETTEXTEX, WPARAM(@lr_Info), LPARAM(lp_Buff)); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; //テキストをセット procedure TMyCustomEditControl.FSetText(sText: WideString); begin SetWindowTextW(FhEditHandle, PWideChar(sText)); end; //カーソル位置を返す function TMyCustomEditControl.FGetCaretIndex: Integer; begin SendMessageW(FhEditHandle, EM_GETSEL, WPARAM(@Result), 0); end; //カーソル位置をセット procedure TMyCustomEditControl.FSetCaretIndex(iIndex: Integer); begin SendMessageW(FhEditHandle, EM_SETSEL, WPARAM(iIndex), LPARAM(iIndex)); end; //選択範囲の先頭を返す function TMyCustomEditControl.FGetSelStart: Integer; begin Result := FGetCaretIndex; end; //選択範囲の先頭をセット procedure TMyCustomEditControl.FSetSelStart(iIndex: Integer); var li_Start : Longint; li_End : Longint; begin li_Start := 0; li_End := 0; SendMessageW(FhEditHandle, EM_GETSEL, WPARAM(@li_Start), LPARAM(@li_End)); SendMessageW(FhEditHandle, EM_SETSEL, WPARAM(iIndex), LPARAM(@li_End)); end; //選択範囲の長さを返す function TMyCustomEditControl.FGetSelLength: Integer; var li_Start : Longint; li_End : Longint; begin li_Start := 0; li_End := 0; SendMessageW(FhEditHandle, EM_GETSEL, WPARAM(@li_Start), LPARAM(@li_End)); Result := li_End - li_Start; end; //選択範囲の長さをセット procedure TMyCustomEditControl.FSetSelLength(iCount: Integer); var li_Index : Integer; begin if (iCount >= 0) then begin //iCountがマイナスのときに左に向かって選択するということはしない li_Index := CaretIndex; SendMessageW(FhEditHandle, EM_SETSEL, WPARAM(li_Index), LPARAM(li_Index + iCount)); end; end; //選択されているか function TMyCustomEditControl.FGetSelected: Boolean; begin Result := (FGetSelLength > 0); end; procedure TMyCustomEditControl.FSetSelText(sStr: WideString); { >SelTextを設定すると選択したテキストを新しいテキストで置き換えることができます。 >範囲選択されていない編集コントロールにSelTextを設定するとカーソル位置に新しい文字列を挿入できます。 } begin if (Selected) then begin CutToClipboard; end; Insert(sStr); end; //選択文字列を取得する function TMyCustomEditControl.FGetSelText: WideString; begin Result := StrCopy; end; //変更されたか function TMyCustomEditControl.FGetModified: Boolean; begin Result := BOOL(SendMessageW(FhEditHandle, EM_GETMODIFY, 0, 0)); end; procedure TMyCustomEditControl.FSetModified(Value: Boolean); begin if (Value) then begin SendMessageW(FhEditHandle, EM_SETMODIFY, 1, 0); end else begin SendMessageW(FhEditHandle, EM_SETMODIFY, 0, 0); end; end; //全て削除 procedure TMyCustomEditControl.Clear; begin FSetText(''); end; //Undoできるか function TMyCustomEditControl.FGetCanUndo: Boolean; begin Result := BOOL(SendMessageW(FhEditHandle, EM_CANUNDO, 0, 0)); end; //元に戻すためのバッファをクリア procedure TMyCustomEditControl.ClearUndo; begin SendMessageW(FhEditHandle, EM_EMPTYUNDOBUFFER, 0, 0); end; //http://www.river.sannet.ne.jp/yuui/richedit.html //Undo 元に戻す procedure TMyCustomEditControl.Undo; begin SendMessageW(FhEditHandle, EM_UNDO, 0, 0); end; //Redoできるか function TMyCustomEditControl.FGetCanRedo: Boolean; begin Result := BOOL(SendMessageW(FhEditHandle, EM_CANREDO, 0, 0)); end; //Redo やり直し procedure TMyCustomEditControl.Redo; begin SendMessageW(FhEditHandle, EM_REDO, 0, 0); end; //切り取り procedure TMyCustomEditControl.CutToClipboard; begin CopyToClipboard; ClearSelection; end; //コピー procedure TMyCustomEditControl.CopyToClipboard; begin gpcStrToClipboard(StrCopy); end; //貼り付け procedure TMyCustomEditControl.PasteFromClipboard; begin SendMessageW(FhEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(gfnsStrFromClipboard))); end; //削除 procedure TMyCustomEditControl.ClearSelection; begin SendMessageW(FhEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(WideString('')))); end; //すべて選択 procedure TMyCustomEditControl.SelectAll; begin SendMessageW(FhEditHandle, EM_SETSEL, 0, -1); end; //挿入 procedure TMyCustomEditControl.Insert(sText: WideString); begin SendMessageW(FhEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(sText))); end; //貼り付けできるか function TMyCustomEditControl.CanPaste: Boolean; begin Result := SendMessageW(FhEditHandle, EM_CANPASTE, WPARAM(CF_TEXT), 0) <> 0; end; //文字列は空か function TMyCustomEditControl.Empty: Boolean; begin Result := FGetText = ''; end; { //バイト数を返す function TMyCustomEditControl.ByteLength: Integer; var lr_Info: TGetTextLengthEx; begin FillChar(lr_Info, SizeOf(lr_Info), 0); lr_Info.flags := GTL_USECRLF or GTL_CLOSE or GTL_NUMBYTES; lr_Info.codepage := 1200; Result := SendMessage(F_hEditHandle, EM_GETTEXTLENGTHEX, WPARAM(@lr_Info), 0); end; } //文字数を返す function TMyCustomEditControl.Length: Integer; //合成文字は2とカウントする var lr_Info: TGetTextLengthEx; begin FillChar(lr_Info, SizeOf(lr_Info), 0); lr_Info.flags := GTL_USECRLF or GTL_CLOSE or GTL_NUMCHARS; lr_Info.codepage := 1200; Result := SendMessage(FhEditHandle, EM_GETTEXTLENGTHEX, WPARAM(@lr_Info), 0); end; //文字列コピー function TMyCustomEditControl.StrCopy: WideString; var lr_Range : TCharRange; li_Len : Cardinal; lp_Buff : PWideChar; i : Integer; ls_Text : WideString; begin FillChar(lr_Range, SizeOf(lr_Range), 0); SendMessageW(FhEditHandle, EM_EXGETSEL, WPARAM(0), LPARAM(@lr_Range)); li_Len := (lr_Range.cpMax - lr_Range.cpMin + 1) * 2; lp_Buff := AllocMem(li_Len); try SendMessageW(FhEditHandle, EM_GETSELTEXT, 0, LPARAM(lp_Buff)); ls_Text := WideString(lp_Buff); finally FreeMem(lp_Buff); end; //改行コードをCRのみからCR+LFにする Result := ''; for i := 1 to System.Length(ls_Text) do begin case (ls_Text[i]) of #$D :begin Result := Result + #$A; end; #$A :begin end; else begin Result := Result + ls_Text[i]; end; end; end; end; function TMyCustomEditControl.StrCopy(iCount: Integer): WideString; begin Result := System.Copy(FGetText, FGetSelStart +1, iCount); end; function TMyCustomEditControl.StrCopy(iIndex, iCount: Integer): WideString; //iIndexは0ベース begin Result := System.Copy(FGetText, iIndex +1, iCount); end; procedure TMyCustomEditControl.Find; begin if (Selected) then begin Find(SelText); end; end; procedure TMyCustomEditControl.Find(sStr: WideString); var li_Len, li_Index: Integer; begin li_Len := System.Length(sStr); li_Index := FindText(sStr); if (li_Index > -1) then begin CaretIndex := li_Index; SelLength := li_Len; end else begin SysUtils.Beep; end; end; function TMyCustomEditControl.FindText(sStr: WideString): Integer; //http://yokohama.cool.ne.jp/chokuto/urawaza/message/EM_FINDTEXT.html var li_Opt : WPARAM; lr_FindText : TFindTextW; begin FillChar(lr_FindText, SizeOf(lr_FindText), 0); lr_FindText.lpstrText := PWideChar(sStr); li_Opt := 0; //検索の方向 if (FbFindForward) then begin //下に向かって検索 li_Opt := li_Opt or FR_DOWN; lr_FindText.chrg.cpMin := SelStart + SelLength; lr_FindText.chrg.cpMax := -1; end else begin //上に向かって検索 //cpMinは検索範囲の最後の文字を、cpMaxは最初の文字を指定する lr_FindText.chrg.cpMin := SelStart; //開始 lr_FindText.chrg.cpMax := 0; //終了 end; //単語検索 if (FbFindWholeWord) then begin li_Opt := li_Opt or FR_WHOLEWORD; end; //IgnoreCaseは大文字小文字を区別しない、FR_MATCHCASEは指定すると区別する //なのでnot(F_bFindIgnoreCase)でFR_MATCHCASEを指定 if not(FbFindIgnoreCase) then begin li_Opt := li_Opt or FR_MATCHCASE; end; Result := SendMessageW(FhEditHandle, EM_FINDTEXT, li_Opt, LPARAM(@lr_FindText)); end; procedure TMyCustomEditControl.SaveToFile(sFile: WideString); begin gpcFileWriteText(sFile, FGetText); FSetModified(False); end; procedure TMyCustomEditControl.LoadFromFile(sFile: WideString); begin FSetText(gfnsFileReadText(sFile)); end; //============================================================================== { TMyMemoControl } constructor TMyMemoControl.Create(winParent: TWinControl); begin FParent := winParent; FScrollBars := ssBoth; //両方あり FbLineHeight := False; //行間を開けない FbWordWrap := False; //折り返し無し Tabs := 0; //デフォルト(8) CreateWnd(WS_HSCROLL or WS_VSCROLL or ES_AUTOVSCROLL or ES_AUTOHSCROLL); end; constructor TMyMemoControl.Create(winParent: TWinControl; iStyle: DWORD); begin //親ウィンドウ FParent := winParent; //折り返し FbWordWrap := not(LongBool(iStyle and ES_AUTOHSCROLL)); //スクロールバー if (LongBool(iStyle and WS_HSCROLL)) or (LongBool(iStyle and WS_VSCROLL)) then begin if not(LongBool(iStyle and WS_HSCROLL)) then begin FScrollBars := ssVertical; end else if not(LongBool(iStyle and WS_VSCROLL)) then begin FScrollBars := ssHorizontal; end else begin FScrollBars := ssBoth; end; end else begin FScrollBars := ssNone; end; CreateWnd(iStyle); end; procedure TMyMemoControl.CreateWnd(iStyle: Longint); begin if (High(FTabs) < 0) then begin SetLength(FTabs, 1); FTabs[0] := 8 * 4; end; //スクロールバーのセット case FScrollBars of ssNone :begin //スクロールバーなし if (LongBool(iStyle and WS_VSCROLL)) then begin Dec(iStyle, WS_VSCROLL); end; if (LongBool(iStyle and WS_HSCROLL)) then begin Dec(iStyle, WS_HSCROLL); end; end; ssHorizontal :begin //下端にだけスクロールバーを付ける //垂直スクロールバーはなし iStyle := iStyle or WS_HSCROLL; if (LongBool(iStyle and WS_VSCROLL)) then begin Dec(iStyle, WS_VSCROLL); end; end; ssVertical :begin //右端にだけスクロールバーを付ける //水平スクロールバーはなし if (LongBool(iStyle and WS_HSCROLL)) then begin Dec(iStyle, WS_HSCROLL); end; iStyle := iStyle or WS_VSCROLL; end; ssBoth :begin //下端と右端の両方にスクロールバーを付ける iStyle := iStyle or WS_HSCROLL; iStyle := iStyle or WS_VSCROLL; end; end; if (FbWordWrap) and (LongBool(iStyle and WS_HSCROLL)) then begin Dec(iStyle, WS_HSCROLL); end; //TMyCustomEditControl.Createを呼んでいる inherited Create(FParent, ES_MULTILINE or ES_WANTRETURN or $8000{ES_WANTTAB} or iStyle); end; //退避した設定値を戻す procedure TMyMemoControl.RestoreValue; begin FSetLineHeight; //行間の復元 inherited RestoreValue; end; //スクロールバーの変更 procedure TMyMemoControl.SetScrollBars(Value: TScrollStyle); var li_Style: Longint; begin if (FScrollBars <> Value) then begin li_Style := GetWindowLongW(Handle, GWL_STYLE); FScrollBars := Value; case FScrollBars of ssNone :begin //スクロールバーなし if (LongBool(li_Style and WS_VSCROLL)) then begin Dec(li_Style, WS_VSCROLL); end; if (LongBool(li_Style and WS_HSCROLL)) then begin Dec(li_Style, WS_HSCROLL); end; end; ssHorizontal :begin //下端にだけスクロールバーを付ける li_Style := li_Style or WS_HSCROLL; //垂直スクロールバーはなし if (LongBool(li_Style and WS_VSCROLL)) then begin Dec(li_Style, WS_VSCROLL); end; end; ssVertical :begin //右端にだけスクロールバーを付ける //水平スクロールバーはなし if (LongBool(li_Style and WS_HSCROLL)) then begin Dec(li_Style, WS_HSCROLL); end; li_Style := li_Style or WS_VSCROLL; end; ssBoth :begin //下端と右端の両方にスクロールバーを付ける li_Style := li_Style or WS_HSCROLL; li_Style := li_Style or WS_VSCROLL; end; end; RecreateWnd(li_Style); end; end; //右端で折り返す procedure TMyMemoControl.SetWordWrap(Value: Boolean); var li_Style: Longint; begin if (FbWordWrap <> Value) then begin li_Style := GetWindowLongW(Handle, GWL_STYLE); FbWordWrap := Value; if (FbWordWrap) then begin //折り返す if (LongBool(li_Style and ES_AUTOHSCROLL)) then begin Dec(li_Style, ES_AUTOHSCROLL); end; if (FScrollBars = ssBoth) or (FScrollBars = ssHorizontal) then begin //水平スクロールバーが出ていたら隠す if (LongBool(li_Style and WS_HSCROLL)) then begin Dec(li_Style, WS_HSCROLL); end; end; end else begin //折り返さない li_Style := li_Style or ES_AUTOHSCROLL; if (FScrollBars = ssBoth) or (FScrollBars = ssHorizontal) then begin //水平スクロールバーを出す設定であったら出す li_Style := li_Style or WS_HSCROLL; end; end; if (FScrollBars = ssBoth) or (FScrollBars = ssVertical) then begin //何も読み込んでいない場合以下の二つはli_Styleにセットされていないのでセットする li_Style := li_Style or ES_AUTOVSCROLL or WS_VSCROLL; end; RecreateWnd(li_Style); end; end; //行間の変更 procedure TMyMemoControl.FSetLineHeight; var li_Opt : Integer; begin //http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200904/09040031.txt li_Opt := SendMessageW(Handle, EM_GETLANGOPTIONS, 0, 0); if (FbLineHeight) then begin //行間を開ける if ((li_Opt and IMF_UIFONTS) <> 0) then begin Dec(li_Opt, IMF_UIFONTS); end; end else begin //Memoと同じ行間にする li_Opt := li_Opt or IMF_UIFONTS; end; SendMessageW(Handle, EM_SETLANGOPTIONS, 0, LPARAM(li_Opt)); end; procedure TMyMemoControl.SetLineHeight(Value: Boolean); begin //http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200904/09040031.txt if (FbLineHeight <> Value) then begin FbLineHeight := Value; BackupValue; RestoreValue; //←の中で行間のセットを行っている end; end; function TMyMemoControl.FGetCount: Integer; //行数を返す begin Result := SendMessageW(Handle, EM_GETLINECOUNT, 0, 0); end; function TMyMemoControl.FGetCurrentLine: Integer; //カーソルのある行を返す。 //最初の行は0。 begin Result := SendMessageW(Handle, EM_LINEFROMCHAR, WPARAM(-1), 0); end; function TMyMemoControl.FGetColumn: Integer; //カーソルの位置を行頭からの文字数で返す。 //カーソルが行頭にあるときは0を返す。 begin Result := CaretIndex - SendMessageW(Handle, EM_LINEINDEX, -1, 0); end; function TMyMemoControl.GetLine(iIndex: Integer): WideString; //iIndex行の文字列を返す。 var lp_Buff: PWideChar; li_Head, li_Len: Integer; begin iIndex := gfniNumLimit(iIndex, -1, FGetCount-1); //F_GetCountは1ベースの行数、iIndexは0ベースのインデックスなので-1 //iIndex行の頭の文字インデックスを取得 li_Head := SendMessageW(Handle, EM_LINEINDEX, WPARAM(iIndex), 0); //iIndexが現在のカーソル位置を示す値(-1)の場合EM_GETLINEではうまくいかないのでカーソル行のインデックスを取得 if (iIndex = -1) then begin iIndex := SendMessageW(Handle, EM_LINEFROMCHAR, WPARAM(li_Head), 0); end; //取得したい行の文字数を取得 li_Len := SendMessageW(Handle, EM_LINELENGTH, WPARAM(li_Head), 0); lp_Buff := AllocMem((li_Len +1) * 2); try lp_Buff[0] := WideChar(li_Len); SendMessageW(Handle, EM_GETLINE, WPARAM(iIndex), LPARAM(lp_Buff)); Result := WideString(lp_Buff); finally FreeMem(lp_Buff); end; end; function TMyMemoControl.Empty: Boolean; begin //SendMessageW(Handle, EM_GETLINECOUNT, 0, 0)は1未満になることはない if (SendMessageW(Handle, EM_GETLINECOUNT, 0, 0) > 1) then begin Result := False; end else if (Text <> '') then begin Result := False; end else begin Result := True; end; end; function TMyMemoControl.StrCopy(iCount: Integer): WideString; begin Result := StrCopy(FGetCurrentLine, FGetColumn, iCount); end; function TMyMemoControl.StrCopy(iLine, iIndex, iCount: Integer): WideString; { iLine行のiIndex文字からiCount文字をコピーして返す。 iLine, iIndexは0ベース。 CurrentLineやColumnと併用しやすい。 } var ls_Str: WideString; begin ls_Str := GetLine(iLine); Result := System.Copy(ls_Str, iIndex +1, iCount); end; function TMyMemoControl.FGetTopIndex: Integer; { 見えている一番最初の行のインデックスを返す。 http://yokohama.cool.ne.jp/chokuto/urawaza/message/EM_GETFIRSTVISIBLELINE.html } begin Result := SendMessageW(Handle, EM_GETFIRSTVISIBLELINE, 0, 0); end; procedure TMyMemoControl.FSetTopIndex(iIndex: Integer); { 見える範囲の一番最初の行をセットする 折り返しがあり2行にわたる行は1ではなく2とカウントされることに注意。 } var li_Scroll: Integer; begin li_Scroll := iIndex - FGetTopIndex; SendMessageW(Handle, EM_LINESCROLL, 0, LPARAM(li_Scroll)); end; //============================================================================== initialization lhRichEditModule := 0; finalization if (lhRichEditModule <> 0) then begin FreeLibrary(lhRichEditModule); end; end.