|
|
|
| Home | Delphi |
| アンダーラインの長さを WrapByte に合わせたい |
|
DrawUnderLine を override した新しいコンポーネントを作成します。
type
TEEditor = class(TEditor)
protected
procedure DrawUnderLine(ARow: Integer); override;
end;
procedure TEEditor.DrawUnderLine(ARow: Integer);
var
X, Y: Integer;
begin
if WordWrap then
begin
if LeftScrollWidth > WrapOption.WrapByte * ColWidth then
Exit;
Y := UnderLinePos(ARow);
if Y <> -1 then
begin
X := WrapOption.WrapByte * ColWidth - LeftScrollWidth;
CaretBeginUpdate;
try
with Canvas do
begin
Pen.Style := psSolid;
Pen.Color := Marks.Underline.Color;
MoveTo(Margin.Left, Y);
LineTo(Margin.Left + X, Y);
// ver 1.70 以降の場合 ////////
MoveTo(LeftMargin, Y);
LineTo(LeftMargin + X, Y);
///////////////////////////////
end;
finally
CaretEndUpdate;
end;
end;
end
else
inherited DrawUnderLine(ARow);
end;
| WrapByte に応じた改行ライン(縦線)を出したい |
|
HideUnderline, Paint を override した新しいコンポーネントを作成します。
type
TEEditorEditor = class(TEditor)
protected
procedure HideUnderline(ARow: Integer); override;
procedure Paint; override;
end;
procedure TEEditor.HideUnderline(ARow: Integer);
var
X, Y: Integer;
begin
if WordWrap then
begin
if LeftScrollWidth > WrapOption.WrapByte * ColWidth then
Exit;
Y := UnderlinePos(ARow);
if Y <> -1 then
begin
X := WrapOption.WrapByte * ColWidth - LeftScrollWidth;
CaretBeginUpdate;
try
with Canvas do
begin
Pen.Style := psSolid;
Pen.Color := Color;
MoveTo(Margin.Left, Y);
LineTo(Margin.Left + X, Y);
// ver 1.70 以降の場合 ////////
MoveTo(LeftMargin, Y);
LineTo(LeftMargin + X, Y);
///////////////////////////////
end;
finally
CaretEndUpdate;
end;
end;
end
else
inherited HideUnderline(ARow);
end;
procedure TEEditor.Paint;
var
X: Integer;
begin
inherited;
if WordWrap then
begin
X := Margin.Left + WrapOption.WrapByte * ColWidth - LeftScrollWidth;
// ver 1.70 以降の場合 ////////
X := LeftMargin + WrapOption.WrapByte * ColWidth - LeftScrollWidth;
///////////////////////////////
with Canvas do
begin
Pen.Color := clAqua; // as you like
MoveTo(X, Margin.Top);
// ver 1.70 以降の場合 ////////
MoveTo(X, TopMargin);
///////////////////////////////
LineTo(X, Height);
end;
end;
end;
| RowToLines と反対の LinesToRow が欲しい |
|
TEditor.Lines に実装されていますが、protected メソッドなので、
type
TMyEditorStrings = class(TEditorStrings); としておいて
Result := TMyEditorStrings(Editor1.Lines).LinesToRow(Index);
とすることで、取得出来ます。
| <, > で囲まれた文字列内の " " で囲まれた文字列だけを別色表示したい |
|
with Editor1.View.Brackets do
begin
Add;
BracketItems[0].LeftBracket := '<!--';
BracketItems[0].RightBracket := '-->';
BracketItems[0].ItemColor.BkColor := clWhite;
BracketItems[0].ItemColor.Color := clGray;
Add;
BracketItems[1].LeftBracket := '<';
BracketItems[1].RightBracket := '>';
BracketItems[1].ItemColor.BkColor := clWhite;
BracketItems[1].ItemColor.Color := clBlue;
end;
の状態で、View.Quatation に " を指定して、
View.Colors.Str は普通の色に設定します。
procedure TForm1.Editor1DrawLine(Sender: TObject;
LineStr: string; X, Y, Index: Integer;
ARect: TRect; Selected: Boolean);
var
Parser, Parser2: TEditorParser;
S: String;
begin
Parser := TEditorParser.CreateWithEditor(
LineStr, Editor1, Editor1.ListBracket[Index]);
try
while Parser.Token <> toEof do
begin
if (Parser.Token = toBracket) and
(Parser.DrawBracketIndex = 1) then
begin
S := Parser.TokenString;
Parser2 := TEditorParser.CreateWithEditor(
S, Editor1, InvalidBracketIndex);
try
while Parser2.Token <> toEof do
begin
if Parser2.Token = toString then
begin
if Selected then
begin
Editor1.Canvas.Brush.Color :=
Editor1.View.Colors.Select.BkColor;
Editor1.Canvas.Font.Color :=
Editor1.View.Colors.Select.Color;
end
else
begin
Editor1.Canvas.Brush.Color := Editor1.Color;
Editor1.Canvas.Font.Color := clRed; // as you like
end;
Editor1.DrawTextRect(
ARect,
X +
(Parser.SourcePos + Parser2.SourcePos) *
Editor1.ColWidth,
Y,
Parser2.TokenString, ETO_CLIPPED);
end;
Parser2.NextToken;
end;
finally
Parser2.Free;
end;
end;
Parser.NextToken;
end;
finally
Parser.Free;
end;
end;
解説
toBracket が返った時に、<, > で囲まれた文字列 ( Parser.TokenString ) をさらに分解して、その中に " で囲まれた 文字列が無いかどうかを判別します。この時は、toBracket が返ら ないように、InvalidBracketIndex を CreateWithEditor に渡して います。toBracket は返りませんが、View プロパティへの設定は 尊重されるので、toString が返ります。
toString が返ったら、Parser2.TokenString は、<, > で囲 まれた文字列の中にある「"」で囲われた文字列ですので、文字色 を指定してから描画しています。
ver 1.63, ver 1.70 以降の TEditor では、TEditorParser の仕様が 変わり、受け取った文字列を PChar にキャストしてパースしています。 (以前のバージョンでは一旦領域確保を行ってコピーしていました) ですので、今回のようにネストしたパーシングを行う場合は一旦 String 型 の変数に Parser.TokenString をコピーしてから処理を進めるように して下さい。
ver 2.00 以降の TEditorParser は、toString を返さず、toQuotation という トークンを返して来ます。ver 2.00 以降を利用される場合は、上記 toString を toQuotation に置き換えて下さい。
| TEditor 付属サンプルの HtSearch.pas を利用して検索置換機能を実装したソフトを配布しても良いのでしょうか |
|
全然問題ありません。どうぞご自由にお使い下さい。
| HtSearch.pas 内の検索オプションの解説 |
|
TSearchOption = (sfrDown, sfrMatchCase, sfrWholeWord, sfrNoMatchZenkaku, sfrReplace, sfrReplaceAll, sfrReplaceConfirm, sfrIncludeCRLF, sfrIncludeSpace, sfrWholeFile);
| sfrDown | 前方検索指定。これが無いと後方検索となります。 |
| sfrMatchCase | 大文字小文字を区別するしない |
| sfrWholeWord | 単語単位での検索。Delphi という文字列を検索する場合、このオプ ションが指定されていると「Delphiの神託」という文字列があっても ヒットしません。「 Delphi の神託」だとヒットします。デリミタで 区切られた独立した文字列として完全に合致するものというオプショ ンです。 |
| sfrNoMatchZenkaku | 全角半角区別無し検索です。Delphi で Delphi や Delphi にヒットします。 |
| sfrReplace | 置き換えダイアログでユーザーが「置き換え」 ボタンをクリックしたという意味に使用します |
| sfrReplaceAll | 置き換えダイアログでユーザーが「すべて」ボタンをクリックした時に セットされる(するべき?)オプションです |
| sfrReplaceConfirm | このオプションがセットされている場合は、置き換えを行うとき 置き換えますかの確認ダイアログが出る(というかプログラマが出すと いうか^^;) |
| sfrIncludeCRLF |
検索文字列に改行が含まれていてもヒットするぞというオプションです。
Del phi にもヒットします |
| sfrIncludeSpace |
空白文字 #$20 が含まれていてもヒットします。
Del phiにもヒットします。 sfrIncludeCRLF と sfrIncludeSpace はセットで使用すると強力です。 |
| sfrWholeFile | 拙作 HelpTool.exe 用そのままなので、その名残りです(^^;) アウトラインエディタの選択中のノードデータ内でのみ検索するか そのノード以降の(あるいは以前の)ノードに対しても検索するか というオプションです。 |
| マウスでのカット&ペーストに対応して欲しい |
|
というご要望が多かったので、現在ここで公開されている ver 1.12 からは、 デフォルトのポップアップメニューを装備しています。お試し下さい。 DownLoad ページ
| TEditer のプロパティーエディタをプログラムから呼び出して使用する |
|
ユニット HViewEdt.pas には、
function EditEditor(Editor: TEditor; Option: TPersistent): Boolean;
function EditEditorProp(EditorProp: TEditorProp; Option: TPersistent): Boolean;
という関数が用意されていますので、そのまま使用出来ます。
Option に渡されるオブジェクトを以下のように判別して、
プロパティエディタのアクティブになるページを指定しています。
if FOption is TEditorBracketCollection then
PageControl1.ActivePage := TabSheet3
else
if FOption is TEditorCaret then
PageControl1.ActivePage := TabSheet1
else
if FOption is TEditorWrapOption then
PageControl1.ActivePage := TabSheet5
else
PageControl1.ActivePage := TabSheet2;
<使用例>
uses
HViewEdt;
procedure TForm1.Button1Click(Sender: TObject);
begin
EditEditor(Editor1, nil);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if EditEditorProp(EditorProp1, nil) then
EditorProp1.AssignTo(Editor);
end;
| 文字列が無くても横スクロールバーが出て変 |
|
そういう仕様です。ソースコード内の InitScroll でスクロールバーを
設定しているのですが、横スクロールバーは「8000 ピクセル÷フォントの巾」
で固定になっています。それ以上はスクロールも表示もされません。
文字列長に横スクロールバーを合わせるためには、文字列に変更が
ある毎に、全行スキャンと最大値取得が必要になるので、やってい
ません。
| Delphi 5 では DsgnIntf.pas が実行時パッケージから削除され、実行時にプロパティエディタを呼び出せなくなった |
|
ver 1.21 から、プロパティエディタ関連のクラスを別ユニットにすることで 対応しました。私はまだD5を持っていないので、動作確認は出来ていません。 動作確認のご報告などを頂けるとありがたいです。m(_ _)m
| 文字列の行数に応じて縦スクロールバーをオンオフする |
|
OnChange イベントで以下のようにします。
procedure TForm1Editor1Change(Sender: TObject);
begin
if Editor1.ListCount > Editor1.RowCount then
Editor1.ScrollBars := ssVertical
else
Editor1.ScrollBars := ssNone;
end;
| 改行マーク以降を選択しないようにする |
|
procedure TForm1.Editor1DrawLine(Sender: TObject; LineStr: string; X, Y,
Index: Integer; ARect: TRect; Selected: Boolean);
var
i, iX, iW : Integer;
S : String;
begin
if Selected then
begin
Editor1.Canvas.Brush.Color := Editor1.Color;
iX := X + (Editor1.ColWidth * (Length(LineStr) + 1));
iW := (Editor1.Width div Editor1.ColWidth) - (Length(LineStr) + 1);
S := StringOfChar(' ', iW + 1);
Editor1.DrawTextRect(ARect, iX, Y, S, 0);
end;
end;
| TEditorProp の設定をファイル出力する |
|
TEditorProp コンポを拡張するなどして、以下のメソッドを追加します。
procedure TEditorProp.SaveToFile(const FileName:String);
var
Ms: TMemoryStream;
begin
Ms := TMemoryStream.Create;
try
Ms.WriteComponent(Self);
Ms.Position := 0;
Ms.SaveToFile(FileName);
finally
Ms.Free;
end;
end;
procedure TEditorProp.LoadFromFile(const FileName:String);
var
Ms: TMemoryStream;
begin
FReserveWordList.Clear;
FView.Brackets.Clear;
FView.HexPrefix := '';
FView.Quotation := '';
FView.Commenter := '';
FWrapOption.FollowStr := '';
FWrapOption.LeadStr := '';
FWrapOption.PunctuationStr := '';
Ms := TMemoryStream.Create;
try
Ms.LoadFromFile(FileName);
Ms.Position := 0;
if Ms.Size > 0 then
Ms.ReadComponent(Self);
finally
Ms.Free;
end;
end;
| コメント行が折り返し表示されている場合、3行目以降が指定した色で描画されない |
|
これは、描画速度を得るために描画すべき文字列の取得で手を抜いている仕様
から発生する現象です。回避するためには、PaintLine メソッドを書き換える
必要があります。
// wrapped line
if WordWrap and
(Index > 0) and (FList.Rows[Index - 1] = raWrapped) then
begin
BracketIndex := FList.Brackets[Index - 1];
Buf := FList[Index - 1];
X := X - Length(Buf) * FFontWidth;
S := Buf + S;
end;
となっているところを
// wrapped line
if WordWrap and
(Index > 0) and (FList.Rows[Index - 1] = raWrapped) then
begin
BracketIndex := FList.Brackets[FList.RowStart(Index)];
for I := Index - 1 down to FList.RowStart(Index) do
begin
Buf := FList[I];
X := X - Length(Buf) * FFontWidth;
S := Buf + S;
end;
end;
とします。
これで、折り返し表示された長〜いコメント行も、指定した色で描画される
ようになります。描画速度はかなり落ちますが悪しからず。
| ホイールマウスへの対応は |
|
現在 TEditor はホイールマウスによるスクロールには対応していません。
フォームに WM_MOUSEWHEEL メッセージハンドラを追加して下さい。
type
TForm1 = class(TForm)
private
procedure WMMousewheel(var Msg: TMessage); message WM_MOUSEWHEEL;
procedure TForm1.WMMousewheel(var Msg: TMessage);
begin
if (Msg.WParam > 0) then
begin
{ ホイールを奥に動かした時の処理 }
Sendmessage(Editor1.Handle, WM_VSCROLL, SB_LINEUP, 0);
//ページスクロールの場合は下を使用
// Sendmessage(Editor1.Handle, WM_VSCROLL, SB_PAGEUP, 0);
end
else
begin
{ ホイールを手前に動かした時の処理 }
Sendmessage(Editor1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
//ページスクロールの場合は下を使用
// Sendmessage(Editor1.Handle, WM_VSCROLL, SB_PAGEDOWN, 0);
end;
end;
| 半角スペースを明示するには |
|
TEditorParser は半角スペースを認識しませんので、まず以下のようなパーサー
クラスを宣言&実装します。場所は Editor1DrawLine イベントハンドラの
直前で構いません。
type
TMyParser = class(TEditorParser)
protected
procedure SkipBlanks; override;
end;
procedure TMyParser.SkipBlanks;
begin
while True do
begin
case FSourcePtr^ of
#0:
Exit;
#9:
Exit;
// #33..#255:
#32..#255: // 半角スペースも認識させる
Exit;
end;
Inc(FSourcePtr);
end;
end;
後は、サンプルプロジェクトの unit2 を参考にして Editor1DrawLine
イベントハンドラを記述しますが、その際、生成するパーサーを上記
TMyParser に差し替えます。
unit2 では、Parser := TEditorParser.Create(S); となっているところを
Parser := TMyParser.Create(S); とします。
TMyParser は半角スペースを toSymbol として返して来るように
なりますので、半角マークの描画処理を行うようにします。
| デフォルトのポップアップメニューのショートカットを変更したい |
|
TEditor を拡張します。具体的には、CreateMenuItem を override した
TMyEditorPopupmenu を宣言しておいて、TMyEditor では、CreatePopupMenu
を override して、この TMyEditorPopupmenu を生成して返すようにします。
//////////////////////////////////////////////////////////////////////
unit MyEditor;
interface
uses
Classes, Menus, HEditor;
type
TMyEditorPopupMenu = class(TEditorPopupMenu)
protected
procedure CreateMenuItem; override;
end;
TMyEditor = class(TEditor)
protected
function CreatePopupMenu: TPopupMenu; override;
end;
procedure Register;
implementation
procedure TMyEditorPopupMenu.CreateMenuItem;
begin
inherited CreateMenuItem;
FUndo.ShortCut := TextToShortCut('Ctrl+Z');
FRedo.ShortCut := TextToShortCut('Ctrl+A');
FCut.ShortCut := TextToShortCut('Ctrl+X');
FCopy.ShortCut := TextToShortCut('Ctrl+C');
FPaste.ShortCut := TextToShortCut('Ctrl+V');
FBoxPaste.ShortCut := TextToShortCut('Ctrl+B');
FSelMode.ShortCut := TextToShortCut('Ctrl+K');
// ↑をお好きな設定で書き換えます。
end;
function TMyEditor.CreatePopupMenu: TPopupMenu;
begin
Result := TMyEditorPopupMenu.Create(Self);
TMyEditorPopupMenu(Result).FEditor := Self;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyEditor]);
end;
end.
//////////////////////////////////////////////////////////////////////
以上のユニットファイルをコンポーネントインストールすると samples ページに TMyEditor が登録されます。
| バージョンの異なる TEditor をプロジェクトに混在させるとエラーになる |
|
まずメインに使いたいバージョンの TEditor コンポを Delphi に
インストールします。その状態で TEditor が貼り付けられている
フォームを総て開きます。
「プロパティが無い」旨のエラーが出る場合は、「総て無視」
ボタンをクリックして開きます。この状態でフォームの上に居るの
は該当バージョンの TEditor になっていますので、一度全部保存
します。後は「プロジェクトの再構築」を行って頂ければ大丈夫です。
Delphi にコンポーネントをインストールすることは、Delphi に
そのコンポの遺伝子情報を伝えることになります。この情報はパッ
ケージに保存されます。フォームにコンポを貼り付けた瞬間に、
Delphi はこの情報を元にコンポを生成しています。このフォーム
を保存すると、.dfm ファイルには、コンポのクラス名とそのプロ
パティ値が保存されます。
Delphi がこの .dfm ファイルを開く時ですが、まずクラス名を
読み込んで、Delphi が知っている遺伝子情報を元にそのクラスの
コンポを生成します。(この時 Delphi が知らないクラス名だった
場合エラーになります。該当コンポをインストールする前にそのコ
ンポが貼り付けられたフォームを開こうとしてエラーが発生するの
はこのためです。)次に、.dfm ファイルからプロパティ値を一つ
ずつ読み込んでは生成したコンポのプロパティ値を設定して行きま
す。この時、遺伝子情報には書き込まれていないプロパティ値を指
定されるとエラーになります。
今回の場合、新しいバージョンの TEditor を貼り付けたフォー
ムがプロジェクト内にあって、(例えば Caret.AutoCursor などが書
き込まれた .dfm が存在する)コンパイルする時点でインストール
されていたのが古いバージョンの TEditor だったのではないかと思
います。その .exe に織り込まれた TEditor の遺伝子情報には
Caret.AutoCursor プロパティが無いためだと思います。
| HtSearch.pas の TSearchInfo について |
|
HtSearsh.pas 内の SearchText 関数に渡す TSearchInfo 型の引数には
その Start に SelStart を、Length には SelLength を指定して渡します。
Start には SelStart を、Length には SelLength を指定します。
^^^
上記文字列の↑の部分が選択された状態から 'Sel' を検索する
場合、検索開始位置を Sel の次に移動するためのパラメーターと
して渡します。
選択されていない場合は 0 を渡すことで SelStart の Sel にヒ
ットします。選択されている場合は 3 を渡すことで検索開始位置
がその分シフトされるので、SelLength の Sel にヒットするよう
になります。
| 選択領域を移動した後、選択状態を復帰するには |
|
Drag&Drop を実装すると可能になります。サンプルプロジェクトの Editor6 での
実装例を示します。unit2.pas を以下のように変更して下さい。
TForm2 の private セクションに、ドラッグされたことを保持する
フラグを用意します。
.............
private
FEditor6Dragging: Boolean; // Reselection
// Dragging されたかどうかを保持するフラグ
// Editor6DragOver で設定 Editor6EndDrag で解除
FHintWindow: THintWindow;
.............
次に、Editor6DragOver, Editor6DragDroop, Editor6EndDrag を以下のように
変更します
procedure TForm2.Editor6DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
R, C: Integer;
begin
if (Sender is TEditor) and (Source is TEditor) then
with TEditor(Sender) do
begin
FEditor6Dragging := True; // Reselection Dragging フラグ設定 Editor6EndDrag で解除
// 上に行った時はスクロールする
if Y <= TopMargin then
Row := Row - 1;
// ドラッグオブジェクトにキャレットを追随させる
// ここでも、False を渡すミソ1
PosToRowCol(X, Y, R, C, False);
SetRowCol(R, C);
Accept := True;
end;
end;
// ミソ1については、IsSelectedArea, PosToRowCol のヘルプを参照して下さい。
procedure TForm2.Editor6DragDrop(Sender, Source: TObject; X, Y: Integer);
var
Length: Integer;
InSel: Boolean;
begin
if (Sender is TEditor) and (Source is TEditor) then
with TEditor(Sender) do
begin
InSel := IsSelectedArea(Row, Col); // Reselection
if Source = Sender then
begin
Length := SelLength; // Reselection
// 自身のデータを移動又はコピー
if GetKeyState(VK_CONTROL) < 0 then
// ssCtrl キーが押されている場合はコピー
CopySelection(Row, Col)
else
// 移動
MoveSelection(Row, Col);
end
else
begin
Length := TEditor(Source).SelLength; // Reselection
// 他人のデータなので選択状態の場合は解除してから
// キャレット位置へ他人の選択領域文字列を挿入する
CleanSelection;
SetSelTextBuf(PChar(TEditor(Source).SelText));
end;
// Reselection
if FEditor6Dragging then
if InSel then
// 選択領域内にドロップされた場合
CleanSelection
else
begin
// 再選択処理
SelStart := SelStart - Length;
SelLength := Length;
end;
end;
end;
procedure TForm2.Editor6EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
// BeginDrag(False) した後、マウスを動かすことなくドロップ
// した場合のための処理
if (Sender is TEditor) and not FEditor6Dragging then // Reselection
TEditor(Sender).CleanSelection;
FEditor6Dragging := False; // Reselection フラグ解除
end;
| C++Builder 5 で TEditor を利用するには |
|
以下は掲示板からの引用です。
-------------------------------------------------------------------------------
1.パッケージの新規作成&名前を付けて保存(HEdit.bpk)
2.ユニットの追加(Heditreg.pas)
3.コンパイル済みパッケージの追加(vclx50.bpi, vclsmp50.bpi)
4.ユニットの追加(dsgnintf.pas)
5.コンパイル&インストール
DsgnIntfが見つかりませんでしたというエラーになるので、pasを
追加してます。でも、必須パッケージvcl50に見つかりましたので
削除しますというメッセージもでます。
1. HEdit165.LZH を解凍し、すべてのファイルをHEditor 専用のディレクトリに格納
2. 「コンポーネントのインストール」の「新規パッケージに追加」で、「パッケージフ
ァイル名」を HEdit.bpk(これも何でもよい) に、また、「ユニットファイル名」に
HEditReg.pas を指定
3. ここでコンパイルすると、「DsgnIntf ファイルが見つかりません」のエラー
4. DsgnIntf.pas を追加して、再コンパイル
5. 「削除:dsgnintf ユニットは必須パッケージ vcl50 の中に見つかりました」のメッ
セージ
6. そのまま「OK」すると、[Pascal ヒント] が 2 つ、[リンカ エラー]が 8 つでる。リ
ンカエラーは Colorgrd と spin が関係する「外部シンボルが未解決」です
7. 次に、Requires に $(BCB)\Lib\Debug にある vclsmp50.bpi と vclx50.bpi を追加し
、再々度コンパイル
8. で、コンパイルは完了
9. 「パッケージのインストール」で、$(BCB)\Projects\Bpl にある HEdit.bpl を指定す
ると、インストール完了
-------------------------------------------------------------------------------
| OnResize イベントで WrapByte を更新する |
|
TEditor で OnResize イベントが発生した時点では、ColCount プロパティ
が、まだ更新されていないので、イベントハンドラの中で ColCount 値を
取得する必要があります。
procedure TForm1.Editor1Resize(Sender: TObject);
var
W: Integer;
begin
if Editor1.ColWidth <> 0 then
begin
W := Editor1.Width - Editor1.LeftMargin - // 又は Editor1.Margin.Left -
Editor1.ColWidth div 2;
if Editor1.ScrollBars in [ssVertical, ssBoth] then
W := W - GetSystemMetrics(SM_CYVSCROLL);
if Editor1.Marks.WrapMark.Visible then
Editor1.WrapOption.WrapByte := W div Editor1.ColWidth - 2
else
Editor1.WrapOption.WrapByte := W div Editor1.ColWidth;
end;
| カーソル行を別の色・フォントで表示する |
|
DrawUnderline, HideUnderline を override した TEditor 拡張コンポを
作成します。また、色・フォント情報を保持するためのフィールドを用意します。
unit Editorx;
interface
uses
Windows, Classes, Graphics, heFountain, HEditor;
type
TEditorx = class(TEditor)
private
FCursorlineColor: TFountainColor;
FCursorlineDraw: Boolean;
procedure SetCursorlineColor(Value: TFountainColor);
procedure SetCursorlineDraw(Value: Boolean);
protected
procedure CursorlineChanged(Sender: TObject); virtual;
procedure DrawUnderline(ARow: Integer); override;
procedure HideUnderline(ARow: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property CursorlineColor: TFountainColor read FCursorlineColor write SetCursorlineColor;
property CursorlineDraw: Boolean read FCursorlineDraw write SetCursorlineDraw;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('TEditor', [TEditorx]);
end;
constructor TEditorx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCursorlineColor := TFountainColor.Create;
FCursorlineColor.OnChange := CursorlineChanged;
FCursorlineColor.BkColor := Color;
FCursorlineColor.Color := Font.Color;
FCursorlineColor.Style := [fsBold];
end;
destructor TEditorx.Destroy;
begin
FCursorlineColor.Free;
inherited Destroy;
end;
procedure TEditorx.CursorlineChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TEditorx.SetCursorlineColor(Value: TFountainColor);
begin
if Value <> nil then
FCursorlineColor.Assign(Value);
end;
procedure TEditorx.SetCursorlineDraw(Value: Boolean);
begin
if FCursorlineDraw <> Value then
begin
FCursorlineDraw := Value;
Invalidate;
end;
end;
procedure TEditorx.DrawUnderline(ARow: Integer);
var
Y: Integer;
R: TRect;
S: String;
begin
if not FCursorlineDraw then
inherited DrawUnderline(ARow)
else
if Showing then
begin
Y := UnderlinePos(ARow);
if Y <> -1 then
begin
CaretBeginUpdate;
try
// フォントを設定
Canvas.Font.Style := FCursorlineColor.Style;
Canvas.Font.Color := FCursorlineColor.Color;
Canvas.Brush.Color := FCursorlineColor.BkColor;
// 該当行文字列を取得
S := ExpandListStr(ARow);
// 描画領域を設定
R := Rect(LeftMargin, Y - FontHeight, LeftMargin - LeftScrollWidth + Length(S) * ColWidth, Y);
// 描画
DrawTextRect(R, LeftMargin - LeftScrollWidth, Y - FontHeight, ExpandListStr(ARow), ETO_CLIPPED or ETO_OPAQUE);
finally
CaretEndUpdate;
end;
end;
end;
end;
procedure TEditorx.HideUnderline(ARow: Integer);
var
Y: Integer;
R: TRect;
begin
if not FCursorlineDraw then
inherited HideUnderline(ARow)
else
if Showing then
begin
Y := UnderlinePos(ARow);
if Y <> -1 then
begin
CaretBeginUpdate;
try
// 描画領域を設定して無効化し、描画させる
R := Rect(LeftMargin, Y - FontHeight, Width, Y);
InvalidateRect(Handle, @R, False);
UpdateWindow(Handle);
finally
CaretEndUpdate;
end;
end;
end;
end;
end.
(Marks.Underline.Visible = True) and (CursorlineDraw = True) の時に、 CursorlineColor で指定される背景色、描画色、フォントスタイルで カーソル行が描画されます。
| HTML のタグの中の〜で囲まれた領域を別の色で表示する ver2.52 |
|
OnDrawLine イベントハンドラで1行文字列をパースしながら判別して描画します。
procedure TForm1.Editor1DrawLine(Sender: TObject; LineStr: String; X, Y,
Index: Integer; ARect: TRect; Selected: Boolean);
var
Parser: THTMLFountainParser;
TagIn, MarkIn: Boolean;
StartPos: Integer;
begin
StartPos := 0;
TagIn := False;
MarkIn := False;
Parser := THTMLFountainParser.Create(HTMLFountain1);
try
Parser.NewData(LineStr, Editor1.ListData[Index]);
while Parser.NextToken <> toEof do
begin
if Parser.Token = toTagStart then
TagIn := True
else
if Parser.Token = toTagEnd then
begin
TagIn := False;
MarkIn := False;
end;
if TagIn and not MarkIn and (Parser.TokenString = '〜') then
begin
MarkIn := True;
StartPos := Parser.SourcePos;
end;
if MarkIn then
begin
if Selected then
begin
Editor1.Canvas.Brush.Color := Editor1.View.Colors.Select.BkColor;
Editor1.Canvas.Font.Color := Editor1.View.Colors.Select.Color;
end
else
begin
Editor1.Canvas.Brush.Color := Editor1.Color;
Editor1.Canvas.Font.Color := clRed; // as you like
end;
Editor1.DrawTextRect(
ARect,
X + Parser.SourcePos * Editor1.ColWidth,
Y,
Parser.TokenString,
ETO_CLIPPED
);
end;
if MarkIn and (Parser.TokenString = '〜') and (Parser.SourcePos > StartPos) then
MarkIn := False;
end;
finally
Parser.Free;
end;
end;
|
|