From f0843b4de167bfe11a1f60f640a52d98e9161890 Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 7 Oct 2008 06:31:19 +0000 Subject: [PATCH] ide: further project icon changes - 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 - --- .gitattributes | 1 + ide/main.pp | 25 +++- ide/project.pp | 44 +++--- ide/projecticon.pas | 291 ++++++++++++++++++++++++++++++++++++++++ ide/projectopts.lfm | 2 - ide/projectopts.lrs | 162 +++++++++++----------- ide/projectopts.pp | 54 ++++---- ide/w32manifest.pas | 22 ++- ideintf/projectintf.pas | 11 -- 9 files changed, 464 insertions(+), 148 deletions(-) create mode 100644 ide/projecticon.pas diff --git a/.gitattributes b/.gitattributes index 3a233a6663..7903eb1ce9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/ide/main.pp b/ide/main.pp index 318982fdf8..37c231c037 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -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 diff --git a/ide/project.pp b/ide/project.pp index 31c49b40b2..9feaea8d99 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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; diff --git a/ide/projecticon.pas b/ide/projecticon.pas new file mode 100644 index 0000000000..b24adc4a57 --- /dev/null +++ b/ide/projecticon.pas @@ -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 . 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. + diff --git a/ide/projectopts.lfm b/ide/projectopts.lfm index 918bd1ee11..8af703ac67 100644 --- a/ide/projectopts.lfm +++ b/ide/projectopts.lfm @@ -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 diff --git a/ide/projectopts.lrs b/ide/projectopts.lrs index 51c4e90ca7..ad5ce9ecf4 100644 --- a/ide/projectopts.lrs +++ b/ide/projectopts.lrs @@ -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 ]); diff --git a/ide/projectopts.pp b/ide/projectopts.pp index 88b129f2de..691ec67af6 100644 --- a/ide/projectopts.pp +++ b/ide/projectopts.pp @@ -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; diff --git a/ide/w32manifest.pas b/ide/w32manifest.pas index eb22265e9a..75c20f4e01 100644 --- a/ide/w32manifest.pas +++ b/ide/w32manifest.pas @@ -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. diff --git a/ideintf/projectintf.pas b/ideintf/projectintf.pas index be67bb03a3..9987b06d5b 100644 --- a/ideintf/projectintf.pas +++ b/ideintf/projectintf.pas @@ -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;