pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazimageeditor: Adds menu entry to export to windows icon

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2287 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2012-02-14 15:34:28 +00:00
parent effe4ebbdb
commit ef78c4e923
4 changed files with 663 additions and 602 deletions
Download Patch File Download Diff File Expand all files Collapse all files

124
applications/lazimageeditor/main.lfm
View File

@ -4,7 +4,7 @@
Top = 60 Top = 60
Width = 925 Width = 925
Caption = 'Lazarus Image Editor' Caption = 'Lazarus Image Editor'
ClientHeight = 717 ClientHeight = 719
ClientWidth = 925 ClientWidth = 925
Font.CharSet = GB2312_CHARSET Font.CharSet = GB2312_CHARSET
Font.Height = -13 Font.Height = -13
@ -18,18 +18,18 @@
LCLVersion = '0.9.31' LCLVersion = '0.9.31'
object PanelTools: TPanel object PanelTools: TPanel
Left = 0 Left = 0
Height = 590 Height = 591
Top = 105 Top = 105
Width = 40 Width = 40
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 590 ClientHeight = 591
ClientWidth = 40 ClientWidth = 40
ParentColor = False ParentColor = False
TabOrder = 0 TabOrder = 0
object ToolBarTools: TToolBar object ToolBarTools: TToolBar
Left = 0 Left = 0
Height = 590 Height = 591
Top = 0 Top = 0
Width = 40 Width = 40
Align = alLeft Align = alLeft
@ -201,8 +201,8 @@
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 22 Height = 23
Top = 695 Top = 696
Width = 925 Width = 925
Panels = < Panels = <
item item
@ -229,18 +229,18 @@
end end
object PanelPallete: TPanel object PanelPallete: TPanel
Left = 850 Left = 850
Height = 590 Height = 591
Top = 105 Top = 105
Width = 75 Width = 75
Align = alRight Align = alRight
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 590 ClientHeight = 591
ClientWidth = 75 ClientWidth = 75
TabOrder = 1 TabOrder = 1
object Palette: TColorPalette object Palette: TColorPalette
Left = 0 Left = 0
Height = 590 Height = 591
Top = 0 Top = 0
Width = 75 Width = 75
Align = alClient Align = alClient
@ -426,11 +426,11 @@
OnClick = PanelZoomClick OnClick = PanelZoomClick
object ComboBoxZoom: TComboBox object ComboBoxZoom: TComboBox
Left = 1 Left = 1
Height = 27 Height = 24
Top = 2 Top = 3
Width = 75 Width = 75
Anchors = [akLeft] Anchors = [akLeft]
ItemHeight = 19 ItemHeight = 16
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'25 %' '25 %'
@ -480,10 +480,10 @@
TabOrder = 1 TabOrder = 1
object FontListBox: TComboBox object FontListBox: TComboBox
Left = 2 Left = 2
Height = 27 Height = 24
Top = 3 Top = 3
Width = 112 Width = 112
ItemHeight = 19 ItemHeight = 16
OnChange = FontListBoxChange OnChange = FontListBoxChange
OnClick = FontListBoxClick OnClick = FontListBoxClick
Style = csDropDownList Style = csDropDownList
@ -491,7 +491,7 @@
end end
object FontSize: TSpinEdit object FontSize: TSpinEdit
Left = 117 Left = 117
Height = 27 Height = 24
Top = 3 Top = 3
Width = 50 Width = 50
OnChange = FontSizeChange OnChange = FontSizeChange
@ -516,7 +516,7 @@
Left = 112 Left = 112
Height = 34 Height = 34
Top = 0 Top = 0
Width = 72 Width = 70
Align = alLeft Align = alLeft
Caption = 'Fill, Outline:' Caption = 'Fill, Outline:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -535,10 +535,10 @@
ParentColor = False ParentColor = False
end end
object LabelMaskTool: TLabel object LabelMaskTool: TLabel
Left = 284 Left = 282
Height = 34 Height = 34
Top = 0 Top = 0
Width = 67 Width = 64
Align = alLeft Align = alLeft
Caption = 'Mask Tool:' Caption = 'Mask Tool:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -546,10 +546,10 @@
ParentColor = False ParentColor = False
end end
object PanelColors: TPanel object PanelColors: TPanel
Left = 713 Left = 714
Height = 34 Height = 34
Top = 0 Top = 0
Width = 212 Width = 211
Align = alRight Align = alRight
AutoSize = True AutoSize = True
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
@ -557,30 +557,30 @@
BorderSpacing.CellAlignVertical = ccaCenter BorderSpacing.CellAlignVertical = ccaCenter
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 34 ClientHeight = 34
ClientWidth = 212 ClientWidth = 211
TabOrder = 0 TabOrder = 0
object LabelOutline: TLabel object LabelOutline: TLabel
Left = 8 Left = 8
Height = 34 Height = 34
Top = 0 Top = 0
Width = 49 Width = 46
Align = alRight Align = alRight
Caption = 'Outline:' Caption = 'Outline:'
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
end end
object LabelFill: TLabel object LabelFill: TLabel
Left = 89 Left = 86
Height = 34 Height = 34
Top = 0 Top = 0
Width = 20 Width = 22
Align = alRight Align = alRight
Caption = 'Fill:' Caption = 'Fill:'
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
end end
object LabelPaper: TLabel object LabelPaper: TLabel
Left = 141 Left = 140
Height = 34 Height = 34
Top = 0 Top = 0
Width = 39 Width = 39
@ -590,7 +590,7 @@
ParentColor = False ParentColor = False
end end
object PanelOutline: TPanel object PanelOutline: TPanel
Left = 63 Left = 60
Height = 22 Height = 22
Top = 6 Top = 6
Width = 20 Width = 20
@ -605,7 +605,7 @@
OnDragOver = PanelPaperDragOver OnDragOver = PanelPaperDragOver
end end
object PanelFill: TPanel object PanelFill: TPanel
Left = 115 Left = 114
Height = 22 Height = 22
Top = 6 Top = 6
Width = 20 Width = 20
@ -620,7 +620,7 @@
OnDragOver = PanelPaperDragOver OnDragOver = PanelPaperDragOver
end end
object PanelPaper: TPanel object PanelPaper: TPanel
Left = 186 Left = 185
Height = 22 Height = 22
Top = 6 Top = 6
Width = 20 Width = 20
@ -637,7 +637,7 @@
end end
end end
object PanelFillOutline: TPanel object PanelFillOutline: TPanel
Left = 184 Left = 182
Height = 34 Height = 34
Top = 0 Top = 0
Width = 100 Width = 100
@ -967,7 +967,7 @@
end end
end end
object PanelMaskTool: TPanel object PanelMaskTool: TPanel
Left = 351 Left = 346
Height = 34 Height = 34
Top = 0 Top = 0
Width = 99 Width = 99
@ -1201,23 +1201,23 @@
end end
object Label1: TLabel object Label1: TLabel
Left = 521 Left = 521
Height = 20 Height = 17
Top = 5 Top = 5
Width = 14 Width = 12
Caption = 'to' Caption = 'to'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 594 Left = 594
Height = 20 Height = 17
Top = 7 Top = 7
Width = 62 Width = 58
Caption = 'Poly num:' Caption = 'Poly num:'
ParentColor = False ParentColor = False
end end
object PolyNum: TSpinEdit object PolyNum: TSpinEdit
Left = 663 Left = 663
Height = 27 Height = 24
Top = 4 Top = 4
Width = 50 Width = 50
MaxValue = 20 MaxValue = 20
@ -1241,7 +1241,7 @@
Left = 0 Left = 0
Height = 34 Height = 34
Top = 0 Top = 0
Width = 28 Width = 30
Align = alLeft Align = alLeft
Caption = 'Size:' Caption = 'Size:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -1249,10 +1249,10 @@
ParentColor = False ParentColor = False
end end
object LabelDensity: TLabel object LabelDensity: TLabel
Left = 234 Left = 233
Height = 34 Height = 34
Top = 0 Top = 0
Width = 50 Width = 47
Align = alLeft Align = alLeft
Caption = 'Density:' Caption = 'Density:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -1260,10 +1260,10 @@
ParentColor = False ParentColor = False
end end
object LabelRoundness: TLabel object LabelRoundness: TLabel
Left = 95 Left = 97
Height = 34 Height = 34
Top = 0 Top = 0
Width = 71 Width = 68
Align = alLeft Align = alLeft
Caption = 'Roundness:' Caption = 'Roundness:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -1271,7 +1271,7 @@
ParentColor = False ParentColor = False
end end
object LabelTolerance: TLabel object LabelTolerance: TLabel
Left = 353 Left = 349
Height = 34 Height = 34
Top = 0 Top = 0
Width = 63 Width = 63
@ -1282,7 +1282,7 @@
ParentColor = False ParentColor = False
end end
object PanelSize: TPanel object PanelSize: TPanel
Left = 28 Left = 30
Height = 34 Height = 34
Top = 0 Top = 0
Width = 67 Width = 67
@ -1293,7 +1293,7 @@
TabOrder = 0 TabOrder = 0
object EditSize: TSpinEdit object EditSize: TSpinEdit
Left = 4 Left = 4
Height = 27 Height = 24
Top = 3 Top = 3
Width = 50 Width = 50
OnChange = EditSizeChange OnChange = EditSizeChange
@ -1302,7 +1302,7 @@
end end
end end
object PanelDensity: TPanel object PanelDensity: TPanel
Left = 284 Left = 280
Height = 34 Height = 34
Top = 0 Top = 0
Width = 69 Width = 69
@ -1313,7 +1313,7 @@
TabOrder = 1 TabOrder = 1
object EditDensity: TSpinEdit object EditDensity: TSpinEdit
Left = 4 Left = 4
Height = 27 Height = 24
Top = 3 Top = 3
Width = 56 Width = 56
OnChange = EditDensityChange OnChange = EditDensityChange
@ -1322,7 +1322,7 @@
end end
end end
object PanelRoundness: TPanel object PanelRoundness: TPanel
Left = 166 Left = 165
Height = 34 Height = 34
Top = 0 Top = 0
Width = 68 Width = 68
@ -1333,7 +1333,7 @@
TabOrder = 2 TabOrder = 2
object EditRoundness: TSpinEdit object EditRoundness: TSpinEdit
Left = 5 Left = 5
Height = 27 Height = 24
Top = 3 Top = 3
Width = 50 Width = 50
OnChange = EditRoundnessChange OnChange = EditRoundnessChange
@ -1341,7 +1341,7 @@
end end
end end
object PanelTolerance: TPanel object PanelTolerance: TPanel
Left = 416 Left = 412
Height = 34 Height = 34
Top = 0 Top = 0
Width = 68 Width = 68
@ -1352,7 +1352,7 @@
TabOrder = 3 TabOrder = 3
object EditTolerance: TSpinEdit object EditTolerance: TSpinEdit
Left = 6 Left = 6
Height = 27 Height = 24
Top = 3 Top = 3
Width = 54 Width = 54
OnChange = EditToleranceChange OnChange = EditToleranceChange
@ -1360,10 +1360,10 @@
end end
end end
object LabelTolerance1: TLabel object LabelTolerance1: TLabel
Left = 484 Left = 480
Height = 34 Height = 34
Top = 0 Top = 0
Width = 59 Width = 58
Align = alLeft Align = alLeft
Caption = 'Fill Alpha:' Caption = 'Fill Alpha:'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -1371,7 +1371,7 @@
ParentColor = False ParentColor = False
end end
object PanelTolerance1: TPanel object PanelTolerance1: TPanel
Left = 543 Left = 538
Height = 34 Height = 34
Top = 0 Top = 0
Width = 68 Width = 68
@ -1382,7 +1382,7 @@
TabOrder = 4 TabOrder = 4
object spinFillAlpha: TSpinEdit object spinFillAlpha: TSpinEdit
Left = 10 Left = 10
Height = 27 Height = 24
Top = 3 Top = 3
Width = 53 Width = 53
OnChange = spinFillAlphaChange OnChange = spinFillAlphaChange
@ -1391,10 +1391,10 @@
end end
end end
object LabelTolerance2: TLabel object LabelTolerance2: TLabel
Left = 611 Left = 606
Height = 34 Height = 34
Top = 0 Top = 0
Width = 35 Width = 33
Align = alLeft Align = alLeft
Caption = 'Fuzzy' Caption = 'Fuzzy'
Constraints.MinHeight = 32 Constraints.MinHeight = 32
@ -1402,7 +1402,7 @@
ParentColor = False ParentColor = False
end end
object PanelTolerance2: TPanel object PanelTolerance2: TPanel
Left = 646 Left = 639
Height = 34 Height = 34
Top = 0 Top = 0
Width = 30 Width = 30
@ -1413,9 +1413,9 @@
TabOrder = 5 TabOrder = 5
object checkFuzzy: TCheckBox object checkFuzzy: TCheckBox
Left = 4 Left = 4
Height = 23 Height = 17
Top = 5 Top = 5
Width = 24 Width = 18
OnChange = checkFuzzyChange OnChange = checkFuzzyChange
TabOrder = 0 TabOrder = 0
end end
@ -1424,7 +1424,7 @@
end end
object PanelPictures: TPanel object PanelPictures: TPanel
Left = 40 Left = 40
Height = 590 Height = 591
Top = 105 Top = 105
Width = 810 Width = 810
Align = alClient Align = alClient
@ -1626,9 +1626,13 @@
OnClick = FileSaveAsExecute OnClick = FileSaveAsExecute
end end
object MenuItemExportAsLRS: TMenuItem object MenuItemExportAsLRS: TMenuItem
Caption = '&Export As *.lrs...' Caption = '&Export as *.lrs...'
OnClick = FileExportAsLRSExecute OnClick = FileExportAsLRSExecute
end end
object MenuItemExportAsICO: TMenuItem
Caption = 'Export as *.ico...'
OnClick = MenuItemExportAsICOClick
end
object MenuItemClose: TMenuItem object MenuItemClose: TMenuItem
Caption = '&Close' Caption = '&Close'
Bitmap.Data = { Bitmap.Data = {

1081
applications/lazimageeditor/main.lrs
View File

File diff suppressed because it is too large Load Diff

22
applications/lazimageeditor/main.pas
View File

@ -68,6 +68,7 @@ type
EditRoundness: TSpinEdit; EditRoundness: TSpinEdit;
EditDensity: TSpinEdit; EditDensity: TSpinEdit;
EditTolerance: TSpinEdit; EditTolerance: TSpinEdit;
MenuItemExportAsICO: TMenuItem;
ToolsImageList: TImageList; ToolsImageList: TImageList;
PolyNum: TSpinEdit; PolyNum: TSpinEdit;
Label1: TLabel; Label1: TLabel;
@ -256,6 +257,7 @@ type
procedure MenuItemAboutClick(Sender: TObject); procedure MenuItemAboutClick(Sender: TObject);
procedure MenuItemClipPaperToMaskClick(Sender: TObject); procedure MenuItemClipPaperToMaskClick(Sender: TObject);
procedure MenuItemExitClick(Sender: TObject); procedure MenuItemExitClick(Sender: TObject);
procedure MenuItemExportAsICOClick(Sender: TObject);
procedure MenuItemResizeClick(Sender: TObject); procedure MenuItemResizeClick(Sender: TObject);
procedure MenuItemResizePaperClick(Sender: TObject); procedure MenuItemResizePaperClick(Sender: TObject);
procedure PaletteColorMouseMove(Sender: TObject; AColor: TColor; procedure PaletteColorMouseMove(Sender: TObject; AColor: TColor;
@ -361,6 +363,20 @@ begin
Close; Close;
end; end;
procedure TMainForm.MenuItemExportAsICOClick(Sender: TObject);
var
lExt, Value: string;
begin
ExportResourceDialog.Filter := 'Windows Icon (*.ico)|*.ico|All files (*.*)|*.*';
if ExportResourceDialog.Execute then
begin
Value := ExtractFileName(ExportResourceDialog.FileName);
lExt := ExtractFileExt(Value);
Value := Copy(Value, 1, Length(Value) - Length(lExt));
Pictures.ExportAsWindowsIcon(ExportResourceDialog.FileName);
end;
end;
procedure TMainForm.MenuItemResizeClick(Sender: TObject); procedure TMainForm.MenuItemResizeClick(Sender: TObject);
begin begin
if not Pictures.CanEdit then if not Pictures.CanEdit then
@ -1227,12 +1243,14 @@ end;
procedure TMainForm.FileExportAsLRSExecute(Sender: TObject); procedure TMainForm.FileExportAsLRSExecute(Sender: TObject);
var var
Value: string; lExt, Value: string;
begin begin
ExportResourceDialog.Filter := 'Lazarus resource (*.lrs)|*.lrs|All files (*.*)|*.*';
if ExportResourceDialog.Execute then if ExportResourceDialog.Execute then
begin begin
Value := ExtractFileName(ExportResourceDialog.FileName); Value := ExtractFileName(ExportResourceDialog.FileName);
Value := Copy(Value, 1, Length(Value) - Length(ExtractFileExt(Value))); lExt := ExtractFileExt(Value);
Value := Copy(Value, 1, Length(Value) - Length(lExt));
if InputQuery(lieSetResource, lieResourceName, Value) then if InputQuery(lieSetResource, lieResourceName, Value) then
begin begin
Pictures.ExportAsLazarusResource(ExportResourceDialog.FileName, Value); Pictures.ExportAsLazarusResource(ExportResourceDialog.FileName, Value);

38
applications/lazimageeditor/picturemanager.pas
View File

@ -84,14 +84,17 @@ type
procedure PageCloseQuery(var CanClose: Boolean); dynamic; procedure PageCloseQuery(var CanClose: Boolean); dynamic;
public public
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure New(AWidth, AHeight: Integer; APaperColor: TColor); procedure New(AWidth, AHeight: Integer; APaperColor: TColor);
procedure Load(const FileName: String); procedure Load(const FileName: String);
procedure Save; procedure Save;
procedure Save(const FileName: String); procedure Save(const FileName: String);
procedure ExportAsLazarusResource(const AFileName, AName: String); procedure ExportAsLazarusResource(const AFileName, AName: String);
procedure ExportAsWindowsIcon(const AFileName: String);
procedure Close; procedure Close;
procedure CloseAll; procedure CloseAll;
procedure Paste; procedure Paste;
function GetPicturePageByIndex(AIndex: Integer): TPicturePage;
function CanEdit: Boolean; function CanEdit: Boolean;
published published
@ -222,6 +225,11 @@ begin
PageClass := TPicturePage; PageClass := TPicturePage;
end; end;
destructor TPictureManager.Destroy;
begin
inherited Destroy;
end;
procedure TPictureManager.New(AWidth, AHeight: Integer; APaperColor: TColor); procedure TPictureManager.New(AWidth, AHeight: Integer; APaperColor: TColor);
var var
NewPage: TPicturePage; NewPage: TPicturePage;
@ -321,6 +329,31 @@ begin
end; end;
end; end;
procedure TPictureManager.ExportAsWindowsIcon(const AFileName: String);
var
lIcon: TIcon;
lPicturePage: TPicturePage;
i, lWidth, lHeight: Integer;
begin
lIcon := TIcon.Create;
try
for i := 0 to Self.PageCount - 1 do
begin
lPicturePage := GetPicturePageByIndex(i);
if lPicturePage = nil then Continue;
lWidth := lPicturePage.PictureEdit.Picture.Width;
lHeight := lPicturePage.PictureEdit.Picture.height;
lIcon.Add(pf24bit, 16, 16);
lIcon.Current:=i;
lIcon.Canvas.Draw(0, 0, lPicturePage.PictureEdit.Picture); // Currently this crashes due to a bug in TIcon
end;
lIcon.SaveToFile(AFileName);
finally
lIcon.Free;
end;
end;
procedure TPictureManager.Close; procedure TPictureManager.Close;
var var
CanClose: Boolean; CanClose: Boolean;
@ -355,6 +388,11 @@ begin
ActivePicturePage.PictureEdit.Paste; ActivePicturePage.PictureEdit.Paste;
end; end;
function TPictureManager.GetPicturePageByIndex(AIndex: Integer): TPicturePage;
begin
Result := TPicturePage(Self.GetPage(AIndex));
end;
function TPictureManager.CanEdit: Boolean; function TPictureManager.CanEdit: Boolean;
begin begin
Result := ActivePicturePage <> nil; Result := ActivePicturePage <> nil;