Solved

tvirtualstringtree freeze when load too manny images

Posted on 2016-11-20
10
22 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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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
Comment Utility
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 36

Accepted Solution

by:
Geert Gruwez earned 500 total points
Comment Utility
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
userCompare  challenge 3 61
bunnyEars challenge 6 62
How  do I get an older program to run in Windows 10? 20 79
Path of Workbook 3 44
Does the idea of dealing with bits scare or confuse you? Does it seem like a waste of time in an age where we all have terabytes of storage? If so, you're missing out on one of the core tools in every professional programmer's toolbox. Learn how to …
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
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 …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now