Solved

tvirtualstringtree freeze when load too manny images

Posted on 2016-11-20
10
52 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
  • 7
  • 3
10 Comments
 
LVL 37

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 37

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 37

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
 
LVL 37

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 37

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 37

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 37

Accepted Solution

by:
Geert Gruwez earned 500 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

895 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now