Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Перенос дельфи кода в Lazarus, требуется совет 
V
    Опции темы
CynicRus
Дата 13.7.2012, 10:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Доброго дня, уважаемые форумчане. собственно при переносе компонента из Дельфи в лазарус - столкнулся с непонятной проблемой.

Имеется класс:
Код


TGsvObjectInspectorInplaceEditor = class(MaskEdit.TCustomMaskEdit)
  public
    constructor Create(AOwner: TComponent); override;

  private
    // собственные переменные
    FInspector:     TGsvCustomObjectInspectorGrid;
    FPropertyInfo:  PGsvObjectInspectorPropertyInfo; // дескриптор редактируемого свойства
    FListBox:       TGsvObjectInspectorListBox;      // окно выпадающего списка строк
    FButtonWidth:   Integer; 
    FPressed:       Boolean; 
    FWasPressed:    Boolean;
    FLockModify:    Boolean; 
    FDropDownCount: Integer; 

    procedure SetNewEditText(const Value: String);
    procedure ShowEditor(ALeft, ATop, ARight, ABottom: Integer;
              Info: PGsvObjectInspectorPropertyInfo;
              const Value: String);
    procedure HideEditor;
    procedure ShowEditHint;
    procedure ShowValueHint;
    procedure DropDown;
    procedure CloseUp(Accept: Boolean);
    procedure ListItemChanged;
    procedure SetListItem(Index: Integer);
    procedure ShowDialog;
    procedure ValidateStringValue(const Value: String);


    // события Windows
    procedure CMCancelMode(var Message: TLMessage); message LM_CANCELMODE;
    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;

  protected
    // переопределяемые методы базового класса
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure PaintWindow(DC: HDC); override;
    procedure DoExit; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint):
              Boolean; override;
    function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint):
              Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Change; override;
    procedure ValidateError;

  public
    procedure ValidateEdit; override;
  end;                                    
 у него есть поле класса TGsvObjectInspectorListBox;, 
Код

// Компонент выпадающего списка строк
  TGsvObjectInspectorListBox = class(TCustomListBox)
  public
    constructor Create(AOwner: TComponent); override;

  private
    FEditor: TGsvObjectInspectorInplaceEditor;

    procedure HideList(Accept: Boolean);

    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonDown); message WM_RBUTTONUP;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMMButtonUp(var Message: TWMMButtonDown); message WM_MBUTTONUP;

  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
              X, Y: Integer); override;
  end;

 у которого,в свою очередь -  есть поле класса TGsvObjectInspectorInplaceEditor. Вот так они друг на друга ссылаются, и в дельфи это работает прекрасно. В Lazarus же, как я не извращался - получаю Control of class 'TGsvObjectInspectorInplaceEditor ' cant have control of a class 'TGsvObjectInspectorListBox ' as сhild. Как это можно преодолеть? Заранее благодарю за помощь.

Это сообщение отредактировал(а) CynicRus - 13.7.2012, 10:52
PM MAIL   Вверх
Frees
Дата 13.7.2012, 11:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
а на какую строчку кода компилятор так ругается?


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 12:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
А exception выбрасывается в процессе выполнения, который ссылается на недры control.inc.
PM MAIL   Вверх
CynicRus
Дата 13.7.2012, 13:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Точнее, это происходит в функции:
Код

function TControl.CheckChildClassAllowed(ChildClass: TClass; ExceptionOnInvalid: boolean): boolean;
begin
  Result := ChildClassAllowed(ChildClass);
  if (not Result) and ExceptionOnInvalid then
    raise EInvalidOperation.CreateFmt(rsControlClassCantContainChildClass, [ClassName, ChildClass.ClassName]);
end;       
 соответственно, исключение возбуждается. Под отладчиком - это происходит в момент создания редактора.
PM MAIL   Вверх
Frees
Дата 13.7.2012, 13:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
тоесть ошибка в constructor TGsvObjectInspectorListBox.Create(AOwner: TComponent); ?

покажи код конструктора.


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 14:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
А до этого идет проверка присваивания Parent созданному экземпляру класса
конструктор первого:
Код

constructor TGsvObjectInspectorInplaceEditor.Create(AOwner: TComponent);
var
  w: Integer;
begin
  inherited Create(AOwner);
  FInspector := AOwner as TGsvCustomObjectInspectorGrid;
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  w := BUTTON_POINT_SIZE * 7; // 7 = 3 точки + 2 промежутка + 2 отступа по краям
  if FButtonWidth < w then
    FButtonWidth := w;
  ParentColor      := False;
  ParentFont       := True;
  Ctl3D            := False;
  ParentCtl3D      := False;
  TabStop          := False;
  BorderStyle      := bsNone;
  DoubleBuffered   := False;
  AutoSelect       := False;
  AutoSize         := False;
  ShowHint         := False;
  FListBox         := TGsvObjectInspectorListBox.Create(Self);
  FListBox.Parent  := Self;
end;


конструктов второго:
Код

constructor TGsvObjectInspectorListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEditor        := AOwner as TGsvObjectInspectorInplaceEditor;
  TabStop        := False;
  Visible        := False;
  Ctl3D          := False;
  ParentCtl3D    := False;
  ParentFont     := True;
  Color          := clWindow;
  ParentColor    := False;
  ShowHint       := False;
  ParentShowHint := False;
  IntegralHeight := True;
  TabStop        := False;
end;
 Причем сперва создается Editor соответственно.

Добавлено через 14 минут и 53 секунды
На строке: SetParent.Self - переход в 
Код

procedure TControl.SetParent(NewParent: TWinControl);
begin
  if FParent = NewParent then exit;
  DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.SetParent'){$ENDIF};
  try
    CheckNewParent(NewParent);
    if FParent <> nil then FParent.RemoveControl(Self);
    if cfBoundsRectForNewParentValid in FControlFlags then
    begin
      Exclude(FControlFlags, cfBoundsRectForNewParentValid);
      BoundsRect := BoundsRectForNewParent;
    end;
    if NewParent <> nil then NewParent.InsertControl(Self);
  finally
    EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.SetParent'){$ENDIF};
  end;
end;                      
 где в CheckNewParent - благополучно происходит облом.
PM MAIL   Вверх
Frees
Дата 13.7.2012, 14:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
Код

TGsvObjectInspectorListBox = class(TCustomListBox)
  public
      function ChildClassAllowed(ChildClass: TClass): boolean; override;
...
function TGsvObjectInspectorListBox.ChildClassAllowed(ChildClass: TClass): boolean;
begin
  Result:=true;
end; 


Добавлено через 1 минуту и 16 секунд
или

Код

TGsvObjectInspectorInplaceEditor = class(MaskEdit.TCustomMaskEdit)
  public
      function ChildClassAllowed(ChildClass: TClass): boolean; override;
...
function TGsvObjectInspectorInplaceEditor.ChildClassAllowed(ChildClass: TClass): boolean;
begin
  Result:=true;
end; 



--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 14:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Я уже пробовал примерно тоже самое, но результат один тот же самый-(
PM MAIL   Вверх
Frees
Дата 13.7.2012, 14:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
Цитата(CynicRus @  13.7.2012,  17:29 Найти цитируемый пост)
Я уже пробовал примерно тоже самое, но результат один тот же самый-(

что конкретно ты пробовал, "примерно" - понятие растяжимое 


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 14:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Первый, приведенный вами вариант. А вот второй, сейчас попробую.
PM MAIL   Вверх
Frees
Дата 13.7.2012, 14:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
поставь стоп в этой функции она вызывается при присвоении Parent?


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 14:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Со вторым вариантом на Parent:=self - не падает, но впадает в бесконечный цикл-( 

Код

 raise Exception.Create('TControl.InvalidatePreferredSize loop detected '+DbgSName(Self)+' Bounds='+dbgs(BoundsRect)); 


Добавлено через 2 минуты и 37 секунд
Вызывается на parent:= self при втором варианте.

Добавлено через 9 минут и 41 секунду
В первом варианте - не вызывается.
PM MAIL   Вверх
Frees
Дата 13.7.2012, 14:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 9
Всего: 54
Ставиш стоп на исключение и смотришь стек вызовов как ты докатился до него


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
CynicRus
Дата 13.7.2012, 15:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Собственно -  метод ShowEditor самого визуального компонента,
Код

procedure TGsvCustomObjectInspectorGrid.ShowEditor;
var
  y0: Integer;
begin
  // недоступно при проектировании
  if csDesigning in ComponentState then
    Exit;
  if (FRowsCount = 0) or (FTopRow < 0) or
     (FSelected < 0) or (FSelected >= FRowsCount) then
  begin
    HideEditor;
    Exit;
  end;
  // создаем окно, если его еще нет
  if not Assigned(FEditor) then begin
    if not HandleAllocated then
      Exit;
    FEditor           := TGsvObjectInspectorInplaceEditor.Create(Self);
    FEditor.Parent    := Self;
    FEditor.MaxLength := FMaxTextLength;
  end;
  // если выделенное свойство требует окна редактора, то показываем его
  // и передаем ему фокус ввода
  if HAS(_EDITOR, FRows[FSelected]) then begin
    y0 := (FSelected - FTopRow) * FRowHeight;
    FEditor.ShowEditor(FDividerPosition + 2, y0, ClientWidth, y0 + FRowHeight,
      FRows[FSelected], DoGetStringValue(FRows[FSelected]));
    UpdateFocus;
  end
  else
    HideEditor;
end;
  FEditor.Parent    := Self; - здесь, я перескакиваю опять на функции приведеные выше, после переопределения ChildClassAllowed - присходит вызов EnableAutoSizing(приведено выше) - и мы вернулись к чему начинали-( 
PM MAIL   Вверх
CynicRus
Дата 13.7.2012, 17:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: 5
Всем спасибо, это уже глюк лазаруса-)

2Frees: к несчастью пока плюс поставить не могу, но как смогу - с меня плюс.

Это сообщение отредактировал(а) CynicRus - 13.7.2012, 17:17
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0563 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.