Link to home
Start Free TrialLog in
Avatar of drama22
drama22

asked on

Virtualstringtree carsh after invalidate for while

In my application I should run invalidate within timer for as long as my application running because I draw some animated gifs inside nodes but after hour or so invalidate caused crash to my application is this a bug ?
Avatar of Sinisa Vuk
Sinisa Vuk
Flag of Croatia image

Yes... :-) From memory leak until some logic bug. Which component you use to animate gif? I've noticed that some are very buggy (had problem with one before).
Avatar of drama22
drama22

ASKER

i am using GIFImg unit  TGIFImage here is my form code for better help
procedure TForm2.FormCreate(Sender: TObject);
begin
  GIFImg.GIFImageDefaultAnimate       := True;
  GIFImg.GIFImageDefaultAnimationLoop := glContinously;
  GIFImg.GIFImageDefaultTransparent   := True;
end;

Open in new window


//before cell paint

procedure TForm2.VTs1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: PUserData;
NewRect : TRect;
xOff, yOff : Integer;
begin


if not Assigned(Node) then
Exit;

Data := VTS1.GetNodeData(Node);

xSelItemTop    := CellRect.Top + Tuserdataclass(Data.FObject).image.Height;




//image
begin
TargetCanvas.Brush.Style := bsClear;
TargetCanvas.FillRect(CellRect);
NewRect := CellRect;
NewRect.Left   := NewRect.Left + 30;
NewRect.Width  := 30;
Newrect.Height :=  Tuserdataclass(Data.FObject).image.Height;
NewRect.Top    := NewRect.Top + 2;
NewRect.Bottom := NewRect.Bottom;
TargetCanvas.StretchDraw( NewRect, TGraphic(Tuserdataclass(Data.FObject).image));
Vts1.NodeHeight[Node] := Tuserdataclass(Data.FObject).image.Height;
end;


//text
begin
NewRect := CellRect;
NewRect.Left   := NewRect.Left + 2;
NewRect.Width  := 24;
Newrect.Height :=  Tuserdataclass(Data.FObject).image.Height;
NewRect.Top    := NewRect.Top;
NewRect.Bottom := NewRect.Bottom;
xOff := CellRect.Left + 70;
yOff := CellRect.Top + ((Tuserdataclass(Data.FObject).image.Height-TargetCanvas.TextHeight('H')) div 2);
if xboolBlink or ( Tuserdataclass(Data.FObject).bool = False ) then
TargetCanvas.font.color := clgray;
TargetCanvas.TextOut( xOff, yOff, Tuserdataclass(Data.FObject).username);
end;
end;

Open in new window



//Timer

procedure TForm2.Timer1Timer(Sender: TObject);
{$j+}
  Const iCount : Cardinal = 0;
{$j-}
begin
  inc(iCount);
  if (iCount * TTimer(Sender).Interval) > 500 then
  begin  // this is for blink text which subitem[2] contains 'blink'
    xboolBlink := NOT xboolBlink;
    iCount := 0;
  end;
Vts1.Invalidate;
end;

Open in new window


loading gifs
function TForm2.lookingTreeView(name: String): PVirtualNode;
var
Node : PVirtualNode;
Data : PUserData;
begin
Result := nil;
Node := VDT1.GetFirst;
while ((Node <> nil) and (Result = nil)) do
begin
Data := VDT1.GetNodeData(Node);
if (Data.FObject.userUid = name) then
Result := Node;
Node := VDT1.GetNext(Node);
end;
end;



procedure TForm2.UpdateVisual(Sender: TObject; Anameofimg: String; var Aimagelocate: String);
var
Node: PVirtualNode;
Data: PUserData;
i : integer;
loadgif : TGifImage;
RS: TResourceStream;
begin
Node := lookingTreeView(Anameofimg);
if not Assigned(Node) then
Exit;
if (Node <> nil) then
begin
Data := VDT1.GetNodeData(Node);
if Data.FObject.userUid = Anameofimg then
begin
if (ExtractFileExt(Aimagelocate) = '.gif') then
begin
loadgif := TGifImage.Create;
 loadgif.LoadFromFile(Aimagelocate);
 loadgif.Transparent := true;

 if loadgif.Height > 80 then
 begin
Data.FObject.imageH :=  100;
 end else
 begin
Data.FObject.imageH :=  loadgif.Height;
 end;
Data.FObject.image := loadgif;
end else if Aimagelocate = 'error' then
begin
 loadgif := TGifImage.Create;
  try
 RS := TResourceStream.Create(hInstance, 'f1', RT_RCDATA);
 loadgif.LoadFromStream(RS);
 Data.FObject.image := loadgif;
finally
RS.Free;
end;
end;
end;
end;
end;
;

Open in new window


//free node

procedure Tform2.VDT1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PUserData;
begin
Data:=VDT1.GetNodeData(Node);
if Assigned(Data) then
Data.FObject.Free;
end;

Open in new window


compare node

procedure Tform2.VDT1CompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
Data1, Data2: PUserData;
begin
Data1 := VDT1.GetNodeData(Node1);
Data2 := VDT1.GetNodeData(Node2);

if (Data1.FObject.istalking = True) and (Data2.FObject.Istalking = False) then
      Result := 1
    else if (Data1.FObject.istalking = False) and (Data2.FObject.istalking = False) then
      Result := -1
    else
      Result := CompareStr(Data1.FObject.username, Data2.FObject.username);

end;

Open in new window


//adding nodes

function AddVSTStructure(AVST: TCustomVirtualStringTree; ANode:
PVirtualNode;
AObject: Tuserdataclass): PVirtualNode;
var
Data: PUserData;
begin
Result:=AVST.AddChild(ANode);
Data:=AVST.GetNodeData(Result);
Avst.ValidateNode(Result, False);
Data^.FObject := AObject;
end;

Procedure TForm2.Add_Item( strCaption: String;  boolBlink : Boolean; strUniqueID:String;);
var
userdataclass: Tuserdataclass;

begin
VDT1.BeginUpdate;
   try
   begin
userdataclass := Tuserdataclass.Create;
userdataclass.username:= strCaption;
userdataclass.userUid := strUniqueID;
userdataclass.Color := 'clred';
userdataclass.istalking := False;
if boolBlink then

userdataclass.bool:= True else

userdataclass.bool:= False;

  AddVSTStructure(VDT1,nil,userdataclass);

  finally
  VDT1.EndUpdate;
   end;

Open in new window


what i am doing wrong why the tree is leaking memory ?

Note when i don't draw TargetCanvas.StretchDraw( NewRect, TGraphic(Data.FObject.image)); inside onbefirecellpaint no freeze happend and application work normal so its clearly a gif issue any help with that ?
It would be useful to know Tuserdataclass implementation, Delphi version, Gif component ...
Avatar of drama22

ASKER

i am using delphi xe7 . and i am using Gifimage component TGIFImage  here is my tuserdataclass
  type
Tuserdataclass = class
private
Fusername: String;
FuserUid: String;
FColor : String;
Fimage : TGraphic;
FimageH : integer;
Fbool : Boolean;
Fistalking : Boolean;
public
property username: String read Fusername write Fusername;
property userUid: String read FuserUid write FuserUid;
property Color: String read FColor write FColor;
property image: TGraphic read Fimage write Fimage;
property bool: Boolean read Fbool write Fbool ;
property istalking: Boolean read Fistalking write Fistalking;
end;

type
PUserData = ^TUserData;
TUserData = record
FObject : Tuserdataclass;
end;

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Sinisa Vuk
Sinisa Vuk
Flag of Croatia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial