?
Solved

tvirtualstringtree freeze when load too manny images

Posted on 2016-11-20
10
Medium Priority
?
114 Views
Last Modified: 2016-11-21
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 ?

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.

Open in new window


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

Open in new window

0
Comment
Question by:dolphin King
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 3
10 Comments
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894735
why do you have a local class instance for your images ?
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
const MaxGridImgData = 7;

type
  TGridImgData = class(TObject)
  private
    fImgScr: Array[0..MaxGridImgData] of TGifImage;
    function GetImgScr(const Index: Integer): TGifImage;
  public
    property ImgScr[Index: Integer]: TGifImage read GetImgScr; default;
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TGRIDIMGDATA.Create;
var I: Integer;
begin
  for I := 0 to MaxGridImgData do
  begin
    fImgScr[I] := TGifImage.Create;
    fImgScr[I].LoadFromFile('image' + intTostr(i) + '.gif');
    fImgScr[I].Transparent := True;
    fImgScr[I].Width := 55;
    fImgScr[I].Animate := True;
  end;
end;

destructor TGRIDIMGDATA.Destroy;
var I: Integer;
begin
  for I := 0 to MaxGridImgData do
    fImgScr[I].Free;
  inherited;
end;

Open in new window

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894739
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;

Open in new window

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894741
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;

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894769
actually it boiles down to just this:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  countadd: Integer;
begin
    vdt.BeginUpdate;
    try
      AddVSTStructure(vdt, nil, GRIDIMGDATA);
    finally
      vdt.EndUpdate;
    end;
end;

Open in new window


that procedure adds a child node to the tree and an object
so ... just add a row ?
0
 

Author Comment

by:dolphin King
ID: 41894771
but why do you keep setting countadd to 0 

Open in new window


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
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894774
and what with's the "with newrect" ??

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;

Open in new window

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 41894776
I got a few cracks in my brain from using virtual string too :)
It's a pity Mike started on another path
0
 

Author Comment

by:dolphin King
ID: 41894782
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 ...
0
 

Author Comment

by:dolphin King
ID: 41894789
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
0
 
LVL 38

Accepted Solution

by:
Geert Gruwez earned 2000 total points
ID: 41894807
well ... yeah
you'll have to make a compromise between loading everything up front and loading as needed

i once created a unit for an in-memory module to hold images
it was for a devex grid, where same images were displayed in different rows
the images were too big and high quality for fast loading
the devex grid didn't recognize an already loaded image, so i put in this layer

UntGraphicStore.pas

assigning an image is by calling the procedure:
Bitmap.Assign(GraphicFromStore('c:\images\animage.jpeg'));

the first time, the image is loaded from disk and a copy is maintained in memory
the second time, the image is copied from the memory location

with this unit you can load the images as needed
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
Simple Linear Regression
Suggested Courses

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question