paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 09:19:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: view forms: check lfm on disk

Browse Source 
git-svn-id: trunk@27942 -
This commit is contained in:
mattias 2010-10-29 11:26:44 +00:00
parent 2ea1d344f1
commit 64ed209693
2 changed files with 56 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
ide/main.pp
View File

@ -8809,32 +8809,54 @@ var
MainUnitInfo: TUnitInfo;
ActiveSourceEditor: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
CurUnitInfo: TUnitInfo;
LFMFilename: String;
LFMType: String;
LFMComponentName: String;
LFMClassName: String;
anUnitName: String;
begin
GetCurrentUnit(ActiveSourceEditor, ActiveUnitInfo);
for i := 0 to Project1.UnitCount - 1 do
begin
if not Project1.Units[i].IsPartOfProject then
CurUnitInfo:=Project1.Units[i];
if not CurUnitInfo.IsPartOfProject then
Continue;
if ItemType in [piComponent, piFrame] then
begin
// add all form names of project
if Project1.Units[i].ComponentName <> '' then
if CurUnitInfo.ComponentName <> '' then
begin
if (ItemType = piComponent) or
((ItemType = piFrame) and (Project1.Units[i].ResourceBaseClass = pfcbcFrame)) then
ItemList.AddObject(Project1.Units[i].Unit_Name,
TViewUnitsEntry.Create(Project1.Units[i].ComponentName, i,
Project1.Units[i] = ActiveUnitInfo));
((ItemType = piFrame) and (CurUnitInfo.ResourceBaseClass = pfcbcFrame)) then
ItemList.AddObject(CurUnitInfo.Unit_Name,
TViewUnitsEntry.Create(CurUnitInfo.ComponentName, i,
CurUnitInfo = ActiveUnitInfo));
end else if FilenameIsAbsolute(CurUnitInfo.Filename)
and FilenameIsPascalSource(CurUnitInfo.Filename)
and FileExistsCached(CurUnitInfo.Filename) then begin
LFMFilename:=ChangeFileExt(CurUnitInfo.Filename,'.lfm');
if FileExistsCached(LFMFilename) then begin
if ReadLFMHeaderFromFile(LFMFilename,LFMType,LFMComponentName,LFMClassName)
then begin
anUnitName:=CurUnitInfo.Unit_Name;
if anUnitName='' then
anUnitName:=ExtractFileNameOnly(LFMFilename);
ItemList.AddObject(anUnitName,
TViewUnitsEntry.Create(LFMComponentName, i,
CurUnitInfo = ActiveUnitInfo));
end;
end;
end;
end else
begin
// add all unit names of project
if (Project1.Units[i].FileName <> '') then
if (CurUnitInfo.FileName <> '') then
begin
AUnitName := ExtractFileName(Project1.Units[i].Filename);
AUnitName := ExtractFileName(CurUnitInfo.Filename);
if ItemList.IndexOf(AUnitName) = -1 then
ItemList.AddObject(AUnitName,
TViewUnitsEntry.Create(AUnitName, i, Project1.Units[i] = ActiveUnitInfo));
TViewUnitsEntry.Create(AUnitName, i, CurUnitInfo = ActiveUnitInfo));
end
else
if Project1.MainUnitID = i then

25
lcl/lresources.pp
View File

@ -487,6 +487,8 @@ procedure ReadLFMHeader(const LFMSource: string;
out LFMClassName: String; out LFMType: String);
procedure ReadLFMHeader(const LFMSource: string;
out LFMType, LFMComponentName, LFMClassName: String);
function ReadLFMHeaderFromFile(const Filename: string;
out LFMType, LFMComponentName, LFMClassName: String): boolean;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
type
@ -2048,6 +2050,29 @@ begin
LFMClassName:=copy(LFMSource,StartPos,p-StartPos);
end;
function ReadLFMHeaderFromFile(const Filename: string; out LFMType,
LFMComponentName, LFMClassName: String): boolean;
var
fs: TFileStream;
Header: string;
Cnt: LongInt;
begin
Result:=false;
try
fs:=TFileStream.Create(Filename,fmOpenRead);
try
SetLength(Header,600);
Cnt:=fs.Read(Header[1],length(Header));
SetLength(Header,Cnt);
ReadLFMHeader(Header,LFMType,LFMComponentName,LFMClassName);
Result:=LFMClassName<>'';
finally
fs.Free;
end;
except
end;
end;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
// 0 = ok
// -1 = error while streaming AForm to binary stream