paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 11:37:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: added TLazProject.UseManifest/LoadDefaultIcon

Browse Source 
git-svn-id: trunk@32597 -
This commit is contained in:
mattias 2011-10-01 20:09:07 +00:00
parent 38c75a8c1f
commit d700c68b43
4 changed files with 49 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
ide/project.pp
View File

@ -56,7 +56,7 @@ uses
// IDEIntf
CompOptsIntf, ProjectIntf, MacroIntf, LazIDEIntf,
// IDE
CompOptsModes, ProjectResources, LazConf,
CompOptsModes, ProjectResources, LazConf, W32Manifest, ProjectIcon,
LazarusIDEStrConsts, CompilerOptions,
TransferMacros, EditorOptions, IDEProcs, RunParamsOpts, ProjectDefs,
FileReferenceList, EditDefineTree, PackageDefs, PackageSystem, IDEOptionsIntf,
@ -847,6 +847,8 @@ type
procedure SetModified(const AValue: boolean); override;
procedure SetSessionModified(const AValue: boolean); override;
procedure SetExecutableType(const AValue: TProjectExecutableType); override;
function GetUseManifest: boolean; override;
procedure SetUseManifest(AValue: boolean); override;
protected
// special unit lists
procedure AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList);
@ -960,6 +962,7 @@ type
// resources
function GetMainResourceFilename(AnUnitInfo: TUnitInfo): string;
function GetResourceFile(AnUnitInfo: TUnitInfo; Index:integer):TCodeBuffer;
procedure LoadDefaultIcon; override;
// filenames and fileinfo
function RemoveProjectPathFromFilename(const AFilename: string): string;
@ -3855,6 +3858,16 @@ begin
end;
end;
function TProject.GetUseManifest: boolean;
begin
Result:=TProjectXPManifest(ProjResources[TProjectXPManifest]).UseManifest;
end;
procedure TProject.SetUseManifest(AValue: boolean);
begin
TProjectXPManifest(ProjResources[TProjectXPManifest]).UseManifest:=AValue;
end;
class function TProject.GetInstance: TAbstractIDEOptions;
begin
Result := Project1;
@ -4076,6 +4089,11 @@ begin
end;
end;
procedure TProject.LoadDefaultIcon;
begin
TProjectIcon(ProjResources[TProjectIcon]).LoadDefaultIcon;
end;
function TProject.SearchFile(const Filename,SearchPaths,InitialDir:string):string;
var StartPos,EndPos:integer;
CurPath: string;

8
ide/projectdefs.pas
View File

@ -39,7 +39,7 @@ interface
uses
Classes, SysUtils, Laz_XMLCfg,
Controls, Forms, SynRegExpr, FileProcs, LCLProc,
CompOptsIntf, ProjectIntf, PublishModule, LazIDEIntf, W32Manifest,
CompOptsIntf, ProjectIntf, PublishModule, LazIDEIntf,
ProjectResourcesIntf,
frmCustomApplicationOptions, IDEProcs, LazarusIDEStrConsts;
@ -1277,7 +1277,8 @@ begin
AProject.AddFile(MainFile,false);
AProject.MainFileID:=0;
AProject.UseAppBundle:=true;
TProjectXPManifest(TAbstractProjectResources(AProject.Resources)[TProjectXPManifest]).UseManifest:=true;
AProject.UseManifest:=true;
AProject.LoadDefaultIcon;
// create program source
le:=LineEnding;
@ -1341,7 +1342,8 @@ begin
AProject.AddFile(MainFile,false);
AProject.MainFileID:=0;
AProject.UseAppBundle:=true;
TProjectXPManifest(TAbstractProjectResources(AProject.Resources)[TProjectXPManifest]).UseManifest:=true;
AProject.UseManifest:=true;
AProject.LoadDefaultIcon;
// create program source
le:=LineEnding;

28
ide/projecticon.pas
View File

@ -56,6 +56,7 @@ type
function GetStream: TStream;
procedure SetStream(AStream: TStream);
procedure LoadDefaultIcon;
function UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean; override;
@ -96,6 +97,21 @@ begin
IconData := NewIconData;
end;
procedure TProjectIcon.LoadDefaultIcon;
var
DefaultRes: TLResource;
ResStream: TLazarusResourceStream;
begin
// Load default icon
DefaultRes := LazarusResources.Find('LazarusProject', 'ICO');
if DefaultRes <> nil then
begin
ResStream := TLazarusResourceStream.CreateFromHandle(DefaultRes);
SetStream(ResStream);
ResStream.Free;
end;
end;
function TProjectIcon.UpdateResources(AResources: TAbstractProjectResources;
const MainFilename: string): Boolean;
var
@ -217,22 +233,10 @@ begin
end;
constructor TProjectIcon.Create;
var
DefaultRes: TLResource;
ResStream: TLazarusResourceStream;
begin
inherited Create;
FData := nil;
// Load default icon
DefaultRes := LazarusResources.Find('LazarusProject', 'ICO');
if DefaultRes <> nil then
begin
ResStream := TLazarusResourceStream.CreateFromHandle(DefaultRes);
SetStream(ResStream);
ResStream.Free;
end;
end;
procedure TProjectIcon.SetIconData(const AValue: TIconData);

9
ideintf/projectintf.pas
View File

@ -355,6 +355,8 @@ type
FLazCompilerOptions: TLazCompilerOptions;
FFlags: TProjectFlags;
FResources: TObject;
function GetUseManifest: boolean; virtual; abstract;
procedure SetUseManifest(AValue: boolean); virtual; abstract;
function GetMainFile: TLazProjectFile; virtual; abstract;
function GetMainFileID: Integer; virtual; abstract;
procedure SetMainFileID(const AValue: Integer); virtual; abstract;
@ -390,6 +392,7 @@ type
function GetShortFilename(const Filename: string; UseUp: boolean): string; virtual; abstract;
procedure ConvertToLPIFilename(var AFilename: string); virtual; abstract;
procedure ConvertFromLPIFilename(var AFilename: string); virtual; abstract;
procedure LoadDefaultIcon; virtual;
public
property MainFileID: Integer read GetMainFileID write SetMainFileID;
property Files[Index: integer]: TLazProjectFile read GetFiles;
@ -420,6 +423,7 @@ type
property CustomSessionData: TStringToStringTree read FCustomSessionData;
property UseAppBundle: Boolean read FUseAppBundle write FUseAppBundle;
property Resources: TObject read FResources; // TAbstractProjectResources
property UseManifest: boolean read GetUseManifest write SetUseManifest;
end;
TLazProjectClass = class of TLazProject;
@ -1091,6 +1095,11 @@ begin
Files[i].ClearModifieds;
end;
procedure TLazProject.LoadDefaultIcon;
begin
end;
{ TLazProjectFile }
procedure TLazProjectFile.SetIsPartOfProject(const AValue: boolean);