1) Завел структуру TSimbaComponent, описывающую компонент существующий в скриптовом языке:
- Код: Выделить всё
type
TSimbaComponent = record
tp: integer;
caption: string;
left,top,width,heigth: integer;
fontcolor: TColor;
fontname: string;
fontsize: integer;
end;
type
PSimbaComponent = ^TSimbaComponent;
2) Написал класс-обертку для TList Для удобной работы с моей структурой:
- Код: Выделить всё
type
{ TSimbaComponentList }
TSimbaComponentList = class
private
FList: TList; // Simba components storage
public
constructor Create;
destructor Destroy; override;
function AddItem(Item: TSimbaComponent): Integer;
procedure RemoveItem(ItemIndex: Integer);
function GetComponent(Idx: integer): TSimbaComponent;
function GetComponentPtr(Idx: integer): PSimbaComponent;
function Count: integer;
end;
implementation
{ TSimbaComponentList }
constructor TSimbaComponentList.Create;
begin
FList := TList.Create;//create storage
inherited Create;
end;
destructor TSimbaComponentList.Destroy;
begin
FList.Free; //free storage
inherited Destroy;
end;
function TSimbaComponentList.AddItem(Item: TSimbaComponent): Integer;
var
p: PSimbaComponent;
begin
GetMem(p, SizeOf(Item)); // independently allocate memory
Move(Item, p^, SizeOf(Item));
Result := FList.Add(p); // simply redirect a call
end;
procedure TSimbaComponentList.RemoveItem(ItemIndex: Integer);
begin
FreeMem(FList[ItemIndex]); // freememory
FList.Delete(ItemIndex);
end;
function TSimbaComponentList.GetComponent(Idx: integer): TSimbaComponent;
begin
FillChar(Result, SizeOf(TSimbaComponent), #0);
Result := TSimbaComponent(FList.Items[Idx]^); // redirect a call and convert it to TBitmap
end;
function TSimbaComponentList.GetComponentPtr(Idx: integer): PSimbaComponent;
begin
Result := FList.Items[Idx];//redirect a call
end;
function TSimbaComponentList.Count: integer;
begin
Result := FList.Count;
end;
3) Написал процедуру, забирающую у контрола необходимые свойства и присваивающую их структуре:
- Код: Выделить всё
function TCompForm.ComponentToSimba(cmp: TControl): TSimbaComponent;
var
smb: TSimbaComponent;
begin
smb.caption:=cmp.Caption;
smb.top:=cmp.Top;
smb.width:=cmp.Width;
smb.left:=cmp.Left;
smb.heigth:=cmp.Height;
smb.tp:=GetControlType(cmp);
smb.fontcolor:=cmp.Font.Color;
smb.fontname:=cmp.Font.Name;
smb.fontsize:=cmp.Font.Size;
result:=smb;
end;
4) На главной форме разместил стринггрид, и заполняю его:
- Код: Выделить всё
procedure TCompForm.AddToStringGrid(cmp: TControl);
var
smb: TSimbaComponent;
begin
smb:=ComponentToSimba(cmp);
CompList.AddItem(smb);
with StringGrid1 do begin
Cells[1,1]:=cmp.ClassName;
Cells[1,2]:=smb.caption;
Cells[1,3]:=IntToStr(smb.top);
Cells[1,4]:=IntToStr(smb.left);
Cells[1,5]:=IntToStr(smb.width);
Cells[1,6]:=IntToStr(smb.heigth);
Cells[1,7]:=smb.fontname;
cells[1,8]:=IntToStr(smb.fontsize);
Cells[1,9]:=ColorToStr(smb.fontcolor);
end;
end;
5) Форма 2 создается в рантайме, и располагается на панели формы 1. После выбора контрола на первой форме, он располагается на форме 2, его свойства пишуться в структуру, затем структура отображается в гриде. Но только если выбран контрол, при простом клике на форму - я ловлю категорический сегфолт и уже весь мозг сломал, как же мне это вылечить. В отладчике смотрел - как я понимаю, косяк со свойством контрола Tag. Но как мне быть - придумать пока не могу-(
Код создания контрола
- Код: Выделить всё
procedure TDsgnForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
_comp := CreateComponent(Sender, X, Y);
if (_comp.Tag <> 0) then
CompForm.AddToStringGrid(_comp) else
CompForm.AddToStringGridEx(CompForm.CompList.GetComponent(0),_comp);
end;
Если убрать последние 3 строчки, то работает восхитительно. Если при клике на форму - выбран контрол для создание - то и с 3 последними строчками, все пашет замечательно. Так вот собственно вопрос - как избежать сегфолтов при клике на пустую форму, а при клике на существующий на форме 2 контрол - запихнуть в грид уже существующую информацию о нем из обертки?
Добавлено спустя 2 минуты 7 секунд:
PS: сегфолт ловлю на строке
- Код: Выделить всё
if (_comp.Tag <> 0) then
- Код: Выделить всё
if TMethod(@Self.GetTextBuf).Code = Pointer(@TControl.GetTextBuf)
