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

ide: further project icon changes

Browse Source 
- create/remove directive in lpr file on icon change
  - create .ico and .rc files for win32, wince platforms
improve manifest handling - set modified flag to project on change

git-svn-id: trunk@16903 -
This commit is contained in:
paul 2008-10-07 06:31:19 +00:00
parent 06d4577374
commit f0843b4de1
9 changed files with 464 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2253,6 +2253,7 @@ ide/progressdlg.lrs svneol=native#text/plain
ide/progressdlg.pas svneol=native#text/plain
ide/project.pp svneol=native#text/pascal
ide/projectdefs.pas svneol=native#text/pascal
ide/projecticon.pas svneol=native#text/pascal
ide/projectinspector.lfm svneol=native#text/plain
ide/projectinspector.lrs svneol=native#text/pascal
ide/projectinspector.pas svneol=native#text/pascal

25
ide/main.pp
View File

@ -9283,8 +9283,9 @@ begin
PutInfoBuilderProject(Project1.MainFilename);
PutInfoBuilderStatus(lisInfoBuildComplile);
// handle versioninfo
if not (pbfSkipLinking in Flags) then begin
if not (pbfSkipLinking in Flags) then
begin
// handle versioninfo
VersionInfo := Project1.VersionInfo;
Result := VersionInfo.CreateRCFile(Project1.MainFilename,
MainBuildBoss.GetTargetOS(true));
@ -9297,11 +9298,8 @@ begin
PutExitInfoBuilder(lisInfoBuildError);
exit;
end;
end else
VersionInfo:=nil;
// handle manifest
if not (pbfSkipLinking in Flags) then begin
// handle manifest
Result := Project1.XPManifest.CreateRCFile(Project1.MainFilename,
MainBuildBoss.GetTargetOS(true));
for i := 1 to Project1.XPManifest.Messages.Count do
@ -9312,7 +9310,20 @@ begin
PutExitInfoBuilder(lisInfoBuildError);
exit;
end;
end;
Result := Project1.ProjectIcon.CreateRCFile(Project1.MainFileName,
MainBuildBoss.GetTargetOS(true));
for i := 1 to Project1.ProjectIcon.Messages.Count do
MessagesView.AddMsg(Format(Project1.ProjectIcon.Messages[i - 1],
['"', Project1.ShortDescription, '"']), '' ,-1);
if Result <> mrOk then
begin
PutExitInfoBuilder(lisInfoBuildError);
exit;
end;
end else
VersionInfo:=nil;
// compile required packages
if not (pbfDoNotCompileDependencies in Flags) then begin

44
ide/project.pp
View File

@ -53,7 +53,7 @@ uses
// IDEIntf
PropEdits, ProjectIntf, MacroIntf, LazIDEIntf,
// for .res files
W32VersionInfo, W32Manifest,
W32VersionInfo, W32Manifest, ProjectIcon,
// IDE
LazarusIDEStrConsts, CompilerOptions, CodeToolManager, CodeCache,
TransferMacros, EditorOptions, IDEProcs, RunParamsOpts, ProjectDefs,
@ -609,6 +609,7 @@ type
FUseAppBundle: Boolean;
FVersionInfo: TProjectVersionInfo;
FXPManifest: TProjectXPManifest;
FProjectIcon: TProjectIcon;
function GetFirstAutoRevertLockedUnit: TUnitInfo;
function GetFirstLoadedUnit: TUnitInfo;
function GetFirstPartOfProject: TUnitInfo;
@ -637,7 +638,7 @@ type
procedure UpdateSourceDirectories;
procedure ClearSourceDirectories;
procedure SourceDirectoriesChanged(Sender: TObject);
procedure VersionInfoModified(Sender: TObject);
procedure EmbeddedObjectModified(Sender: TObject);
protected
function GetMainFile: TLazProjectFile; override;
function GetMainFileID: Integer; override;
@ -875,6 +876,7 @@ type
property VersionInfo: TProjectVersionInfo read FVersionInfo;
property XPManifest: TProjectXPManifest read FXPManifest;
property ProjectIcon: TProjectIcon read FProjectIcon;
property EnableI18N: boolean read FEnableI18N write SetEnableI18N;
property POOutputDirectory: string read FPOOutputDirectory
@ -1881,14 +1883,17 @@ begin
FRunParameterOptions:=TRunParamsOptions.Create;
FTargetFileExt := GetExecutableExt;
Title := '';
Icon := '';
FUnitList := TFPList.Create; // list of TUnitInfo
FVersionInfo := TProjectVersionInfo.Create;
FVersionInfo.OnModified:=@VersionInfoModified;
FVersionInfo.OnModified := @EmbeddedObjectModified;
FXPManifest := TProjectXPManifest.Create;
FXPManifest.UseManifest := False;
FXPManifest.OnModified := @EmbeddedObjectModified;
FProjectIcon := TProjectIcon.Create;
FProjectIcon.OnModified := @EmbeddedObjectModified;
end;
{------------------------------------------------------------------------------
@ -1901,6 +1906,7 @@ begin
Clear;
FreeThenNil(FVersionInfo);
FreeThenNil(FXPManifest);
FreeThenNil(FProjectIcon);
FreeThenNil(FBookmarks);
FreeThenNil(FUnitList);
FreeThenNil(FJumpHistory);
@ -2069,7 +2075,7 @@ begin
AutoCreateForms,true);
xmlconfig.SetValue(Path+'General/TargetFileExt/Value',TargetFileExt);
xmlconfig.SetDeleteValue(Path+'General/Title/Value', Title,'');
xmlconfig.SetDeleteValue(Path+'General/Icon/Value', Icon, '');
xmlconfig.SetDeleteValue(Path+'General/Icon/Value', ProjectIcon.IconText, '');
xmlconfig.SetDeleteValue(Path+'General/UseAppBundle/Value', UseAppBundle, True);
xmlconfig.SetDeleteValue(Path+'General/UseXPManifest/Value', XPManifest.UseManifest, False);
@ -2470,7 +2476,7 @@ begin
TargetFileExt := xmlconfig.GetValue(
Path+'General/TargetFileExt/Value', GetExecutableExt);
Title := xmlconfig.GetValue(Path+'General/Title/Value', '');
Icon := xmlconfig.GetValue(Path+'General/Icon/Value', '');
ProjectIcon.IconText := xmlconfig.GetValue(Path+'General/Icon/Value', '');
UseAppBundle := xmlconfig.GetValue(Path+'General/UseAppBundle/Value', True);
XPManifest.UseManifest := xmlconfig.GetValue(Path+'General/UseXPManifest/Value', False);
@ -2757,7 +2763,7 @@ begin
FPublishOptions.Clear;
FTargetFileExt := GetExecutableExt;
Title := '';
Icon := '';
ProjectIcon.IconText := '';
EndUpdate;
end;
@ -2863,12 +2869,14 @@ procedure TProject.SetModified(const AValue: boolean);
begin
if AValue=Modified then exit;
inherited SetModified(AValue);
if not Modified then begin
PublishOptions.Modified:=false;
CompilerOptions.Modified:=false;
SessionModified:=false;
VersionInfo.Modified:=false;
XPManifest.Modified:=false;
if not Modified then
begin
PublishOptions.Modified := False;
CompilerOptions.Modified := False;
SessionModified := False;
VersionInfo.Modified := False;
XPManifest.Modified := False;
ProjectIcon.Modified := False;
end;
end;
@ -3343,10 +3351,16 @@ begin
Result:=fFirst[uilLoaded];
end;
procedure TProject.VersionInfoModified(Sender: TObject);
procedure TProject.EmbeddedObjectModified(Sender: TObject);
begin
if VersionInfo.Modified then
Modified:=true;
Modified := True;
if XPManifest.Modified then
Modified := True;
if ProjectIcon.Modified then
Modified := True;
end;
function TProject.GetFirstAutoRevertLockedUnit: TUnitInfo;

291
ide/projecticon.pas Normal file
View File

@ -0,0 +1,291 @@
{
/***************************************************************************
projecticon.pas - Lazarus IDE unit
---------------------------------------
TProjectIcon is responsible for the inclusion of the
icon in windows executables as rc file and others as .lrs.
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit ProjectIcon;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Process, LCLProc, Controls, Forms,
CodeToolManager, CodeCache, CodeAtom, LazConf, LResources, base64;
type
{ TProjectIcon }
TProjectIcon = class(TObject)
private
FIconText: String;
FMessages: TStrings;
FModified: boolean;
rcFileName: string;
icoFileName: string;
FOnModified: TNotifyEvent;
procedure SetIconText(const AValue: String);
procedure SetFileNames(const MainFilename: string);
procedure SetModified(const AValue: Boolean);
protected
function GetAsHex: String;
public
constructor Create;
destructor Destroy; override;
function GetStream: TStream;
procedure SetStream(AStream: TStream);
function CreateRCFile(const MainFilename, TargetOS: string): TModalResult;
function CreateIconFile: Boolean;
function CreateResource: Boolean;
function UpdateMainSourceFile(const AFilename: string): TModalResult;
property IconText: String read FIconText write SetIconText;
property Messages: TStrings read FMessages;
property Modified: boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
end;
implementation
const
sIcon: String =
'MAINICON ICON';
function TProjectIcon.GetStream: TStream;
var
S: TStringStream;
BS: TBase64DecodingStream;
begin
if IconText <> '' then
begin
S := TStringStream.Create(IconText);
S.Position := 0;
BS := TBase64DecodingStream.Create(S);
Result := TMemoryStream.Create;
try
Result.CopyFrom(BS, BS.Size);
Result.Position := 0;
except
FreeAndNil(Result);
end;
BS.Free;
S.Free;
end
else
Result := nil;
end;
procedure TProjectIcon.SetStream(AStream: TStream);
var
S: TStringStream;
BS: TBase64EncodingStream;
NewIconText: String;
begin
NewIconText := '';
if (AStream <> nil) then
begin
S := TStringStream.Create('');
BS := TBase64EncodingStream.Create(S);
BS.CopyFrom(AStream, AStream.Size);
BS.Free;
NewIconText := S.DataString;
S.Free;
end;
IconText := NewIconText;
end;
{-----------------------------------------------------------------------------
TProjectIcon CreateRCFile
-----------------------------------------------------------------------------}
function TProjectIcon.CreateRCFile(const MainFilename, TargetOS: string): TModalResult;
begin
// in future we will compile manifest from rc, but now we just add our template
Result := mrOk;
SetFileNames(MainFilename);
if ((TargetOS = 'win32') or (TargetOS = 'wince')) and (IconText <> '') then
begin
if not CreateResource then
Result := mrCancel;
end;
end;
function TProjectIcon.CreateIconFile: Boolean;
var
FileStream, AStream: TStream;
begin
Result := False;
AStream := GetStream;
FileStream := nil;
try
FileStream := TFileStream.Create(UTF8ToSys(icoFileName), fmCreate);
FileStream.CopyFrom(AStream, AStream.Size);
Result := True;
finally
FileStream.Free;
end;
AStream.Free;
end;
function TProjectIcon.CreateResource: Boolean;
var
Stream: TStream;
RCIcon: String;
begin
Result := CreateIconFile;
if not Result then
Exit;
Stream := nil;
try
Stream := TFileStream.Create(UTF8ToSys(rcFileName), fmCreate);
// the preferred way is this:
// RCIcon := sIcon + #$D#$A + GetAsHex;
// but it does not work
RCIcon := sIcon + Format(' "%s"', [StringReplace(icoFileName, '\', '\\', [rfReplaceAll])]);
Stream.Write(RCIcon[1], length(RCIcon));
Result := True;
finally
Stream.Free;
end;
end;
{-----------------------------------------------------------------------------
TProjectIcon UpdateMainSourceFile
-----------------------------------------------------------------------------}
function TProjectIcon.UpdateMainSourceFile(const AFilename: string): TModalResult;
var
NewX, NewY, NewTopLine: integer;
IconCodeBuf, NewCode: TCodeBuffer;
Filename: String;
begin
Result := mrCancel;
IconCodeBuf := CodeToolBoss.LoadFile(AFilename,false,false);
if IconCodeBuf <> nil then
begin
SetFileNames(AFilename);
Filename:=ExtractFileName(rcFileName);
// DebugLn(['TProjectIcon.UpdateMainSourceFile ',Filename]);
if CodeToolBoss.FindResourceDirective(IconCodeBuf, 1, 1,
NewCode, NewX, NewY,
NewTopLine, Filename, false) then
begin
// there is a resource directive in the source
if IconText = '' then
begin
if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then
begin
Messages.Add('Could not remove "{$R'+ Filename +'"} from main source!');
exit;
end;
end;
end else
if IconText <> '' then
begin
if not CodeToolBoss.AddResourceDirective(IconCodeBuf,
Filename,false,'{$IFDEF WINDOWS}{$R '+Filename+'}{$ENDIF}') then
begin
Messages.Add('Could not add "{$R'+ Filename +'"} to main source!');
exit;
end;
end;
end;
//DebugLn(['TProjectIcon.UpdateMainSourceFile END ', IconCodeBuf.Source]);
Result := mrOk;
end;
{-----------------------------------------------------------------------------
TProjectIcon SetFileNames
-----------------------------------------------------------------------------}
procedure TProjectIcon.SetFileNames(const MainFilename: string);
begin
rcFileName := ExtractFilePath(MainFilename) + 'icon.rc';
icoFileName := ExtractFilePath(MainFilename) + 'icon.ico';
end;
constructor TProjectIcon.Create;
begin
// TODO: default icon
FIconText := '';
FMessages := TStringList.Create;
end;
destructor TProjectIcon.Destroy;
begin
FMessages.Free;
inherited Destroy;
end;
procedure TProjectIcon.SetIconText(const AValue: String);
begin
if FIconText = AValue then Exit;
FIconText := AValue;
Modified := True;
end;
procedure TProjectIcon.SetModified(const AValue: Boolean);
begin
if FModified = AValue then
Exit;
FModified := AValue;
if Assigned(OnModified) then
OnModified(Self);
end;
function TProjectIcon.GetAsHex: String;
var
AStream: TStream;
i, l: integer;
b: PByte;
begin
Result := '';
AStream := GetStream;
b := TMemoryStream(AStream).Memory;
l := AStream.Size - 1;
for i := 0 to l do
begin
if (i mod 16) = 0 then
Result := Result + '''';
Result := Result + IntToHex(b^, 2);
if (i <> l) then
begin
Result := Result + ' ';
if ((succ(i) mod 16) = 0) then
Result := Result + ''''#$D#$A;
end;
inc(b);
end;
if l > 0 then
Result := Result + '''';
Result := '{'#$D#$A + Result + #$D#$A'}';
AStream.Free;
end;
end.

2
ide/projectopts.lfm
View File

@ -759,7 +759,6 @@ object ProjectOptionsDialog: TProjectOptionsDialog
BorderSpacing.Top = 2
BorderSpacing.Bottom = 6
ItemHeight = 13
MaxLength = -1
TabOrder = 0
Text = 'U.S. English'
end
@ -776,7 +775,6 @@ object ProjectOptionsDialog: TProjectOptionsDialog
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
ItemHeight = 13
MaxLength = -1
TabOrder = 1
Text = 'Multilingual'
end

162
ide/projectopts.lrs
View File

@ -265,85 +265,85 @@ LazarusResources.Add('TProjectOptionsDialog','FORMDATA',[
+'AnchorSideLeft.Control'#7#22'LanguageSelectionLabel'#21'AnchorSideTop.Contr'
+'ol'#7#22'LanguageSelectionLabel'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Le'
+'ft'#2#6#6'Height'#2#21#3'Top'#2#26#5'Width'#3#248#0#17'BorderSpacing.Top'#2
+#2#20'BorderSpacing.Bottom'#2#6#10'ItemHeight'#2#13#9'MaxLength'#2#255#8'Tab'
+'Order'#2#0#4'Text'#6#12'U.S. English'#0#0#9'TComboBox'#20'CharacterSetCombo'
+'Box'#22'AnchorSideLeft.Control'#7#17'CharacterSetLabel'#21'AnchorSideTop.Co'
+'ntrol'#7#25'LanguageSelectionComboBox'#23'AnchorSideRight.Control'#7#24'Lan'
+'guageSettingsGroupBox'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#3#4#1
+#6'Height'#2#21#3'Top'#2#26#5'Width'#3#183#0#7'Anchors'#11#5'akTop'#6'akLeft'
+#7'akRight'#0#19'BorderSpacing.Right'#2#6#20'BorderSpacing.Bottom'#2#6#10'It'
+'emHeight'#2#13#9'MaxLength'#2#255#8'TabOrder'#2#1#4'Text'#6#12'Multilingual'
+#0#0#0#9'TGroupBox'#17'OtherInfoGroupBox'#18'AnchorSideTop.Side'#7#9'asrBott'
+'om'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2'e'#3'To'
+'p'#3#215#0#5'Width'#3#197#1#5'Align'#7#5'alTop'#8'AutoSize'#9#20'BorderSpac'
+'ing.Around'#2#6#7'Caption'#6#10'Other Info'#12'ClientHeight'#2'e'#11'Client'
+'Width'#3#197#1#8'TabOrder'#2#3#0#6'TLabel'#16'DescriptionLabel'#21'AnchorSi'
+'deTop.Control'#7#15'DescriptionEdit'#18'AnchorSideTop.Side'#7#9'asrCenter'#4
+'Left'#2#6#6'Height'#2#14#3'Top'#2#3#5'Width'#2':'#18'BorderSpacing.Left'#2#6
+#7'Caption'#6#12'Description:'#11'ParentColor'#8#0#0#6'TLabel'#14'CopyrightL'
+'abel'#22'AnchorSideLeft.Control'#7#16'DescriptionLabel'#21'AnchorSideTop.Co'
+'ntrol'#7#13'CopyrightEdit'#18'AnchorSideTop.Side'#7#9'asrCenter'#4'Left'#2#6
+#6'Height'#2#14#3'Top'#2#30#5'Width'#2'4'#7'Caption'#6#10'Copyright:'#11'Par'
+'entColor'#8#0#0#5'TEdit'#15'DescriptionEdit'#19'AnchorSideLeft.Side'#7#9'as'
+'rBottom'#23'AnchorSideRight.Control'#7#17'OtherInfoGroupBox'#20'AnchorSideR'
+'ight.Side'#7#9'asrBottom'#4'Left'#2'F'#6'Height'#2#21#5'Width'#3'u'#1#7'Anc'
+'hors'#11#5'akTop'#6'akLeft'#7'akRight'#0#18'BorderSpacing.Left'#2#6#19'Bord'
+'erSpacing.Right'#2#6#8'TabOrder'#2#0#0#0#5'TEdit'#13'CopyrightEdit'#22'Anch'
+'orSideLeft.Control'#7#15'DescriptionEdit'#21'AnchorSideTop.Control'#7#15'De'
+'scriptionEdit'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'AnchorSideRight.Con'
+'trol'#7#17'OtherInfoGroupBox'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Lef'
+'t'#2'F'#6'Height'#2#21#3'Top'#2#27#5'Width'#3'u'#1#7'Anchors'#11#5'akTop'#6
+'akLeft'#7'akRight'#0#17'BorderSpacing.Top'#2#6#19'BorderSpacing.Right'#2#6#8
+'TabOrder'#2#1#0#0#7'TBitBtn'#20'AdditionalInfoButton'#21'AnchorSideTop.Cont'
+'rol'#7#13'CopyrightEdit'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'AnchorSid'
+'eRight.Control'#7#17'OtherInfoGroupBox'#20'AnchorSideRight.Side'#7#9'asrBot'
+'tom'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'['#1#6'Height'#2#23
+#3'Top'#2'6'#5'Width'#2'`'#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#9
+#20'BorderSpacing.Around'#2#6#7'Caption'#6#15'Additional Info'#9'NumGlyphs'#2
+#0#7'OnClick'#7#25'AdditionalInfoButtonClick'#8'TabOrder'#2#2#0#0#0#0#5'TPag'
+'e'#8'i18nPage'#7'Caption'#6#4'i18n'#11'ClientWidth'#3#209#1#12'ClientHeight'
+#3'p'#1#0#9'TGroupBox'#12'I18NGroupBox'#22'AnchorSideLeft.Control'#7#17'Othe'
+'rInfoGroupBox'#21'AnchorSideTop.Control'#7#19'VersionInfoGroupBox'#18'Ancho'
+'rSideTop.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#17'OtherInfoGro'
+'upBox'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2'I'#3
+'Top'#2#31#5'Width'#3#197#1#5'Align'#7#5'alTop'#8'AutoSize'#9#20'BorderSpaci'
+'ng.Around'#2#6#7'Caption'#6#12'i18n Options'#12'ClientHeight'#2'I'#11'Clien'
+'tWidth'#3#197#1#8'TabOrder'#2#0#0#6'TLabel'#13'PoOutDirLabel'#4'Left'#2#6#6
+'Height'#2#14#3'Top'#2#6#5'Width'#2'g'#20'BorderSpacing.Around'#2#6#7'Captio'
+'n'#6#20'PO Output Directory:'#11'ParentColor'#8#0#0#5'TEdit'#12'POOutDirEdi'
+'t'#22'AnchorSideLeft.Control'#7#12'I18NGroupBox'#21'AnchorSideTop.Control'#7
+#13'PoOutDirLabel'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'AnchorSideRight.'
+'Control'#7#14'POOutDirButton'#4'Left'#2#6#6'Height'#2#23#3'Top'#2#26#5'Widt'
+'h'#3#151#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#20'BorderSpacing.A'
+'round'#2#6#8'TabOrder'#2#0#4'Text'#6#12'POOutDirEdit'#0#0#7'TButton'#14'POO'
+'utDirButton'#21'AnchorSideTop.Control'#7#13'PoOutDirLabel'#18'AnchorSideTop'
+'.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#12'I18NGroupBox'#20'Anc'
+'horSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4
+'Left'#3#163#1#6'Height'#2#23#3'Top'#2#26#5'Width'#2#24#7'Anchors'#11#5'akTo'
+'p'#7'akRight'#0#20'BorderSpacing.Around'#2#6#7'Caption'#6#3'...'#7'OnClick'
,#7#19'POOutDirButtonClick'#8'TabOrder'#2#1#0#0#0#9'TCheckBox'#18'EnableI18NC'
+'heckBox'#4'Left'#2#6#6'Height'#2#19#3'Top'#2#6#5'Width'#3#197#1#5'Align'#7#5
+'alTop'#20'BorderSpacing.Around'#2#6#7'Caption'#6#11'Enable i18n'#8'OnChange'
+#7#24'EnableI18NCheckBoxChange'#8'TabOrder'#2#1#0#0#0#0#6'TPanel'#11'PODBtnP'
+'anel'#6'Height'#2'&'#3'Top'#3'~'#1#5'Width'#3#217#1#5'Align'#7#8'alBottom'#8
+'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2'&'#11'ClientWidth'
+#3#217#1#8'TabOrder'#2#1#0#7'TBitBtn'#8'OKButton'#21'AnchorSideBottom.Side'#7
+#9'asrBottom'#4'Left'#3'5'#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'
+#7#7'alRight'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#3'&OK'
+#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#7'Default'#9#4
+'Kind'#7#4'bkOK'#11'ModalResult'#2#1#9'NumGlyphs'#2#0#8'TabOrder'#2#0#0#0#7
+'TBitBtn'#12'CancelButton'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'Anchor'
+'SideBottom.Side'#7#9'asrBottom'#4'Left'#3#134#1#6'Height'#2#26#3'Top'#2#6#5
+'Width'#2'M'#5'Align'#7#7'alRight'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6
+#6'Cancel'#9#7'Caption'#6#6'Cancel'#21'Constraints.MinHeight'#2#25#20'Constr'
+'aints.MinWidth'#2'K'#4'Kind'#7#8'bkCancel'#11'ModalResult'#2#2#9'NumGlyphs'
+#2#0#8'TabOrder'#2#1#0#0#7'TBitBtn'#10'HelpButton'#21'AnchorSideBottom.Side'
+#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'
+#7#6'alLeft'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#5'&Help'
+#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#4'Kind'#7#6'bk'
+'Help'#9'NumGlyphs'#2#0#7'OnClick'#7#15'HelpButtonClick'#8'TabOrder'#2#2#0#0
+#0#22'TSelectDirectoryDialog'#21'SelectDirectoryDialog'#11'FilterIndex'#2#0#4
+'left'#2'X'#3'top'#3'p'#1#0#0#18'TOpenPictureDialog'#18'OpenPictureDialog1'#4
+'left'#2'u'#3'top'#3'p'#1#0#0#18'TSavePictureDialog'#18'SavePictureDialog1'#5
+'Title'#6#12'Save file as'#4'left'#3#146#0#3'top'#3'p'#1#0#0#0
+#2#20'BorderSpacing.Bottom'#2#6#10'ItemHeight'#2#13#8'TabOrder'#2#0#4'Text'#6
+#12'U.S. English'#0#0#9'TComboBox'#20'CharacterSetComboBox'#22'AnchorSideLef'
+'t.Control'#7#17'CharacterSetLabel'#21'AnchorSideTop.Control'#7#25'LanguageS'
+'electionComboBox'#23'AnchorSideRight.Control'#7#24'LanguageSettingsGroupBox'
+#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#3#4#1#6'Height'#2#21#3'Top'
+#2#26#5'Width'#3#183#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#19'Bord'
+'erSpacing.Right'#2#6#20'BorderSpacing.Bottom'#2#6#10'ItemHeight'#2#13#8'Tab'
+'Order'#2#1#4'Text'#6#12'Multilingual'#0#0#0#9'TGroupBox'#17'OtherInfoGroupB'
+'ox'#18'AnchorSideTop.Side'#7#9'asrBottom'#20'AnchorSideRight.Side'#7#9'asrB'
+'ottom'#4'Left'#2#6#6'Height'#2'e'#3'Top'#3#215#0#5'Width'#3#197#1#5'Align'#7
+#5'alTop'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#10'Other I'
+'nfo'#12'ClientHeight'#2'e'#11'ClientWidth'#3#197#1#8'TabOrder'#2#3#0#6'TLab'
+'el'#16'DescriptionLabel'#21'AnchorSideTop.Control'#7#15'DescriptionEdit'#18
+'AnchorSideTop.Side'#7#9'asrCenter'#4'Left'#2#6#6'Height'#2#14#3'Top'#2#3#5
+'Width'#2':'#18'BorderSpacing.Left'#2#6#7'Caption'#6#12'Description:'#11'Par'
+'entColor'#8#0#0#6'TLabel'#14'CopyrightLabel'#22'AnchorSideLeft.Control'#7#16
+'DescriptionLabel'#21'AnchorSideTop.Control'#7#13'CopyrightEdit'#18'AnchorSi'
+'deTop.Side'#7#9'asrCenter'#4'Left'#2#6#6'Height'#2#14#3'Top'#2#30#5'Width'#2
+'4'#7'Caption'#6#10'Copyright:'#11'ParentColor'#8#0#0#5'TEdit'#15'Descriptio'
+'nEdit'#19'AnchorSideLeft.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7
+#17'OtherInfoGroupBox'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2'F'#6
+'Height'#2#21#5'Width'#3'u'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0
+#18'BorderSpacing.Left'#2#6#19'BorderSpacing.Right'#2#6#8'TabOrder'#2#0#0#0#5
+'TEdit'#13'CopyrightEdit'#22'AnchorSideLeft.Control'#7#15'DescriptionEdit'#21
+'AnchorSideTop.Control'#7#15'DescriptionEdit'#18'AnchorSideTop.Side'#7#9'asr'
+'Bottom'#23'AnchorSideRight.Control'#7#17'OtherInfoGroupBox'#20'AnchorSideRi'
+'ght.Side'#7#9'asrBottom'#4'Left'#2'F'#6'Height'#2#21#3'Top'#2#27#5'Width'#3
+'u'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#17'BorderSpacing.Top'#2#6
+#19'BorderSpacing.Right'#2#6#8'TabOrder'#2#1#0#0#7'TBitBtn'#20'AdditionalInf'
+'oButton'#21'AnchorSideTop.Control'#7#13'CopyrightEdit'#18'AnchorSideTop.Sid'
+'e'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#17'OtherInfoGroupBox'#20'An'
+'chorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9'asrBottom'
+#4'Left'#3'['#1#6'Height'#2#23#3'Top'#2'6'#5'Width'#2'`'#7'Anchors'#11#5'akT'
+'op'#7'akRight'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#15
+'Additional Info'#9'NumGlyphs'#2#0#7'OnClick'#7#25'AdditionalInfoButtonClick'
+#8'TabOrder'#2#2#0#0#0#0#5'TPage'#8'i18nPage'#7'Caption'#6#4'i18n'#11'Client'
+'Width'#3#209#1#12'ClientHeight'#3'p'#1#0#9'TGroupBox'#12'I18NGroupBox'#22'A'
+'nchorSideLeft.Control'#7#17'OtherInfoGroupBox'#21'AnchorSideTop.Control'#7
+#19'VersionInfoGroupBox'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'AnchorSide'
+'Right.Control'#7#17'OtherInfoGroupBox'#20'AnchorSideRight.Side'#7#9'asrBott'
+'om'#4'Left'#2#6#6'Height'#2'I'#3'Top'#2#31#5'Width'#3#197#1#5'Align'#7#5'al'
+'Top'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'i18n Option'
+'s'#12'ClientHeight'#2'I'#11'ClientWidth'#3#197#1#8'TabOrder'#2#0#0#6'TLabel'
+#13'PoOutDirLabel'#4'Left'#2#6#6'Height'#2#14#3'Top'#2#6#5'Width'#2'g'#20'Bo'
+'rderSpacing.Around'#2#6#7'Caption'#6#20'PO Output Directory:'#11'ParentColo'
+'r'#8#0#0#5'TEdit'#12'POOutDirEdit'#22'AnchorSideLeft.Control'#7#12'I18NGrou'
+'pBox'#21'AnchorSideTop.Control'#7#13'PoOutDirLabel'#18'AnchorSideTop.Side'#7
+#9'asrBottom'#23'AnchorSideRight.Control'#7#14'POOutDirButton'#4'Left'#2#6#6
+'Height'#2#23#3'Top'#2#26#5'Width'#3#151#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
+'akRight'#0#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#12'POOutD'
+'irEdit'#0#0#7'TButton'#14'POOutDirButton'#21'AnchorSideTop.Control'#7#13'Po'
+'OutDirLabel'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'AnchorSideRight.Contr'
+'ol'#7#12'I18NGroupBox'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSid'
+'eBottom.Side'#7#9'asrBottom'#4'Left'#3#163#1#6'Height'#2#23#3'Top'#2#26#5'W'
+'idth'#2#24#7'Anchors'#11#5'akTop'#7'akRight'#0#20'BorderSpacing.Around'#2#6
+#7'Caption'#6#3'...'#7'OnClick'#7#19'POOutDirButtonClick'#8'TabOrder'#2#1#0#0
,#0#9'TCheckBox'#18'EnableI18NCheckBox'#4'Left'#2#6#6'Height'#2#19#3'Top'#2#6
+#5'Width'#3#197#1#5'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#7'Caption'
+#6#11'Enable i18n'#8'OnChange'#7#24'EnableI18NCheckBoxChange'#8'TabOrder'#2#1
+#0#0#0#0#6'TPanel'#11'PODBtnPanel'#6'Height'#2'&'#3'Top'#3'~'#1#5'Width'#3
+#217#1#5'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'Cl'
+'ientHeight'#2'&'#11'ClientWidth'#3#217#1#8'TabOrder'#2#1#0#7'TBitBtn'#8'OKB'
+'utton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'5'#1#6'Height'#2
+#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#7'alRight'#8'AutoSize'#9#20'BorderSp'
+'acing.Around'#2#6#7'Caption'#6#3'&OK'#21'Constraints.MinHeight'#2#25#20'Con'
+'straints.MinWidth'#2'K'#7'Default'#9#4'Kind'#7#4'bkOK'#11'ModalResult'#2#1#9
+'NumGlyphs'#2#0#8'TabOrder'#2#0#0#0#7'TBitBtn'#12'CancelButton'#20'AnchorSid'
+'eRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'
+#3#134#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'M'#5'Align'#7#7'alRight'#8'Aut'
+'oSize'#9#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7'Caption'#6#6'Cancel'#21
+'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#4'Kind'#7#8'bkCan'
+'cel'#11'ModalResult'#2#2#9'NumGlyphs'#2#0#8'TabOrder'#2#1#0#0#7'TBitBtn'#10
+'HelpButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2
+#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#6'alLeft'#8'AutoSize'#9#20'BorderSpa'
+'cing.Around'#2#6#7'Caption'#6#5'&Help'#21'Constraints.MinHeight'#2#25#20'Co'
+'nstraints.MinWidth'#2'K'#4'Kind'#7#6'bkHelp'#9'NumGlyphs'#2#0#7'OnClick'#7
+#15'HelpButtonClick'#8'TabOrder'#2#2#0#0#0#22'TSelectDirectoryDialog'#21'Sel'
+'ectDirectoryDialog'#11'FilterIndex'#2#0#4'left'#2'X'#3'top'#3'p'#1#0#0#18'T'
+'OpenPictureDialog'#18'OpenPictureDialog1'#4'left'#2'u'#3'top'#3'p'#1#0#0#18
+'TSavePictureDialog'#18'SavePictureDialog1'#5'Title'#6#12'Save file as'#4'le'
+'ft'#3#146#0#3'top'#3'p'#1#0#0#0
]);

54
ide/projectopts.pp
View File

@ -192,8 +192,8 @@ type
function SetAutoCreateForms: Boolean;
function SetProjectTitle: Boolean;
procedure SetIconFromText(Value: String);
function GetIconAsText: String;
procedure SetIconFromStream(Value: TStream);
function GetIconAsStream: TStream;
public
constructor Create(TheOwner: TComponent); override;
property Project: TProject read FProject write SetProject;
@ -409,6 +409,7 @@ end;
procedure TProjectOptionsDialog.SetProject(AProject: TProject);
var
AFilename: String;
AStream: TStream;
begin
FProject := AProject;
if AProject = Nil then
@ -421,7 +422,12 @@ begin
UseAppBundleCheckBox.Checked := UseAppBundle;
UseXPManifestCheckBox.Checked := XPManifest.UseManifest;
UseVersionInfoCheckBox.Checked := VersionInfo.UseVersionInfo;
SetIconFromText(Icon);
AStream := ProjectIcon.GetStream;
try
SetIconFromStream(AStream);
finally
AStream.Free;
end;
end;
FillAutoCreateFormsListbox;
FillAvailFormsListBox;
@ -482,6 +488,7 @@ procedure TProjectOptionsDialog.ProjectOptionsClose(Sender: TObject;
var
NewFlags: TProjectFlags;
AFilename: String;
AStream: TStream;
procedure SetProjectFlag(AFlag: TProjectFlag; AValue: Boolean);
begin
@ -495,7 +502,14 @@ begin
if ModalResult = mrOk then
begin
Project.Title := TitleEdit.Text;
Project.Icon := GetIconAsText;
AStream := GetIconAsStream;
try
Project.ProjectIcon.SetStream(AStream);
finally
AStream.Free;
end;
if Project.ProjectIcon.Modified then
Project.ProjectIcon.UpdateMainSourceFile(Project.MainFilename);
Project.TargetFilename := TargetFileEdit.Text;
Project.UseAppBundle := UseAppBundleCheckBox.Checked;
Project.XPManifest.UseManifest := UseXPManifestCheckBox.Checked;
@ -946,42 +960,26 @@ begin
end;// delete title
end;
procedure TProjectOptionsDialog.SetIconFromText(Value: String);
var
S: TStringStream;
BS: TBase64DecodingStream;
procedure TProjectOptionsDialog.SetIconFromStream(Value: TStream);
begin
IconImage.Picture.Clear;
if Value <> '' then
begin
S := TStringStream.Create(Value);
S.Position := 0;
BS := TBase64DecodingStream.Create(S);
if Value <> nil then
try
IconImage.Picture.Icon.LoadFromStream(BS);
IconImage.Picture.Icon.LoadFromStream(Value);
except
on E: Exception do
MessageDlg(E.Message, mtError, [mbOk], 0);
end;
BS.Free;
S.Free;
end;
end;
function TProjectOptionsDialog.GetIconAsText: String;
var
S: TStringStream;
BS: TBase64EncodingStream;
function TProjectOptionsDialog.GetIconAsStream: TStream;
begin
Result := '';
Result := nil;
if not ((IconImage.Picture.Graphic = nil) or IconImage.Picture.Graphic.Empty) then
begin
S := TStringStream.Create('');
BS := TBase64EncodingStream.Create(S);
IconImage.Picture.Icon.SaveToStream(BS);
BS.Free;
Result := S.DataString;
S.Free;
Result := TMemoryStream.Create;
IconImage.Picture.Icon.SaveToStream(Result);
Result.Position := 0;
end;
end;

22
ide/w32manifest.pas
View File

@ -46,8 +46,10 @@ type
FModified: boolean;
FUseManifest: boolean;
rcFilename: string;
FOnModified: TNotifyEvent;
procedure SetUseManifest(const AValue: boolean);
procedure SetFileNames(const MainFilename: string);
procedure SetModified(const AValue: Boolean);
public
constructor Create;
destructor Destroy; override;
@ -58,7 +60,9 @@ type
property Messages: TStrings read FMessages;
property UseManifest: boolean read FUseManifest write SetUseManifest;
property Modified: boolean read FModified write FModified;
property Modified: boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
end;
implementation
@ -110,6 +114,7 @@ var
Stream: TStream;
begin
Result := False;
Stream := nil;
try
Stream := TFileStream.Create(UTF8ToSys(rcFileName), fmCreate);
Stream.Write(sManifest[1], length(sManifest));
@ -123,7 +128,7 @@ procedure TProjectXPManifest.SetUseManifest(const AValue: boolean);
begin
if FUseManifest = AValue then exit;
FUseManifest := AValue;
Modified:=true;
Modified := True;
end;
{-----------------------------------------------------------------------------
@ -141,7 +146,7 @@ begin
begin
SetFileNames(AFilename);
Filename:=ExtractFileName(rcFileName);
DebugLn(['TProjectXPManifest.UpdateMainSourceFile ',Filename]);
//DebugLn(['TProjectXPManifest.UpdateMainSourceFile ',Filename]);
if CodeToolBoss.FindResourceDirective(ManifestCodeBuf, 1, 1,
NewCode, NewX, NewY,
NewTopLine, Filename, false) then
@ -164,7 +169,7 @@ begin
end;
end;
end;
DebugLn(['TProjectXPManifest.UpdateMainSourceFile END ',ManifestCodeBuf.Source]);
//DebugLn(['TProjectXPManifest.UpdateMainSourceFile END ',ManifestCodeBuf.Source]);
Result := mrOk;
end;
@ -187,5 +192,14 @@ begin
inherited Destroy;
end;
procedure TProjectXPManifest.SetModified(const AValue: Boolean);
begin
if FModified = AValue then
Exit;
FModified := AValue;
if Assigned(OnModified) then
OnModified(Self);
end;
end.

11
ideintf/projectintf.pas
View File

@ -532,7 +532,6 @@ type
FProjectSessionFile: string;
FSessionModified: boolean;
FTitle: String;
FIcon: String;
FSessionStorage: TProjectSessionStorage;
FLazDocPaths: string;
procedure SetLazDocPaths(const AValue: string);
@ -543,7 +542,6 @@ type
function GetMainFileID: Integer; virtual; abstract;
procedure SetMainFileID(const AValue: Integer); virtual; abstract;
function GetFiles(Index: integer): TLazProjectFile; virtual; abstract;
procedure SetIcon(const AValue: String); virtual;
procedure SetTitle(const AValue: String); virtual;
procedure SetFlags(const AValue: TProjectFlags); virtual;
function GetProjectInfoFile: string; virtual; abstract;
@ -577,7 +575,6 @@ type
property FileCount: integer read GetFileCount;
property MainFile: TLazProjectFile read GetMainFile;
property Title: String read FTitle write SetTitle;
property Icon: string read FIcon write SetIcon;
property Flags: TProjectFlags read FFlags write SetFlags;
property ExecutableType: TProjectExecutableType read FExecutableType
write SetExecutableType;// read from MainFile, not saved to lpi
@ -1070,7 +1067,6 @@ end;
function TProjectDescriptor.InitProject(AProject: TLazProject): TModalResult;
begin
AProject.Title:='project1';
// TODO: AProject.Icon := default icon
AProject.Flags:=Flags;
Result:=mrOk;
end;
@ -1142,13 +1138,6 @@ begin
Modified:=true;
end;
procedure TLazProject.SetIcon(const AValue: String);
begin
if FIcon=AValue then exit;
FIcon:=AValue;
Modified:=true;
end;
constructor TLazProject.Create(ProjectDescription: TProjectDescriptor);
begin
inherited Create;