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 ?
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).
ASKER
i am using GIFImg unit TGIFImage here is my form code for better help
//before cell paint
//Timer
loading gifs
//free node
compare node
//adding nodes
what i am doing wrong why the tree is leaking memory ?
Note when i don't draw TargetCanvas.StretchDraw( NewRect, TGraphic(Data.FObject.imag e)); inside onbefirecellpaint no freeze happend and application work normal so its clearly a gif issue any help with that ?
procedure TForm2.FormCreate(Sender: TObject);
begin
GIFImg.GIFImageDefaultAnimate := True;
GIFImg.GIFImageDefaultAnimationLoop := glContinously;
GIFImg.GIFImageDefaultTransparent := True;
end;
//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;
//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;
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;
;
//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;
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;
//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;
what i am doing wrong why the tree is leaking memory ?
Note when i don't draw TargetCanvas.StretchDraw( NewRect, TGraphic(Data.FObject.imag
It would be useful to know Tuserdataclass implementation, Delphi version, Gif component ...
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;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.