たくさんの動的コンポーネント表示
解決皆様、こんにちは。
お知恵を拝借できれば幸いです。
var
Form1: TForm1;
arrEdt :array[0..499] of TEdit;
implementation
{$R *.dfm}
procedure TForm1.SetArrEdit(intType :Integer);
var
i,intC,intR : Integer;
begin
//適当に
Panel1.Visible := False;
for i := 0 to 499 do
begin
arrEdt[i].Width := 40;
arrEdt[i].Height := 20;
arrEdt[i].Parent := Panel1;
if intType = 1 then
begin
if (i mod 2) = 0 then
begin
arrEdt[i].Visible := False;
end else begin
arrEdt[i].Visible := True;
end;
end else begin
if (i mod 2) = 0 then
begin
arrEdt[i].Visible := True;
end else begin
arrEdt[i].Visible := False;
end;
end;
end;
intC := 0;
intR := 0;
for i := 0 to 499 do
begin
if intC = 20 then
begin
intC := 0;
intR := intR + 1;
end;
arrEdt[i].Left := (intC * 40) + 8;
arrEdt[i].Top := (intR * 20) + 8;
intC := intC + 1;
end;
Panel1.Visible := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i :Integer;
begin
for i := 0 to 499 do
begin
arrEdt[i] := TEdit.Create(Self);
end
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i :Integer;
begin
for i := 0 to 499 do
begin
arrEdt[i].Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetArrEdit(1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetArrEdit(2);
end;
で、Buton1とButon2の押し変え時にはPanelが一瞬消えて
から、ちょっとブランクがあって表示される感じになって
どうも、面白くありません。
で、StringGridでつかった
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 0, 0);
・・・大量のデータ処理
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 1, 0);
StringGrid1.Refresh;
みたに、消えてからまた再表示ではなく、処理後にぱっと
切り替わる具合には、ならんものかなと思ってます。
何か、良い方法はないものでしょうか？
Panel1.Visible := False;
・・・
Panel1.Visible := True;
をしてるので、一瞬消えるのは当たり前で
これは、苦し紛れです。
なんとか、一気に描画されたような雰囲気に
ならんものかなと・・・・
1枚のPanel上ですべてのEditの表示を切り換えるのではなくて、
2枚のPanel上に偶数番、奇数番のEditを乗せて、2枚のパネルの
Visibleプロパティを切り換えたらどうかな…？
(EditのVisibleはすべてTrue。2枚のPanelは同じ位置)
５００個も Edit 作ってる時点で回答書く気なくす
ありがとうございます。
一案さん すいません。<m(__)m>
先程、記した記述は一例で、再現しやすくする為です。
ので、実際は異なります。
Edit500個は無謀ですか？
極端な例だったかもしれませんでしたが、実際は192個です。
最も、EditだけではなくImageもShapeも少々乗せてます。
現状の手作業をプログラミングする過程で、手作業で利用
されている書式(検査票)と似せた形の入力形態及び表示形
式がすんなりするかななどと、考えた結果です。
目的や使用するタイミングはほぼ同一ですが、内容によって
若干入力形態(書式)が異なるため、実際に表示する個数や位
置を変えています。
それを切り替える時点での内容でした。
StringGrid は何百個も Cell があっても InplaceEdit はひとつだけ。
一度にひとつしか編集できないのだからひとつで十分
>Panel1.Visible := False;
>・・・
>Panel1.Visible := True;
>をしてるので、一瞬消えるのは当たり前で
>これは、苦し紛れです。
上記の部分を以下のようにしてみてはどうでしょうか？
LockWindowUpdate(Panel1.Handle)
・・・
LockWindowUpdate(0);
既出ですが、
環境が限られたPCで使うのを前提としても、
ウィンドウ(TEdit)を必要な数だけ作った時点で、
高速な切り替えは不可能だと思います。
もちろん、GUIアプリケーションの作成方法としては無作法ですし、
コーディングとしては手抜きと判断されても仕方ないと思います。
フォーカスを持つTEditだけを作成して、後は自力で描画した方が良いのではないでしょうか？
皆様いろいろ、ありがとうございます。
確かに無作法で横着しとりました。
>フォーカスを持つTEditだけを作成して、後は自力で描画した方が良いのではないでしょうか？
これは、考えなかったわけではないのですが・・・
いやいや、おっしゃられる通りです。
もう一度見直します。
ありがとうございました。
ちょっと面白そうなのでコンポーネント化挑戦してみます。
完成しました。
４時間か…結構かかりました。
http://www.studio-fe.hiroishi.org/files/VirtualEdites.zip
とりあえずでかいのでzipファイルを置いておきます。
リンク先の保障はないので、だらだらソースを掲載させていただきます。
そのうちDelphianWorldにでも投稿しておきます。
//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.
//使い方（サンプル）
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,
HVirtualEdites; //これ追加 HVirtualEdites.pas
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
VirtualEdites1 : TVirtualEdites;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i,p:integer;
VEdit:TVirtualEdit;
begin
VirtualEdites1:=TVirtualEdites.Create(self);
VirtualEdites1.Parent:=Panel1;
VirtualEdites1.Align:=alClient;
VirtualEdites1.BeginUpdate;
for i:=0 to 4 do
for p:= 0 to 100 do
begin
VEdit.Text := 'Edit'+ IntToStr(i*100+p);
VEdit.Visible := True;
VEdit.EditRect:= Rect(i*100,p*20,i*100+80,p*20+15);
VirtualEdites1.Add(VEdit);
end;
VirtualEdites1.EndUpdate;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,p:integer;
begin
VirtualEdites1.BeginUpdate;
for i:=0 to 4 do
for p:= 0 to 100 do
begin
if i mod 2 = 0 then
VirtualEdites1.EditVisible[i*100+p]:=True
else
VirtualEdites1.EditVisible[i*100+p]:=False;
end;
VirtualEdites1.EndUpdate;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i,p:integer;
begin
VirtualEdites1.BeginUpdate;
for i:=0 to 4 do
for p:= 0 to 100 do
begin
if i mod 2 = 0 then
VirtualEdites1.EditVisible[i*100+p]:=False
else
VirtualEdites1.EditVisible[i*100+p]:=True;
end;
VirtualEdites1.EndUpdate;
end;
end.
てゆーか、インターネット探せばありそうな気がしてきました…
メラトニンさん
ありがとうございます。
お礼が遅くなりました。
さ〜て、自前で描画作業するか・・・と作業中にふと掲示板を見て気付きました。
う〜む、これは・・・・＼(^o^)／
サンプルを実行しましたが、素晴らしいです。
いやいや、お手数をお掛けしてすいませんでした。
まだまだ未熟者ですので大変助かります。
参考にし色々、学習させてもらいます。
ありがとうございました。
| ツイート |  |