VPF::VirtualTree & TThread - Форум программистов

aktuba

Дата 22.11.2006, 16:16 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Вопрос к опытным: из основной формы программы создаю поток:

Код



...

TToDoElement = record
    Path: WideString;
    Data: TMemoryStream;
    Modify: Boolean;
  end;

  TToDoElements = array of TToDoElement;

...
procedure CreateThread(Sender: TObject);
procedure HandleThreadCompletion(var Message: TMessage); message WM_THREAD_COMPLETE;
...

procedure TfrmMain.CreateThread(Sender: TObject);
var
    Index: Integer;
  lStream: TMemoryStream;
begin
    if Assigned(FThread) or (FToDoList.Count <= 0) then Exit;
  FThread := TTimerThread.Create(True);
  FThread.FreeOnTerminate := False;
  SetLength(FThread.FArray, FToDoList.Count);
  for Index := 0 to FToDoList.Count - 1 do
    begin
      lStream := TMemoryStream.Create;
      try
        lStream.Clear;
        FToDoList.Data[Index].Position := 0;
        DecompressStream(FToDoList.Data[Index], lStream);
        FThread.FArray[Index].Data := TMemoryStream.Create;
        FThread.FArray[Index].Data.Clear;
        lStream.Position := 0;
        FThread.FArray[Index].Data.LoadFromStream(lStream);
        FThread.FArray[Index].Path := FToDoList.Path[Index];
        FThread.FArray[Index].Modify := FToDoList.Modify[Index];
      finally
        lStream.Free;
      end;
    end;
  FThread.FHandle := Handle;
  FThread.Resume;
end;

procedure TfrmMain.HandleThreadCompletion(var Message: TMessage);
begin
  if Assigned(FThread) then
    begin
      FThread.WaitFor;
      FThread.Free;
      FThread := nil;
    end;
end;

Вот модуль самого TThread-а:

Код


unit uTimerThread;

interface

uses
    Windows,
  Classes,
  VirtualTrees,
  uTypes,
  SysUtils;

type
    TProcedure = procedure(ANode: PVirtualNode) of object;

  TTimerThread = class(TThread)
  private
    { Private declarations }
    VT: TVirtualStringTree;
    procedure VTLoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream);
    procedure IterateNodes(Sender: TBaseVirtualTree);
    procedure SetTimer(ANode: PVirtualNode);
  protected
    procedure Execute; override;
  public
    FArray: TToDoElements;
    FHandle: THandle;
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
  end;

implementation

uses
  uVTUtils,
  uConsts;

{ TTimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  inherited;
    VT := TVirtualStringTree.Create(nil);
  VT.NodeDataSize := SizeOf(TDataNode);
  VT.OnLoadNode := VTLoadNode;
  SetLength(FArray, 0);
end;

destructor TTimerThread.Destroy;
var
    Index: Integer;
begin
    if Length(FArray) > 0 then
    for Index := 0 to Length(FArray) - 1 do
     begin
        FArray[Index].Data.Clear;
         FArray[Index].Data.Free;
        FArray[Index].Data := nil;
      end;
  SetLength(FArray, 0);
  VT.Free;
  inherited;
end;

procedure TTimerThread.Execute;
var
  Index: Integer;
begin
    if Length(FArray) <= 0 then Exit;
    for Index := 0 to Length(FArray) - 1 do
      begin
        FArray[Index].Data.Position := 0;
        VT.LoadFromStream(FArray[Index].Data);
        FArray[Index].Data.Clear;
        IterateNodes(VT);
      end;
   PostMessage(FHandle, WM_THREAD_COMPLETE, 0, 0);
end;

procedure TTimerThread.IterateNodes(Sender: TBaseVirtualTree);
var
    Hour, Min, s, ms, Day, Month, Year: Word;

  procedure IterNode(ANode: PVirtualNode; AProc: TProcedure);
  var
    lNode: PVirtualNode;
    lData: PDataNode;
  begin
    lNode := ANode.FirstChild;
    while Assigned(lNode) do
     begin
        lData := Sender.GetNodeData(lNode);
        if Assigned(lData) then
         begin
            if lData^.Timer.TimerType <> ttNone then
           case lData^.Timer.TimerType of
             ttOne:
               if (lData^.Timer.Date.D = Day) and
                  (lData^.Timer.Date.M = Month) and
                   (lData^.Timer.Date.Y = Year) and
                   (lData^.Timer.Time.H = Hour) and
                   (lData^.Timer.Time.M = Min) then AProc(lNode);
              ttDay: ;
              ttWeek: ;
              ttMonth: ;
              ttYear: ;
            end;
          end;
       IterNode(lNode, AProc);
        lNode := lNode.NextSibling;
      end;
  end;

begin
    if not Assigned(Sender) then Exit;
  if not (Sender is TVirtualStringTree) then Exit;
  if TVirtualStringTree(Sender).RootNodeCount <= 0 then Exit;
  DecodeTime(Now, Hour, Min, s, ms);
  DecodeDate(Now, Year, Month, Day);
    IterNode(Sender.RootNode, SetTimer);
end;

procedure TTimerThread.SetTimer(ANode: PVirtualNode);
begin
//
end;

procedure TTimerThread.VTLoadNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Stream: TStream);
var
  lData: PDataNode;
  lStream: TMemoryStream;
begin
    lData := Sender.GetNodeData(Node);
    if not Assigned(lData) then Exit;
  lStream := TMemoryStream.Create;
  try
    ReadStreamFromStream(Stream, lStream);
    LoadNodeFromStream(lStream, lData^);
  finally
        lStream.Free;
  end;
end;

end.

Где-то есть утечка памяти. не поможете? smile

--------------------

AriX

Дата 22.11.2006, 16:23 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 311
Регистрация: 16.6.2003

Репутация: 5
Всего: 19

По-моему самому скромного и не авторитетному мнению, OnFreeNode нет, в котором нужно делать Finalize данных привязанных к ноду.

aktuba

Дата 22.11.2006, 16:43 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Попробовал так:

Код


procedure TfrmMain.CreateThread(Sender: TObject);
var
    Index: Integer;
  lStream: TMemoryStream;
begin
    if Assigned(FThread) or (FToDoList.Count <= 0) then Exit;

  FThread := TTimerThread.Create(True);
  FThread.FreeOnTerminate := False;
  SetLength(FThread.FArray, FToDoList.Count);
  for Index := 0 to FToDoList.Count - 1 do
    begin
      lStream := TMemoryStream.Create;
      try
        lStream.Clear;
        FToDoList.Data[Index].Position := 0;
        DecompressStream(FToDoList.Data[Index], lStream);
        lStream.Position := 0;
        FThread.VT.LoadFromStream(lStream);
      finally
        lStream.Free;
      end;
    end;
  FThread.FHandle := Handle;
  FThread.Resume;
end;

Эффект тот-же!!! Получается утечка не при передаче данных, а в Virtual Tree???
Есть какие идеи? smile

Добавлено @ 16:45
AriX: не понял, можно подробнее?

--------------------

Bose

Дата 22.11.2006, 17:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

у Virtual String Tree есть событие OnFreeNode - которое вызывается при удалении узла. В этом событии нужно освобождать память для дополнительных объектов, если такие есть. Virtual Tree сам следит за памятью, выделяет/освобождает её при добавлении/удалении узла.

aktuba
Что за тип TDataNode?

Объекты какого типа не освобождаются у тебя(утекают)?

Это сообщение отредактировал(а) Bose - 22.11.2006, 17:44

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

aktuba

Дата 23.11.2006, 12:51 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Bose и AriX - ОГРОМНОЕ СПАСИБО. Теперь разобрался, причина была в том, что у меня в данных есть TStream, который не освобождался, но ссылка на который убивалась.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »