paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-07 21:25:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed loading program file bug

Browse Source 
git-svn-id: trunk@247 -
This commit is contained in:
lazarus 2001-03-29 13:11:33 +00:00
parent 751a6f677e
commit 0ffbcd9238
1 changed files with 27 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
ide/main.pp
View File

@ -2163,7 +2163,7 @@ end;
function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult; function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult;
var UnitList: TList; var UnitList: TList;
i, ProgramNameStart, ProgramNameEnd:integer; i, ProgramNameStart, ProgramNameEnd:integer;
MainUnitName: string; MainUnitName, Ext: string;
MainUnitInfo, AnUnitInfo: TUnitInfo; MainUnitInfo, AnUnitInfo: TUnitInfo;
MainUnitIndex: integer; MainUnitIndex: integer;
Begin Begin
@ -2173,11 +2173,13 @@ Begin
for i:=0 to Project.UnitCount-1 do begin for i:=0 to Project.UnitCount-1 do begin
if Project.Units[i].IsPartOfProject then begin if Project.Units[i].IsPartOfProject then begin
if OnlyForms then begin if OnlyForms then begin
if Project.MainUnit=i then MainUnitIndex:=i;
if Project.Units[i].FormName<>'' then if Project.Units[i].FormName<>'' then
UnitList.Add(TViewUnitsEntry.Create( UnitList.Add(TViewUnitsEntry.Create(
Project.Units[i].FormName,i,false)); Project.Units[i].FormName,i,false));
end else begin end else begin
if Project.Units[i].UnitName<>'' then begin if Project.Units[i].UnitName<>'' then begin
if Project.MainUnit=i then MainUnitIndex:=i;
UnitList.Add(TViewUnitsEntry.Create( UnitList.Add(TViewUnitsEntry.Create(
Project.Units[i].UnitName,i,false)); Project.Units[i].UnitName,i,false));
end else if Project.MainUnit=i then begin end else if Project.MainUnit=i then begin
@ -2191,6 +2193,11 @@ Begin
MainUnitName:=FindProgramNameInSource(MainUnitInfo.Source.Source MainUnitName:=FindProgramNameInSource(MainUnitInfo.Source.Source
,ProgramNameStart,ProgramNameEnd); ,ProgramNameStart,ProgramNameEnd);
end; end;
if MainUnitName='' then begin
MainUnitName:=ExtractFileName(MainUnitInfo.Filename);
Ext:=ExtractFileExt(MainUnitName);
MainUnitName:=copy(MainUnitName,1,length(MainUnitName)-length(Ext));
end;
if MainUnitName<>'' then begin if MainUnitName<>'' then begin
MainUnitIndex:=UnitList.Count; MainUnitIndex:=UnitList.Count;
UnitList.Add(TViewUnitsEntry.Create( UnitList.Add(TViewUnitsEntry.Create(
@ -2446,6 +2453,8 @@ end;
function TMainIDE.DoOpenProjectFile(AFileName:string):TModalResult; function TMainIDE.DoOpenProjectFile(AFileName:string):TModalResult;
var Ext,AText,ACaption,LPIFilename:string; var Ext,AText,ACaption,LPIFilename:string;
LowestEditorIndex,LowestUnitIndex,LastEditorIndex,i:integer; LowestEditorIndex,LowestUnitIndex,LastEditorIndex,i:integer;
SrcStream: TMemoryStream;
NewSource: string;
begin begin
writeln('TMainIDE.DoOpenProjectFile 1'); writeln('TMainIDE.DoOpenProjectFile 1');
Result:=mrCancel; Result:=mrCancel;
@ -2483,6 +2492,20 @@ writeln('TMainIDE.DoOpenProjectFile 1');
LPIFilename:=ChangeFileExt(AFilename,'.lpi'); LPIFilename:=ChangeFileExt(AFilename,'.lpi');
Project:=TProject.Create(ptProgram); Project:=TProject.Create(ptProgram);
Project.ReadProject(LPIFilename); Project.ReadProject(LPIFilename);
if Project.MainUnit=0 then begin
// read MainUnit Source
SrcStream:=TMemoryStream.Create;
try
Result:=DoLoadMemoryStreamFromFile(SrcStream
,ChangeFileExt(AFilename,'.lpr'));
if Result=mrAbort then exit;
SetLength(NewSource,SrcStream.Size);
SrcStream.Read(NewSource[1],length(NewSource));
Project.Units[Project.MainUnit].Source.Source:=NewSource;
finally
SrcStream.Free;
end;
end;
UpdateCaption; UpdateCaption;
// restore files // restore files
LastEditorIndex:=-1; LastEditorIndex:=-1;
@ -3201,6 +3224,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.85 2001/03/29 13:11:33 lazarus
MG: fixed loading program file bug
Revision 1.84 2001/03/29 12:38:59 lazarus Revision 1.84 2001/03/29 12:38:59 lazarus
MG: new environment opts, ptApplication bugfixes MG: new environment opts, ptApplication bugfixes