paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-01 08:56:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed classname bug and StreamJITForm index bug

Browse Source 
git-svn-id: trunk@277 -
This commit is contained in:
lazarus 2001-05-30 19:06:04 +00:00
parent 9068ebd544
commit e57580d034
1 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
designer/jitforms.pp
View File

@ -29,7 +29,7 @@ type
// Just-In-Time-Form List // Just-In-Time-Form List
TJITForms = class(TPersistent) TJITForms = class(TPersistent)
private private
FForms: TList; FForms: TList; // list of TJITForm
FCurReadForm:TForm; FCurReadForm:TForm;
FCurReadClass:TClass; FCurReadClass:TClass;
FRegCompList:TRegisteredComponentList; FRegCompList:TRegisteredComponentList;
@ -207,7 +207,7 @@ begin
if NewFormName<>'' then if NewFormName<>'' then
Instance.Name:=NewFormName; Instance.Name:=NewFormName;
DoRenameClass(FCurReadClass,NewClassName); DoRenameClass(FCurReadClass,NewClassName);
//writeln('[TJITForms.DoCreateJITForm] Initialization was successful!'); //writeln('[TJITForms.DoCreateJITForm] Initialization was successful! FormName="',NewFormName,'"');
except except
TComponent(FCurReadForm):=nil; TComponent(FCurReadForm):=nil;
writeln('[TJITForms.DoCreateJITForm] Error while creating instance'); writeln('[TJITForms.DoCreateJITForm] Error while creating instance');
@ -221,7 +221,7 @@ var NewFormName,NewClassName:shortstring;
begin begin
Writeln('[TJITForms] AddNewJITForm'); Writeln('[TJITForms] AddNewJITForm');
GetUnusedNames(NewFormName,NewClassName); GetUnusedNames(NewFormName,NewClassName);
Writeln('Newformname is '+NewFormname); Writeln('NewFormName is ',NewFormname,', NewClassName is ',NewClassName);
Result:=DoCreateJITForm(NewFormName,NewClassName); Result:=DoCreateJITForm(NewFormName,NewClassName);
end; end;
@ -246,18 +246,18 @@ begin
end; end;
function TJITForms.AddJITFormFromStream(BinStream:TStream):integer; function TJITForms.AddJITFormFromStream(BinStream:TStream):integer;
// 0 = ok // returns new index
// -1 = invalid stream // -1 = invalid stream
var var
Reader:TReader; Reader:TReader;
NewClassName:shortstring; NewClassName:shortstring;
a:integer; a:integer;
begin begin
Result:=0; Result:=-1;
NewClassName:=GetClassNameFromStream(BinStream); NewClassName:=GetClassNameFromStream(BinStream);
if NewClassName='' then begin if NewClassName='' then begin
Application.MessageBox('No classname in form stream found.','',mb_OK); Application.MessageBox('No classname in form stream found.','',mb_OK);
Result:=-1; exit; exit;
end; end;
writeln('[TJITForms.AddJITFormFromStream] 1'); writeln('[TJITForms.AddJITFormFromStream] 1');
try try
@ -296,7 +296,6 @@ writeln('[TJITForms.AddJITFormFromStream] 6');
FindGlobalComponent:=nil; FindGlobalComponent:=nil;
Reader.Free; Reader.Free;
end; end;
Result:=0;
except except
writeln('[TJITForms.AddJITFormFromStream] ERROR reading form stream' writeln('[TJITForms.AddJITFormFromStream] ERROR reading form stream'
+' of Class ''',NewClassName,''''); +' of Class ''',NewClassName,'''');
@ -365,9 +364,10 @@ const
vmtSize:integer=2000; //XXX how big is the vmt of class TJITForm ? vmtSize:integer=2000; //XXX how big is the vmt of class TJITForm ?
var MethodTable, NewMethodTable : PMethodNameTable; var MethodTable, NewMethodTable : PMethodNameTable;
MethodTableSize: integer; MethodTableSize: integer;
ClassNamePtr: Pointer;
begin begin
//writeln('[TJITForms.CreatevmtCopy] SourceClass='''+SourceClass.ClassName+'''' //writeln('[TJITForms.CreatevmtCopy] SourceClass='''+SourceClass.ClassName+''''
// +' NewClassName='''+NewClassName+''''); // +' NewClassName='''+NewClassName+'''');
// create copy of vmt // create copy of vmt
GetMem(Result,vmtSize); GetMem(Result,vmtSize);
// type of self is class of TJITForm => it points to the vmt // type of self is class of TJITForm => it points to the vmt
@ -381,17 +381,26 @@ begin
Move(MethodTable^,NewMethodTable^,MethodTableSize); Move(MethodTable^,NewMethodTable^,MethodTableSize);
PPointer(Result+vmtMethodTable)^:=NewMethodTable; PPointer(Result+vmtMethodTable)^:=NewMethodTable;
end; end;
PShortString((Pointer(Result)+vmtClassName)^)^:=NewClassName; // create pointer to classname
ClassNamePtr:=Pointer(Result)+vmtClassName;
GetMem(Pointer(ClassNamePtr^),SizeOf(Pointer));
Pointer(Pointer(ClassNamePtr^)^):=nil;
PShortString(ClassNamePtr^)^:=NewClassName;
end; end;
procedure TJITForms.FreevmtCopy(vmtCopy:Pointer); procedure TJITForms.FreevmtCopy(vmtCopy:Pointer);
var MethodTable : PMethodNameTable; var MethodTable : PMethodNameTable;
ClassNamePtr: Pointer;
begin begin
//writeln('[TJITForms.FreevmtCopy] ClassName='''+TClass(vmtCopy).ClassName+''''); //writeln('[TJITForms.FreevmtCopy] ClassName='''+TClass(vmtCopy).ClassName+'''');
if vmtCopy=nil then exit; if vmtCopy=nil then exit;
// free copy of methodtable
MethodTable:=PMethodNameTable((Pointer(vmtCopy)+vmtMethodTable)^); MethodTable:=PMethodNameTable((Pointer(vmtCopy)+vmtMethodTable)^);
if (Assigned(MethodTable)) then if (Assigned(MethodTable)) then
FreeMem(MethodTable); FreeMem(MethodTable);
// free pointer to classname
ClassNamePtr:=Pointer(vmtCopy)+vmtClassName;
FreeMem(Pointer(ClassNamePtr^));
FreeMem(vmtCopy); FreeMem(vmtCopy);
end; end;