dolphin King
asked on
tvirtualstringtree freeze when load too manny images
Hi , i have been asking before about tvirtuailstringtree and how to make it as Grid View . i have done this part !
and here is my full code . But i got freeze issue when i load too Manny images to the VST after loading First Time i got no freeze at all until i clear the VST and load them again . any idea why ?
DFM
and here is my full code . But i got freeze issue when i load too Manny images to the VST after loading First Time i got no freeze at all until i clear the VST and load them again . any idea why ?
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.StdCtrls, GIFIMG,
Vcl.ExtCtrls;
type
TGRIDIMGDATA = class
private
FIMGID: String;
FIMGSCR: TGifImage;
FIMGSCR1: TGifImage;
FIMGSCR2: TGifImage;
FIMGSCR3: TGifImage;
FIMGSCR4: TGifImage;
FIMGSCR5: TGifImage;
FIMGSCR6: TGifImage;
FIMGSCR7: TGifImage;
public
property IMGID: String read FIMGID write FIMGID;
property IMGSCR: TGifImage read FIMGSCR write FIMGSCR;
property IMGSCR1: TGifImage read FIMGSCR1 write FIMGSCR1;
property IMGSCR2: TGifImage read FIMGSCR2 write FIMGSCR2;
property IMGSCR3: TGifImage read FIMGSCR3 write FIMGSCR3;
property IMGSCR4: TGifImage read FIMGSCR4 write FIMGSCR4;
property IMGSCR5: TGifImage read FIMGSCR5 write FIMGSCR5;
property IMGSCR6: TGifImage read FIMGSCR6 write FIMGSCR6;
property IMGSCR7: TGifImage read FIMGSCR7 write FIMGSCR7;
public
constructor Create;
destructor Destroy; override;
end;
type
PGRIDVIEWDATA = ^TGRIDVIEWDATA;
TGRIDVIEWDATA = record
FObject: TGRIDIMGDATA;
end;
type
TForm1 = class(TForm)
vdt: TVirtualStringTree;
Button1: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure vdtBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure vdtGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vdtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function AddVSTStructure(AVST: TCustomVirtualStringTree; ANode: PVirtualNode;
AObject: TGRIDIMGDATA): PVirtualNode;
var
Data: PGRIDVIEWDATA;
begin
Result := AVST.AddChild(ANode);
Data := AVST.GetNodeData(Result);
AVST.ValidateNode(Result, false);
Data^.FObject := AObject;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
GRIDIMGDATA: TGRIDIMGDATA;
countadd: Integer;
begin
for i := 0 to 5 do
begin
if countadd = 0 then
begin
GRIDIMGDATA := TGRIDIMGDATA.Create;
end;
vdt.BeginUpdate;
try
countadd := countadd + 1;
if countadd = 1 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR.Transparent := True;
GRIDIMGDATA.IMGSCR.Width := 55;
GRIDIMGDATA.IMGSCR.Animate := True;
end;
if countadd = 2 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR1.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR1.Transparent := True;
GRIDIMGDATA.IMGSCR1.Width := 55;
GRIDIMGDATA.IMGSCR1.Animate := True;
end;
if countadd = 3 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR2.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR2.Transparent := True;
GRIDIMGDATA.IMGSCR2.Width := 55;
GRIDIMGDATA.IMGSCR2.Animate := True;
end;
if countadd = 4 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR3.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR3.Transparent := True;
GRIDIMGDATA.IMGSCR3.Width := 55;
GRIDIMGDATA.IMGSCR3.Animate := True;
end;
if countadd = 5 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR4.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR4.Transparent := True;
GRIDIMGDATA.IMGSCR4.Width := 55;
GRIDIMGDATA.IMGSCR4.Animate := True;
end;
if countadd = 6 then
begin
GRIDIMGDATA.IMGID := intTostr(i);
GRIDIMGDATA.IMGSCR5.LoadFromFile('image' + intTostr(i) + '.gif');
GRIDIMGDATA.IMGSCR5.Transparent := True;
GRIDIMGDATA.IMGSCR5.Width := 55;
GRIDIMGDATA.IMGSCR5.Animate := True;
end;
if countadd >= 2 then
begin
AddVSTStructure(vdt, nil, GRIDIMGDATA);
countadd := 0;
end;
finally
vdt.EndUpdate;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
vdt.NodeDataSize := SizeOf(TGRIDVIEWDATA);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
vdt.Invalidate;
end;
procedure TForm1.vdtBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: PGRIDVIEWDATA;
NewRect: TRect;
begin
if not Assigned(Node) then
begin
exit;
end;
Data := vdt.GetNodeData(Node);
TargetCanvas.Brush.Style := bsClear;
TargetCanvas.FillRect(CellRect);
CellRect.Width := 55;
if Assigned(Data.FObject.IMGSCR) then
begin
if Column = 0 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR);
end;
end;
end;
if Assigned(Data.FObject.IMGSCR1) then
begin
if Column = 1 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR1);
end;
end;
end;
if Assigned(Data.FObject.IMGSCR2) then
begin
if Column = 2 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR2);
end;
end;
end;
if Assigned(Data.FObject.IMGSCR3) then
begin
if Column = 3 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR3);
end;
end;
if Assigned(Data.FObject.IMGSCR5) then
begin
if Column = 4 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR4);
end;
end;
end;
end;
if Assigned(Data.FObject.IMGSCR5) then
begin
if Column = 5 then
begin
with NewRect do
begin
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR5);
end;
end;
end;
end;
procedure TForm1.vdtFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PGRIDVIEWDATA;
begin
Data := vdt.GetNodeData(Node);
if Assigned(Data) then
Data.FObject.Free;
end;
procedure TForm1.vdtGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TGRIDVIEWDATA);
end;
{ TGRIDIMGDATA }
constructor TGRIDIMGDATA.Create;
begin
FIMGSCR := TGifImage.Create;
FIMGSCR1 := TGifImage.Create;
FIMGSCR2 := TGifImage.Create;
FIMGSCR3 := TGifImage.Create;
FIMGSCR4 := TGifImage.Create;
FIMGSCR5 := TGifImage.Create;
FIMGSCR6 := TGifImage.Create;
FIMGSCR7 := TGifImage.Create;
end;
destructor TGRIDIMGDATA.Destroy;
begin
FIMGSCR.Free;
FIMGSCR1.Free;
FIMGSCR2.Free;
FIMGSCR3.Free;
FIMGSCR4.Free;
FIMGSCR5.Free;
FIMGSCR6.Free;
FIMGSCR7.Free;
inherited;
end;
end.
DFM
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 267
ClientWidth = 124
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object vdt: TVirtualStringTree
Left = 0
Top = 0
Width = 124
Height = 242
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
BorderStyle = bsNone
DefaultNodeHeight = 50
Header.AutoSizeIndex = 0
Header.DefaultHeight = 55
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Height = 55
Header.Options = []
HotCursor = crHandPoint
ScrollBarOptions.ScrollBars = ssVertical
TabOrder = 0
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toHideFocusRect, toHideSelection, toHotTrack, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toUseBlendedSelection]
TreeOptions.SelectionOptions = [toExtendedFocus, toMiddleClickSelect, toRightClickSelect]
OnBeforeCellPaint = vdtBeforeCellPaint
OnFreeNode = vdtFreeNode
OnGetNodeDataSize = vdtGetNodeDataSize
ExplicitWidth = 233
Columns = <
item
Position = 0
end
item
Position = 1
end
item
Position = 2
end
item
Position = 3
end
item
Position = 4
end
item
Position = 5
end
item
Position = 6
end
item
Position = 7
end>
end
object Button1: TButton
Left = 0
Top = 242
Width = 124
Height = 25
Align = alBottom
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
ExplicitWidth = 402
end
object Timer1: TTimer
Interval = 10
OnTimer = Timer1Timer
Left = 48
Top = 64
end
end
the form create and destroy:
constructor TForm1.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
ImgGridData := TImgGridData.Create;
end;
destructor TForm1.Destroy;
begin
ImgGridData.Free;
inherited Destroy;
end;
this would remain of the button click code, but why do you keep setting countadd to 0 ?
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
countadd: Integer;
begin
for i := 0 to 5 do
begin
vdt.BeginUpdate;
try
if countadd >= 2 then
begin
AddVSTStructure(vdt, nil, GRIDIMGDATA);
countadd := 0;
end;
finally
vdt.EndUpdate;
end;
end;
end;
actually it boiles down to just this:
that procedure adds a child node to the tree and an object
so ... just add a row ?
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
countadd: Integer;
begin
vdt.BeginUpdate;
try
AddVSTStructure(vdt, nil, GRIDIMGDATA);
finally
vdt.EndUpdate;
end;
end;
that procedure adds a child node to the tree and an object
so ... just add a row ?
ASKER
but why do you keep setting countadd to 0
as i mention this mechanism will work as Gridview . inside the loop i set that count variable to add 2 images per node , then when number 2 reached i create new node which required to create class again so each count 0 new class created
and what with's the "with newrect" ??
your recoded on before cell paint :
your recoded on before cell paint :
procedure TForm1.vdtBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: PGRIDVIEWDATA;
begin
if not Assigned(Node) then
begin
exit;
end;
Data := vdt.GetNodeData(Node);
TargetCanvas.Brush.Style := bsClear;
TargetCanvas.FillRect(CellRect);
CellRect.Width := 55;
for I := 0 to 5 do
if (Column = I) and Assigned(GridImgData[I]) then
TargetCanvas.StretchDraw(CellRect, Data.FObject.IMGSCR[I]);
end;
I got a few cracks in my brain from using virtual string too :)
It's a pity Mike started on another path
It's a pity Mike started on another path
ASKER
and what with's the "with newrect" ??
new rect i place it there because i were planing to draw in custom rect width height etc ...
ASKER
your code is good customization and make the coding easier . but still the main issue will be caused with your code any my code , if you got as example more than 50 images the form will be freezed until all images loaded so each time you add 50 images you will be freezed
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
shouldn't it be a form class instance ?
i would define the class for the images in the form private definition
and initiate the instance upon creating the form
you have mixed initialization code and vcl updating in the button click ... very odd
and why did you make your own life so difficult with such non generic code ?
copy paste is fine, but this is somewhat over the top
Open in new window