TMemo.Lines.Objects

[flexterful]

Доброго времени суток,

Столкнулся с проблемой в Мемо.
Lines : TStrings в конструкторе получает TMemoLines.Create
А TMemoLines неумеют обращаться с объектами - функции неописаны.
Нужны же мне ети объекты в строках для локализации.

Кто сталкивался/решал сию проблему?

У меня Delphi XE

Заранее спасибо

[Прик]

Была раз такая проблемка.
Решение было такое: Строки загонялись в TStringList, объекты, понятно, есть куда деть.
После этого массив строк для отображения присваивался TMemo:

   Memo1.Lines.Assign(SL);

Ясно, что если требуется редактировать текст в Memo этот примитивный способ не подойдет.
А делать наследника от мемо...
Маленький кошмар в отдельно взятом проекте.

[flexterful]

Сделал я наследника от TCustomMemo, и TMemoLines переписал (наследника следать недаёт, ибо тип описан уже в имплемент секции).
Для объектов создал TObjectList.
Но вот грохаеться оно всё при выключении с 'Invalid pointer operation'...

type
  TObjectMemoStrings = class(TStrings)
  private
    Memo: TCustomObjectMemo;
    FObjects : TObjectList;
  protected
     {}
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure DeleteObject(Index : Integer);
    procedure ClearObjects;
     {}
  public
     {}
    constructor Create;
    destructor Destroy; override;
     {}
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;


{ TObjectMemoStrings }

constructor TObjectMemoStrings.Create;
begin
 inherited Create;

 FObjects := TObjectList.Create(True);
end;

destructor TObjectMemoStrings.Destroy;
begin
 ClearObjects;
 FObjects.Free;

 inherited Destroy;
end;

procedure TObjectMemoStrings.Insert(Index: Integer; const S: string);
var
  SelStart, LineLen: Integer;
  Line: string;
begin
  if Index >= 0 then
  begin
    SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
    if SelStart >= 0
     then Line := S + #13#10
     else begin
      SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index - 1, 0);
      if SelStart < 0 then Exit;
      LineLen := SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
      if LineLen = 0 then Exit;
      Inc(SelStart, LineLen);
      Line := #13#10 + s;
     end;
    SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart);
    SendTextMessage(Memo.Handle, EM_REPLACESEL, 0, Line);
{} FObjects.Insert(Index, nil);
  end;
end;

procedure TObjectMemoStrings.Delete(Index: Integer);
var
  SelStart, SelEnd: Integer;
begin
  SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  if SelStart >= 0 then
  begin
    SelEnd := SendMessage(Memo.Handle, EM_LINEINDEX, Index + 1, 0);
    if SelEnd < 0
     then SelEnd := SelStart + SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
    SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelEnd);
    SendTextMessage(Memo.Handle, EM_REPLACESEL, 0, '');
{}    DeleteObject(Index);
  end;
end;


procedure TObjectMemoStrings.Clear;
begin
{}  ClearObjects;
  Memo.Clear;
end;


function TObjectMemoStrings.GetObject(Index: Integer): TObject;
begin
 if (Index >= 0) and (Index < FObjects.Count)
   then Result := FObjects[Index]
   else Result := nil;
end;

procedure TObjectMemoStrings.PutObject(Index: Integer; AObject: TObject);
begin
 if (Index >= 0) and (Index < FObjects.Count)
  then FObjects[Index] := AObject;
end;

procedure TObjectMemoStrings.DeleteObject(Index : Integer);
var
 Elem : TObject;
begin
 if (Index >= 0) and (Index < FObjects.Count)
//  then Exit;
  then FObjects.Delete(Index);

{ Elem := FObjects[Index];
 if Assigned(Elem)
  then Elem.Free;

 FObjects.Delete(Index);
}
end;

procedure TObjectMemoStrings.ClearObjects;
var
 i : integer;
 Elem : TObject;
begin
{ for i := 0 to FObjects.Count - 1 do
  begin
   Elem := FObjects[i];
   if Assigned(Elem)
    then ;//FreeAndNil(Elem);
  end;}
 FObjects.Clear;
end;

[Прик]

Может сделать (предположение, разумеется)

FObjects := TObjectList.Create(False);

Ведь что получается. В процедуре DeleteObject элементы освобождаются, а потом еще сам ObjectList пытается их освобождать, если Create(True).

[flexterful]

Они освобождаються самим списком при Delete.

[Прик]

Да, вначале не заметил комментарий.
Тогда остается смотреть в отладке где облом происходит.

[flexterful]

Оказываеться сам чудак (на букву М) - сделал в главной форме освобождение объектов из TMemo (100 лет назад) и, конечно, забыл. Проблема решена очищением деструктора формы