たくさんの動的コンポーネント表示 (ID:16292)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

//HVirtualEdites.pas

unit HVirtualEdites;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, //for TEdit
  Themes    //for Xp Style
  ;

type
  //仮想Edit情報
  PVirtualEdit = ^TVirtualEdit;
  TVirtualEdit = record
    EditRect   : TRect;
    Text       : string;
    Visible    : boolean;
  end;

TVirtualEdites = class(TCustomControl)
  private
    bufBmp   : TBitmap;
    EditList : TList;
    FColor   : TColor;
    FUpdate  : boolean;

FFocusEdit      : TEdit;
    FFocusEditIndex : Integer;
    FFocusEditChanged: boolean;
    function InTheRect(X,Y:integer; ERect:TRect):boolean;
    function GetEditText(Index: integer): String;
    function GetEditHeight(Index: integer): Integer;
    function GetEditWidth(Index: integer): Integer;
    function GetEditLeft(Index: integer): Integer;
    function GetEditTop(Index: integer): Integer;
    function GetEditVisible(Index: integer): boolean;

procedure ClearEdit;
    procedure EditChange(Sender:TObject);
    procedure EditExit(Sender:TObject);

procedure Draw; //全体を描く
    procedure DrawEditRect(ERect:TRect);
    procedure DrawVirtualEdit(Index:integer);
    procedure SetColor(const Value: TColor);
    procedure SetEditText(Index: integer; const Value: String);
    procedure SetEditHeight(Index: integer; const Value: Integer);
    procedure SetEditWidht(Index: integer; const Value: Integer);
    procedure SetEditLeft(Index: integer; const Value: Integer);
    procedure SetEditTop(Index: integer; const Value: Integer);
    procedure SetEditVisible(Index: integer; const Value: boolean);
    procedure ShowFocusEdit; //フォーカスのあるEditを実体化

procedure WMEraseBkGnd (var Msg: TMessage);       message WM_ERASEBKGND;
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseMove  (var Msg: TWMMouseMove);   message WM_MOUSEMOVE;
    function GetFocusEditText: String;
    procedure SetFocusEditText(const Value: String);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    procedure Add(VEdit:TVirtualEdit);
    procedure BeginUpdate;
    procedure Delete(Index:integer);
    procedure EndUpdate;

constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;

property Color      : TColor read FColor     write SetColor;
    property EditText   [Index:integer]: String  read GetEditText    write SetEditText;
    property EditTop    [Index:integer]: Integer read GetEditTop     write SetEditTop;
    property EditLeft   [Index:integer]: Integer read GetEditLeft    write SetEditLeft;
    property EditHeight [Index:integer]: Integer read GetEditHeight  write SetEditHeight;
    property EditWidth  [Index:integer]: Integer read GetEditWidth   write SetEditWidht;
    property EditVisible[Index:integer]: boolean read GetEditVisible write SetEditVisible;
    property FocusedEditIndex          : Integer read FFocusEditIndex write FFocusEditIndex;
    property FocusedEditText           : String  read GetFocusEditText write SetFocusEditText;
  end;

implementation

uses Types;

{ TVirtualEdites }

procedure TVirtualEdites.Add(VEdit:TVirtualEdit);
//Edit追加
var
  PEdit:PVirtualEdit;
begin
  New(PEdit);
  PEdit.EditRect:=VEdit.EditRect;
  PEdit.Text    :=VEdit.Text;
  PEdit.Visible :=VEdit.Visible;

EditList.Add(PEdit);

FFocusEditIndex:=EditList.Count-1; //追加されたEditにフォーカスIndexを与える

//再描画
  Draw;
  Repaint;
end;

procedure TVirtualEdites.BeginUpdate;
begin
  FUpdate:=True;
end;

procedure TVirtualEdites.ClearEdit;
//Editを一括クリア
var
  i:integer;
begin
  for i:= EditList.Count-1 downto 0 do
    Delete(I);
end;

constructor TVirtualEdites.Create(AOwner: TComponent);
begin
  inherited;
  FColor  :=clBtnFace;
  FUpdate :=False;

bufBmp  :=TBitmap.Create;
  EditList:=TList.Create;

FFocusEditIndex:=-1;
  FFocusEdit:= TEdit.Create(self);
  FFocusEdit.Hide;
  FFocusEdit.Parent :=Self;
  FFocusEdit.OnChange:=EditChange;
  FFocusEdit.OnExit  :=EditExit;
end;

procedure TVirtualEdites.Delete(Index: integer);
//Edit削除
var
  VEdit:PVirtualEdit;
begin
  VEdit := EditList.Items[Index];
  Dispose(VEdit);
  EditList.Delete(Index);
end;

destructor TVirtualEdites.Destroy;
begin
  ClearEdit;     //中身を消去
  EditList.Free; //開放
  inherited;
end;

procedure TVirtualEdites.Draw;
var
  i:integer;
begin
if FUpdate=True then exit;
  bufBmp.Canvas.Font.Assign(Font);
  bufBmp.Canvas.Pen.Color:= FColor;
  bufBmp.Canvas.Brush.Color:= FColor;
  bufBmp.Canvas.Rectangle(0,0,bufBmp.Width,bufBmp.Height);
  for i:= 0 to EditList.Count-1 do
    DrawVirtualEdit(i);
end;

procedure TVirtualEdites.DrawEditRect(ERect: TRect);
var
  thDetails: TThemedElementDetails;
begin
  ERect.Bottom:= ERect.Top + FFocusEdit.Height; //わざと入れてます嫌ならコメントアウト

if ThemeServices.ThemesEnabled then
  begin
    thDetails := ThemeServices.GetElementDetails(TThemedEdit(3));
    //ERect     := ThemeServices.ContentRect(bufBmp.Canvas.Handle, thDetails,ERect);
    ThemeServices.DrawElement(bufBmp.Canvas.Handle, thDetails, ERect);
  end else begin
    bufBmp.Canvas.Brush.Color:=clWindow;
    bufBmp.Canvas.Rectangle(ERect);
    DrawEdge(bufBmp.Canvas.Handle,ERect,EDGE_SUNKEN,BF_RECT); //EDGE_ETCHED EDGE_BUMP
  end;
end;

procedure TVirtualEdites.DrawVirtualEdit(Index:integer);
var
  Text : string;
  ERect: TRect;
begin
if PVirtualEdit(EditList.Items[Index]).Visible=False then exit;
if (PVirtualEdit(EditList.Items[Index]).EditRect.Left > Width) or
   (PVirtualEdit(EditList.Items[Index]).EditRect.Top  > Height) then
   exit; //余計な描画はしない

DrawEditRect(PVirtualEdit(EditList.Items[Index]).EditRect);
  //文字を描く
  Text := PVirtualEdit(EditList.Items[Index]).Text;
  ERect:= PVirtualEdit(EditList.Items[Index]).EditRect;
  //ちょっと無理があるかも…
    ERect.Top  := ERect.Top  + 3;
    ERect.Left := ERect.Left + 3;
    ERect.Bottom := ERect.Top + FFocusEdit.Height;
  bufBmp.Canvas.Brush.Color:=clWindow;
  DrawText(bufBmp.Canvas.Handle,PChar(Text),Length(Text), ERect, DT_LEFT);
end;

procedure TVirtualEdites.EditChange(Sender: TObject);
begin
  PVirtualEdit(EditList.Items[FFocusEditIndex]).Text:= FFocusEdit.Text;
  FFocusEditChanged:=True;
end;

procedure TVirtualEdites.EditExit(Sender: TObject);
begin
  if FFocusEditChanged=True then
    Draw;
  FFocusEdit.Hide;
  FFocusEditChanged:=False;
end;

procedure TVirtualEdites.EndUpdate;
begin
  FUpdate:=False;
  Draw;
  Repaint;
end;

function TVirtualEdites.GetEditHeight(Index: integer): Integer;
begin
  Result:=  PVirtualEdit(EditList.Items[Index]).EditRect.Bottom -
            PVirtualEdit(EditList.Items[Index]).EditRect.Top;
end;

function TVirtualEdites.GetEditLeft(Index: integer): Integer;
begin
  Result:=  PVirtualEdit(EditList.Items[Index]).EditRect.Left;
end;

function TVirtualEdites.GetEditText(Index: integer): String;
begin
  Result:= PVirtualEdit(EditList.Items[Index]).Text;
end;

function TVirtualEdites.GetEditTop(Index: integer): Integer;
begin
  Result:=  PVirtualEdit(EditList.Items[Index]).EditRect.Top;
end;

function TVirtualEdites.GetEditVisible(Index: integer): boolean;
begin
  Result:=  PVirtualEdit(EditList.Items[Index]).Visible;
end;

function TVirtualEdites.GetEditWidth(Index: integer): Integer;
begin
  Result:=  PVirtualEdit(EditList.Items[Index]).EditRect.Right -
            PVirtualEdit(EditList.Items[Index]).EditRect.Left;
end;

function TVirtualEdites.GetFocusEditText: String;
begin
  Result:=GetEditText(FFocusEditIndex);
end;

function TVirtualEdites.InTheRect(X, Y: integer; ERect: TRect): boolean;
begin
  if (X >= ERect.Left)   and
     (X <= ERect.Right)  and
     (Y >= ERect.Top)    and
     (Y <= ERect.Top + FFocusEdit.Height ) then   //TEditの仕様にあわせる
     //(Y <= ERect.Bottom) then
     Result:=True
     else
     Result:=False;
end;

procedure TVirtualEdites.Paint;
begin
if FUpdate=True then exit;
  inherited;
  if bufBmp<>nil then
    Canvas.Draw(0,0,bufBmp);
end;

procedure TVirtualEdites.Resize;
begin
  inherited;
  if bufBmp<>nil then
  begin
    bufBmp.Height:=Height;
    bufBmp.Width :=Width;
    Draw;
  end;
end;

procedure TVirtualEdites.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditHeight(Index: integer;
  const Value: Integer);
begin
if PVirtualEdit(EditList.Items[Index]).EditRect.Bottom -
  PVirtualEdit(EditList.Items[Index]).EditRect.Top <> Value then
  begin
    PVirtualEdit(EditList.Items[Index]).EditRect.Bottom:=
      PVirtualEdit(EditList.Items[Index]).EditRect.Top +
      Value;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditLeft(Index: integer; const Value: Integer);
var
  i:Integer;
begin
  i:= PVirtualEdit(EditList.Items[Index]).EditRect.Right -
      PVirtualEdit(EditList.Items[Index]).EditRect.Left;
  if i<>Value then
  begin
    PVirtualEdit(EditList.Items[Index]).EditRect.Left    :=Value;
    PVirtualEdit(EditList.Items[Index]).EditRect.Right   :=Value + i;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditText(Index: integer; const Value: String);
begin
  if PVirtualEdit(EditList.Items[Index]).Text<>Value then
  begin
    PVirtualEdit(EditList.Items[Index]).Text:=Value;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditTop(Index: integer; const Value: Integer);
var
  i:Integer;
begin
  i:= PVirtualEdit(EditList.Items[Index]).EditRect.Bottom -
      PVirtualEdit(EditList.Items[Index]).EditRect.Top;
  if i<>Value then
  begin
    PVirtualEdit(EditList.Items[Index]).EditRect.Top    :=Value;
    PVirtualEdit(EditList.Items[Index]).EditRect.Bottom :=Value + i;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditVisible(Index: integer;
  const Value: boolean);
begin
  if PVirtualEdit(EditList.Items[Index]).Visible  <>  Value then
  begin
    PVirtualEdit(EditList.Items[Index]).Visible    :=Value;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetEditWidht(Index: integer;
  const Value: Integer);
begin
if  PVirtualEdit(EditList.Items[Index]).EditRect.Right<>
    PVirtualEdit(EditList.Items[Index]).EditRect.Left +
    Value
  then
  begin
    PVirtualEdit(EditList.Items[Index]).EditRect.Right:=
      PVirtualEdit(EditList.Items[Index]).EditRect.Left +
      Value;
    Draw;
    Repaint;
  end;
end;

procedure TVirtualEdites.SetFocusEditText(const Value: String);
begin
  SetEditText(FFocusEditIndex,Value);
end;

procedure TVirtualEdites.ShowFocusEdit;
var
  ERect:TRect;
begin
  if FFocusEditChanged=True then
    Draw;

FFocusEdit.Hide;

if (FFocusEditIndex < 0) or
     (FFocusEditIndex > EditList.Count-1) then
     begin
       exit;
     end;
  ERect:=PVirtualEdit(EditList.Items[FFocusEditIndex]).EditRect;

//わざと高さ制限を設けています
  FFocusEdit.SetBounds( ERect.Left,
                        ERect.Top,
                        ERect.Right  - ERect.Left,
                        FFocusEdit.Height);
  FFocusEdit.Text := PVirtualEdit(EditList.Items[FFocusEditIndex]).Text;
  FFocusEdit.Show;
  FFocusEdit.SetFocus;

FFocusEditChanged:=False;
end;

procedure TVirtualEdites.WMEraseBkGnd(var Msg: TMessage);
begin
  Msg.Result:=0;
end;

procedure TVirtualEdites.WMLButtonDown(var Msg: TWMLButtonDown);
var
  i:Integer;
begin
  inherited;
  //フォーカスを作る
  for i:=EditList.Count-1 downto 0 do
  begin
    if InTheRect(Msg.XPos,Msg.YPos,PVirtualEdit(EditList.Items[i]).EditRect) = True then
    begin
      if PVirtualEdit(EditList.Items[i]).Visible=True then
      begin
        FFocusEditIndex:=i;
        ShowFocusEdit;
        exit; //その場で抜ける
      end;
    end;
  end;
end;

procedure TVirtualEdites.WMMouseMove(var Msg: TWMMouseMove);
var
  i:Integer;
begin
  inherited;
  //カーソル処理
  for i:=EditList.Count-1 downto 0 do
  begin
    if InTheRect(Msg.XPos,Msg.YPos,PVirtualEdit(EditList.Items[i]).EditRect) = True then
    begin
      Cursor:= crIBeam;
      exit; //その場で抜ける
    end;
  end;
  Cursor:=crDefault;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る