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;

解説

ハンドラにやってきた文字列を一度分解します。この時は、 View.Brackets プロパティの値を尊重して、TEditorParser.Token プロパティが toBracket を返せるように、CreateWithEditor に ListBrackt[Index] を渡します。

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;