« ■CodeGear Outside | トップページ | ☆TDrawGridを使ってみる。 »

☆TEditにインデント機能をつける。

私の仕事で使う見積アイテムは、
 バルコニー手摺  アルミ製(ステンカラー)   H=1100
 床       300角磁器質タイル貼
 土間      防水モルタル金鏝押エ    t=30
といったように、見た目を合わせて書くものが多いです。(ここではフォントの関係でずれてますけど)
データベースから作成したものは、自動処理させていますが、手入力する部分は 結構面倒なので、TEditにインデント機能をつけてみようと思います。

今回作成する機能一覧
[ CTRL+I ]
  次のインデント位置に要素を移動させます。
[ CTRL+SHIFT+I ]
  前のインデント位置に要素を移動させます。
[ CTRL+U ]
  次の要素開始位置へキャレットを移動させます。  
[ CTRL+SHIFT+U ]
  前の要素開始位置へキャレットを移動させます。 

いまいち使い方が伝わらないかも知れませんが、編集エディットで上記のキーを試してみて下さい。

Indent


ランタイムテーマにも対応させるため、☆カーソル下のテキストを選択する。で 作成した AdjustedEdit 名前空間を使います。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AdjustedEdit;

type
  TPositionList = array of Integer;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Memo1: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    procedure GetIndentPosList(S: String; var List: TPositionList);
    procedure GetElementPosList(S: String; var List: TPositionList);
  public
    procedure PriorIndent;
    procedure NextIndent;
    procedure PriorElement;
    procedure NextElement;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  // Ctrl + Iで指定位置にエレメントを移動させます。
  if (GetKeyState(VK_SHIFT) and $80 = 0) and
     (GetKeyState(VK_CONTROL) and $80 > 0) and
     (Key = #9) then
  begin
    NextIndent;
    Key := #0;
    Exit;
  end;

  // Ctrl + Shift + Iで指定位置にエレメントを移動させます。
  if (GetKeyState(VK_SHIFT) and $80 > 0) and
     (GetKeyState(VK_CONTROL) and $80 > 0) and
     (Key = #9) then
  begin
    PriorIndent;
    Key := #0;
    Exit;
  end;

  // 要素開始位置へキャレットを移動させます。CTRL+U
  if (GetKeyState(VK_SHIFT) and $80 = 0) and
     (GetKeyState(VK_CONTROL) and $80 > 0) and
     (Key = #21) then
  begin
    Key := #0;
    NextElement;
    Exit;
  end;

  // 要素開始位置へキャレットを移動させます。CTRL+SHIFT+U
  if (GetKeyState(VK_SHIFT) and $80 > 0) and
     (GetKeyState(VK_CONTROL) and $80 > 0) and
     (Key = #21) then
  begin
    Key := #0;
    PriorElement;
    Exit;
  end;
end;


procedure TForm1.NextIndent;
var
  P1, P2: Integer;
  I,J: Integer;
  S1, S2, S3: String;
  List: TPositionList;
begin
  SendMessage(Edit1.Handle, WM_SETREDRAW, Ord(False), 0);
  try
    P1 := GetSelStart(Edit1);
    P2 := 0;

    GetIndentPosList(Edit2.Text, List);
    for I := 0 to High(List) do
      if List[I]-1 > P1 then
      begin
        P2 := List[I]-1;
        Break;
      end;

    if P2 = 0 then Exit;

    S1 := Copy(Edit1.Text, 1, P1);
    S2 := Copy(Edit1.Text, P1+1, Length(Edit1.Text)-P1);

    J := P2 - P1;
    S3 := S1 +StringOfChar(' ', J) + S2;
    Edit1.Text := S3;
  finally
    SendMessage(Edit1.Handle, WM_SETREDRAW, Ord(True), 0);
  end;
  SetSelStart(Edit1, P2);
end;

procedure TForm1.PriorIndent;
var
  P1, P2, P3: Integer;
  I,J: Integer;
  S1, S2, S3: String;
  List: TPositionList;
begin
  SendMessage(Edit1.Handle, WM_SETREDRAW, Ord(False), 0);
  try
    P1 := GetSelStart(Edit1);
    P2 := 0;

    GetIndentPosList(Edit2.Text, List);
    for I := High(List) downto 0 do
      if List[I]-1 < P1 then
      begin
        P2 := List[I]-1;
        Break;
      end;

    if P2 < 0 then Exit;

    S1 := TrimRight(Copy(Edit1.Text, 1, P1));
    P3 := Length(S1);

    S2 := Copy(Edit1.Text, P1+1, Length(Edit1.Text)-P1);

    if P3 >= P2 then
    begin
      S3 := S1 + S2;
      P2 := P3;
    end
    else
    begin
      J := P2 - Length(S1);
      S3 := S1 +StringOfChar(' ', J) + S2;
    end;
    Edit1.Text := S3;
  finally
    SendMessage(Edit1.Handle, WM_SETREDRAW, Ord(True), 0);
  end;
  SetSelStart(Edit1, P2);
end;

procedure TForm1.NextElement;
var
  I: Integer;
  P1: Integer;
  List: TPositionList;
begin
  GetElementPosList(Edit1.Text, List);
  P1 := GetSelStart(Edit1);
  for I := 0 to High(List) do
    if P1 < List[I] then
    begin
      P1 := List[I];
      Break;
    end;
  SetSelStart(Edit1, P1);
end;

procedure TForm1.PriorElement;
var
  I: Integer;
  P1: Integer;
  List: TPositionList;
begin
  GetElementPosList(Edit1.Text, List);
  P1 := GetSelStart(Edit1);
  for I := High(List) downto 0 do
    if P1 > List[I] then
    begin
      P1 := List[I];
      Break;
    end;
  SetSelStart(Edit1, P1);
end;

// 要素の位置を取得します。
procedure TForm1.GetElementPosList(S: String; var List: TPositionList);

  procedure Increment(var P: PChar; var I: Integer; Value: Integer);
  begin
    Inc(P, Value);
    Inc(I, Value);
  end;

var
  P: PChar;
  I, J: Integer;
  w: Word;
  F: Boolean;
begin
  SetLength(List, 100); // 100は適当
  P := PChar(S + #0);
  I := 0;
  J := -1;
  F := True;
  while (P^ <> #0) do
  begin
    if IsDBCSLeadByte(Byte(P^)) then
    begin
      w := (Byte(P^) shl 8) or Byte((P+1)^);
      if F and (w <> $8140) then
      begin
        Inc(J);
        List[J] := I;
        Increment(P, I, 2);
        F := False;
      end
      else if (w = $8140) then
      begin
        Increment(P, I, 2);
        F := True;
      end
      else
       Increment(P, I, 2);
    end
    else
    begin
      if F and (P^ <> ' ') then
      begin
        Inc(J);
        List[J] := I;
        Increment(P, I, 1);
        F := False;
      end
      else if (P^ = ' ') then
      begin
        Increment(P, I, 1);
        F := True;
      end
      else
       Increment(P, I, 1);
    end;
  end;
  SetLength(List, J+1);
end;

// インデントの位置を取得します。
procedure TForm1.GetIndentPosList(S: String; var List: TPositionList);
var
  I: Integer;
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.CommaText := S;
    SetLength(List, SL.Count);
    for I := 0 to SL.Count - 1 do
      List[I] := StrToIntDef(SL[I],0);
  finally
    SL.Free;
  end;
end;

end.

問題点としては、Undoできないことです。よくわかりませんが、文字列を置き換える前に、keybd_event等でクリップボードのカットをさせたりするとできるのかな?

今後、これをTDBGridのTInplaceEditに実装したいと思っています。

|

« ■CodeGear Outside | トップページ | ☆TDrawGridを使ってみる。 »