Здравствуйте, сегодня столкнулся с такой проблемой, я создаю компонент для приложения - сниффера инет. трафика, реализация выглядит примерно так
TTCPSniffer (ScrollBox) -> dyn array of TViewPort (TPanel) -> TStringGrid and TMemo
Но, хотелось бы сократить место на панельках TViewPort и сделать всё табами, как вдруг столкнулся с весьма неприятной проблемой, моя Delphi XE3 вообще удаляет TViewPort 0_o
Код:
constructor TViewPort.Create(AOwner: TComponent);
type
TTCItem = record
mask: UINT;
dwState: DWORD;
dwStateMask: DWORD;
pszText: LPWSTR;
cchTextMax: Integer;
iImage: Integer;
lParam: LPARAM;
end;
const
TCIF_TEXT = $0001;
TCM_FIRST = $1300;
TCM_INSERTITEM = TCM_FIRST + 62;
var
i: integer;
TCItem: TTCItem;
begin
inherited;
fHex:= TStringGrid.Create(nil);
fMemo:= TOutMemo.Create(nil);
Update;
fTabCtrl:= TTabControl.Create(nil);
ShowMessage('1');
fTabCtrl.Left:= 20;
fTabCtrl.Top:= 100;
fTabCtrl.Width:= 400;
fTabCtrl.Height:= 100;
fTabCtrl.MultiLine:= true;
fTabCtrl.Style:= TTabStyle.tsTabs;
fTabCtrl.TabPosition:= tpTop;
ShowMessage('2');
TCItem.mask := TCIF_TEXT;
TCItem.pszText := PChar('Общая информация');
try
SendStructMessage(fTabCtrl.Handle, TCM_INSERTITEM, 0, TCItem);
finally
ShowMessage('3');
end;
fTabCtrl.Tabs.Add('HEX - редактор');
fTabCtrl.Tabs.Add('Консоль плагинов');
fTabCtrl.Tabs.Add('Описание формата');
fTabCtrl.Parent:= self;
fHex.Left:= 490;
fHex.Height:= 180;
fHex.Width:= 530;
fHex.Top:= 10;
fHex.Parent:= self;
fHex.Show;
fHex.ColCount:= 18;
fHex.ColWidths[0]:= 36;
fHex.Rows[0][0]:= 'HEX';
for I := 1 to 16 do
begin
fHex.ColWidths[i]:= 20;
fHex.Rows[0][i]:= IntToStr(i);
end;
fHex.Rows[0][17]:= 'Данные';
fHex.ColWidths[17]:= 150;
fHex.Font.Name := 'Courier New';
fMemo.ReadOnly:= true;
fMemo.Left:= 10;
fMemo.Width:= 700;
fMemo.Height:= 150;
fMemo.ScrollBars:= ssBoth;
fMemo.Parent:= self;
fHex.DoubleBuffered:= true;
fMemo.DoubleBuffered:= true;
DoubleBuffered:= true;
end;
Ошибок не возникает, приложение не падает, в отладчике видно, что при SendStructMessage и fTabCtrl.Tabs.Add мы попадаем в модуль System в функцию
Код:
function _ClassCreate(InstanceOrVMT: Pointer; Alloc: ShortInt): Pointer;
{$IFNDEF CPUX86}
begin
if Alloc >= 0 then
InstanceOrVMT := Pointer(TClass(InstanceOrVMT).NewInstance);
Result := TObject(InstanceOrVMT);
end;
{$ELSE CPUX86}
asm
{ -> EAX = pointer to VMT }
{ <- EAX = pointer to instance }
PUSH EDX
PUSH ECX
PUSH EBX
TEST DL,DL
JL @@noAlloc
CALL DWORD PTR [EAX] + VMTOFFSET TObject.NewInstance
@@noAlloc:
{$IFDEF STACK_BASED_EXCEPTIONS}
XOR EDX,EDX
LEA ECX,[ESP+16]
MOV EBX,FS:[EDX]
MOV [ECX].TExcFrame.next,EBX
MOV [ECX].TExcFrame.hEBP,EBP
MOV [ECX].TExcFrame.desc,offset @desc
MOV [ECX].TexcFrame.ConstructedObject,EAX { trick: remember copy to instance }
MOV FS:[EDX],ECX
{$ENDIF STACK_BASED_EXCEPTIONS}
POP EBX
POP ECX
POP EDX
RET
{$IFDEF STACK_BASED_EXCEPTIONS}
@desc:
JMP _HandleAnyException
{ destroy the object }
MOV EAX,[ESP+8+9*4] // И ТУТ МЫ ПОЯВЛЯЕМСЯ НЕ ИЗВЕСТНО ПОЧЕМУ
MOV EAX,[EAX].TExcFrame.ConstructedObject
TEST EAX,EAX
JE @@skip
MOV ECX,[EAX]
MOV DL,$81
PUSH EAX
CALL DWORD PTR [ECX] + VMTOFFSET TObject.Destroy
POP EAX
CALL _ClassDestroy
@@skip:
{ reraise the exception }
CALL _RaiseAgain
{$ENDIF STACK_BASED_EXCEPTIONS}
end;
{$ENDIF CPUX86}
Оптимизация выключена, хоть я и не совсем понимаю, что за слева снизу ошибкоподобные сообщения.
Полный исходный код в аттаче, прошу не ругать, это версия собрана на коленке в спешке, но из-за этих табов всё встало, притом разницы нет TTabControl или TPageControl!!! Пожалуйста помоги разобраться!!!