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

MG: fixed form streaming of not direct TForm descendents

Browse Source 
git-svn-id: trunk@1719 -
This commit is contained in:
lazarus 2002-05-30 21:53:56 +00:00
parent 5a6ebefa4b
commit e76460e8d4
3 changed files with 37 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/finddeclarationtool.pas
View File

@ -1948,7 +1948,6 @@ var
ClassNameAtom: TAtomPosition; ClassNameAtom: TAtomPosition;
OldInput: TFindDeclarationInput; OldInput: TFindDeclarationInput;
ClassContext: TFindContext; ClassContext: TFindContext;
IdentifierFoundResult: TIdentifierFoundResult;
begin begin
Result:=false; Result:=false;
// if proc is a method, search in class // if proc is a method, search in class

21
debugger/watchesdlg.pp
View File

@ -44,24 +44,24 @@ uses
type type
TWatchesDlg = class(TDebuggerDlg) TWatchesDlg = class(TDebuggerDlg)
lvWatches: TListView; lvWatches: TListView;
procedure lvWatchesClick(Sender: TObject);
procedure lvWatchesSelectItem(Sender: TObject; AItem: TListItem; Selected: Boolean);
mnuPopup: TPopupMenu; mnuPopup: TPopupMenu;
popAdd: TMenuItem; popAdd: TMenuItem;
procedure popAddClick(Sender: TObject);
N1: TMenuItem; //-------------- N1: TMenuItem; //--------------
popProperties: TMenuItem; popProperties: TMenuItem;
procedure popPropertiesClick(Sender: TObject);
popEnabled: TMenuItem; popEnabled: TMenuItem;
procedure popEnabledClick(Sender: TObject);
popDelete: TMenuItem; popDelete: TMenuItem;
procedure popDeleteClick(Sender: TObject);
N2: TMenuItem; //-------------- N2: TMenuItem; //--------------
popDisableAll: TMenuItem; popDisableAll: TMenuItem;
procedure popDisableAllClick(Sender: TObject);
popEnableAll: TMenuItem; popEnableAll: TMenuItem;
procedure popEnableAllClick(Sender: TObject);
popDeleteAll: TMenuItem; popDeleteAll: TMenuItem;
procedure lvWatchesClick(Sender: TObject);
procedure lvWatchesSelectItem(Sender: TObject; AItem: TListItem; Selected: Boolean);
procedure popAddClick(Sender: TObject);
procedure popPropertiesClick(Sender: TObject);
procedure popEnabledClick(Sender: TObject);
procedure popDeleteClick(Sender: TObject);
procedure popDisableAllClick(Sender: TObject);
procedure popEnableAllClick(Sender: TObject);
procedure popDeleteAllClick(Sender: TObject); procedure popDeleteAllClick(Sender: TObject);
private private
FWatchesNotification: TDBGWatchesNotification; FWatchesNotification: TDBGWatchesNotification;
@ -96,7 +96,7 @@ uses
constructor TWatchesDlg.Create(AOwner: TComponent); constructor TWatchesDlg.Create(AOwner: TComponent);
begin begin
inherited; inherited Create(AOwner);
FWatchesNotification := TDBGWatchesNotification.Create; FWatchesNotification := TDBGWatchesNotification.Create;
FWatchesNotification.AddReference; FWatchesNotification.AddReference;
FWatchesNotification.OnAdd := @WatchAdd; FWatchesNotification.OnAdd := @WatchAdd;
@ -289,6 +289,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.3 2002/05/30 21:53:56 lazarus
MG: fixed form streaming of not direct TForm descendents
Revision 1.2 2002/05/10 06:57:48 lazarus Revision 1.2 2002/05/10 06:57:48 lazarus
MG: updated licenses MG: updated licenses

47
lcl/forms.pp
View File

@ -417,7 +417,9 @@ function InitResourceComponent(Instance: TComponent;
RootAncestor: TClass):Boolean; RootAncestor: TClass):Boolean;
function InitComponent(ClassType: TClass): Boolean; function InitComponent(ClassType: TClass): Boolean;
var CompResource:TLResource; var
CompResource:TLResource;
MemStream: TMemoryStream;
a:integer; a:integer;
begin begin
//writeln('[InitComponent] ',ClassType.Classname,' ',Instance<>nil); //writeln('[InitComponent] ',ClassType.Classname,' ',Instance<>nil);
@ -425,33 +427,34 @@ function InitResourceComponent(Instance: TComponent;
if (ClassType=TComponent) or (ClassType=RootAncestor) then exit; if (ClassType=TComponent) or (ClassType=RootAncestor) then exit;
if Assigned(ClassType.ClassParent) then if Assigned(ClassType.ClassParent) then
Result:=InitComponent(ClassType.ClassParent); Result:=InitComponent(ClassType.ClassParent);
CompResource:=LazarusResources.Find(Instance.ClassName); CompResource:=LazarusResources.Find(ClassType.ClassName);
if (CompResource = nil) or (CompResource.Value='') then exit; if (CompResource = nil) or (CompResource.Value='') then exit;
// Writeln('Compresource.value is '+CompResource.Value); //writeln('[InitComponent] CompResource found for ',ClassType.Classname);
if (ClassType.InheritsFrom(TForm)) if (ClassType.InheritsFrom(TForm))
and (CompResource.ValueType<>'FORMDATA') then exit; and (CompResource.ValueType<>'FORMDATA') then exit;
with TMemoryStream.Create do MemStream:=TMemoryStream.Create;
try
MemStream.Write(CompResource.Value[1],length(CompResource.Value));
MemStream.Position:=0;
writeln('Form Stream "',ClassType.ClassName,'" Signature=',copy(CompResource.Value,1,4));
try try
Write(CompResource.Value[1],length(CompResource.Value)); Instance:=MemStream.ReadComponent(Instance);
Position:=0; except
writeln('Form Stream Signature=',copy(CompResource.Value,1,4)); on E: Exception do begin
try writeln('Form streaming "',ClassType.ClassName,'" error: ',E.Message);
Instance:=ReadComponent(Instance); exit;
// MG: workaround til Visible=true is default
if Instance is TControl then
for a:=0 to Instance.ComponentCount-1 do
if Instance.Components[a] is TControl then
TControl(Instance.Components[a]).Visible:=true;
// MG end of workaround
except
on E: Exception do begin
writeln('Form streaming: ',E.Message);
exit;
end;
end; end;
finally
Free;
end; end;
finally
// MG: workaround til Visible=true is default
if Instance is TControl then
for a:=0 to Instance.ComponentCount-1 do
if Instance.Components[a] is TControl then begin
TControl(Instance.Components[a]).Visible:=true;
end;
// MG end of workaround
MemStream.Free;
end;
Result:=true; Result:=true;
end; end;