Solved

tvirtualstringtree freeze when load too manny images

Posted on 2016-11-20
10
61 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
Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

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

Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Dynamically Created Query 3 55
VbScript to countdown to New Year's Day 6 54
Removing line numbers from left column in config file 7 52
Cygwin - GNU GPL License 1 24
This is about my first experience with programming Arduino.
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

770 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