diff --git a/official/1.2.0/Design/PngComponentEditors.pas b/official/1.2.0/Design/PngComponentEditors.pas
new file mode 100644
index 0000000..a36113c
--- /dev/null
+++ b/official/1.2.0/Design/PngComponentEditors.pas
@@ -0,0 +1,223 @@
+unit PngComponentEditors;
+
+interface
+
+uses
+ Windows, SysUtils, Forms, Classes, Controls, PngImageList, TypInfo,
+ DesignIntf, DesignEditors, ColnEdit;
+
+type
+ TPngImageListEditor = class(TComponentEditor)
+ public
+ procedure Edit; override;
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): string; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+ TPngImageCollectionEditor = class(TComponentEditor)
+ public
+ procedure Edit; override;
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): string; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+ TPngButtonEditor = class(TComponentEditor)
+ public
+ procedure Edit; override;
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): string; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+ TPngImageListImagesEditor = class(TStringProperty)
+ public
+ procedure Edit; override;
+ function GetAttributes: TPropertyAttributes; override;
+ function GetValue: string; override;
+ end;
+
+ TPngImageCollectionItemsEditor = class(TPngImageListImagesEditor)
+ public
+ procedure Edit; override;
+ end;
+
+ TEditProperty = class
+ private
+ FPropery: string;
+ procedure EnumProperty(const Prop: IProperty);
+ public
+ constructor Create(Component: TComponent; const Prop: string; Designer: IDesigner);
+ end;
+
+implementation
+
+uses
+ PngImageListEditor;
+
+resourcestring
+ SEditImage = '&Edit image...';
+ SRecreateImages = '&Recreate images...';
+ SEditImages = '&Edit images...';
+ SEditing = 'Editing %s.%s';
+ SPNGObjectsHaveBeenCopied = 'The PNG objects have been copied to the internal imagelist.';
+
+//This type is neccesary to be able to call CopyPngs without having to make it
+//public in the TPngImageList class.
+type
+ TPngImageListAccess = class(TPngImageList);
+
+procedure EditProperty(Component: TComponent; const Prop: string; Designer: IDesigner);
+begin
+ TEditProperty.Create(Component, Prop, Designer).Free;
+end;
+
+{ TPngImageListEditor }
+
+procedure TPngImageListEditor.Edit;
+var
+ Component: TPngImageList;
+begin
+ Component := GetComponent as TPngImageList;
+ EditProperty(Component, 'PngImages', Designer); // do not localize
+end;
+
+procedure TPngImageListEditor.ExecuteVerb(Index: Integer);
+begin
+ case Index of
+ 0: Edit;
+ 1: begin
+ TPngImageListAccess(GetComponent).CopyPngs;
+ MessageBox(0, PChar(SPNGObjectsHaveBeenCopied),
+ PChar(string(GetComponent.ClassName)), MB_ICONINFORMATION or MB_OK);
+ end;
+ end;
+end;
+
+function TPngImageListEditor.GetVerb(Index: Integer): string;
+begin
+ case Index of
+ 0: Result := SEditImages;
+ 1: Result := SRecreateImages;
+ end;
+end;
+
+function TPngImageListEditor.GetVerbCount: Integer;
+begin
+ Result := 2;
+end;
+
+{ TPngImageCollectionEditor }
+
+procedure TPngImageCollectionEditor.Edit;
+var
+ Component: TPngImageCollection;
+begin
+ Component := GetComponent as TPngImageCollection;
+ EditProperty(Component, 'Items', Designer); // do not localize
+end;
+
+procedure TPngImageCollectionEditor.ExecuteVerb(Index: Integer);
+begin
+ Edit;
+end;
+
+function TPngImageCollectionEditor.GetVerb(Index: Integer): string;
+begin
+ Result := SEditImages;
+end;
+
+function TPngImageCollectionEditor.GetVerbCount: Integer;
+begin
+ Result := 1;
+end;
+
+procedure TPngButtonEditor.Edit;
+begin
+ EditProperty(GetComponent, 'OnClick', Designer); // do not localize
+end;
+
+{ TPngButtonEditor }
+
+procedure TPngButtonEditor.ExecuteVerb(Index: Integer);
+begin
+ EditProperty(GetComponent, 'PngImage', Designer); // do not localize
+end;
+
+function TPngButtonEditor.GetVerb(Index: Integer): string;
+begin
+ Result := SEditImage;
+end;
+
+function TPngButtonEditor.GetVerbCount: Integer;
+begin
+ Result := 1;
+end;
+
+{ TEditProperty }
+
+constructor TEditProperty.Create(Component: TComponent; const Prop: string; Designer: IDesigner);
+var
+ Components: IDesignerSelections;
+begin
+ inherited Create;
+ FPropery := Prop;
+ Components := TDesignerSelections.Create;
+ Components.Add(Component);
+ GetComponentProperties(Components, tkAny, Designer, EnumProperty);
+end;
+
+procedure TEditProperty.EnumProperty(const Prop: IProperty);
+begin
+ if Prop.GetName = FPropery then
+ Prop.Edit;
+end;
+
+{ TPngImageListImagesEditor }
+
+procedure TPngImageListImagesEditor.Edit;
+var
+ ImageList: TPngImageList;
+ dlg: TPngImageListEditorDlg;
+begin
+ dlg := TPngImageListEditorDlg.Create(nil);
+ ImageList := GetComponent(0) as TPngImageList;
+ dlg.Caption := Format(SEditing, [ImageList.Name, GetName]);
+ dlg.Images.Items.Assign(ImageList.PngImages);
+ dlg.ImageWidth := ImageList.Width;
+ dlg.ImageHeight := ImageList.Height;
+ if dlg.ShowModal = mrOK then begin
+ ImageList.PngImages.Assign(dlg.Images.Items);
+ Designer.Modified;
+ end;
+end;
+
+function TPngImageListImagesEditor.GetAttributes: TPropertyAttributes;
+begin
+ Result := inherited GetAttributes + [paDialog, paReadOnly];
+end;
+
+function TPngImageListImagesEditor.GetValue: string;
+begin
+ Result := '(PNG images)'; // do not localize
+end;
+
+{ TPngImageCollectionItemsEditor }
+
+procedure TPngImageCollectionItemsEditor.Edit;
+var
+ Collection: TPngImageCollection;
+ dlg: TPngImageListEditorDlg;
+begin
+ Collection := GetComponent(0) as TPngImageCollection;
+ dlg := TPngImageListEditorDlg.Create(nil);
+ dlg.Caption := Format(SEditing, [Collection.Name, GetName]);
+ dlg.Images.Items.Assign(Collection.Items);
+ if dlg.ShowModal = mrOK then begin
+ Collection.Items.Assign(dlg.Images.Items);
+ Designer.Modified;
+ end;
+end;
+
+end.
diff --git a/official/1.2.0/Design/PngComponents.dcr b/official/1.2.0/Design/PngComponents.dcr
new file mode 100644
index 0000000..83ad90b
Binary files /dev/null and b/official/1.2.0/Design/PngComponents.dcr differ
diff --git a/official/1.2.0/Design/PngComponentsRegister.pas b/official/1.2.0/Design/PngComponentsRegister.pas
new file mode 100644
index 0000000..e538dd9
--- /dev/null
+++ b/official/1.2.0/Design/PngComponentsRegister.pas
@@ -0,0 +1,41 @@
+unit PngComponentsRegister;
+
+interface
+
+uses
+ Classes, DesignIntf, TypInfo,
+ PngSpeedButton, PngBitBtn, PngImageList, PngCheckListBox, PngComponentEditors;
+
+procedure Register;
+
+implementation
+
+const
+ SPageName = 'Png';
+
+procedure Register;
+begin
+ //Register all components
+ RegisterComponents(SPageName, [TPngSpeedButton, TPngBitBtn, TPngImageList,
+ TPngImageCollection, TPngCheckListBox]);
+
+ //Register component editors
+ RegisterComponentEditor(TPngImageList, TPngImageListEditor);
+ RegisterComponentEditor(TPngImageCollection, TPngImageCollectionEditor);
+ RegisterComponentEditor(TPngBitBtn, TPngButtonEditor);
+ RegisterComponentEditor(TPngSpeedButton, TPngButtonEditor);
+
+ //Register property editors
+ RegisterPropertyEditor(TypeInfo(TPngImageCollectionItems), TPngImageList,
+ 'PngImages', TPngImageListImagesEditor); // do not localize
+ RegisterPropertyEditor(TypeInfo(TPngImageCollectionItems), TPngImageCollection,
+ 'Items', TPngImageCollectionItemsEditor); // do not localize
+
+ //Hide properties that should be omitted
+ UnlistPublishedProperty(TPngSpeedButton, 'NumGlyphs'); // do not localize
+ UnlistPublishedProperty(TPngSpeedButton, 'Glyph'); // do not localize
+ UnlistPublishedProperty(TPngBitBtn, 'NumGlyphs'); // do not localize
+ UnlistPublishedProperty(TPngBitBtn, 'Glyph'); // do not localize
+end;
+
+end.
diff --git a/official/1.2.0/Design/PngImageListEditor.dfm b/official/1.2.0/Design/PngImageListEditor.dfm
new file mode 100644
index 0000000..3a8c8f5
--- /dev/null
+++ b/official/1.2.0/Design/PngImageListEditor.dfm
@@ -0,0 +1,574 @@
+object PngImageListEditorDlg: TPngImageListEditorDlg
+ Left = 202
+ Top = 128
+ BorderIcons = [biSystemMenu]
+ Caption = 'Editing PngImageList'
+ ClientHeight = 288
+ ClientWidth = 461
+ Color = clBtnFace
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnResize = FormResize
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object pnlMain: TPanel
+ Left = 0
+ Top = 0
+ Width = 461
+ Height = 249
+ BevelOuter = bvNone
+ TabOrder = 0
+ DesignSize = (
+ 461
+ 249)
+ object gbxProperties: TGroupBox
+ Left = 8
+ Top = 4
+ Width = 177
+ Height = 128
+ Anchors = [akLeft, akTop, akBottom]
+ Caption = 'Image properties'
+ TabOrder = 0
+ object lblName: TLabel
+ Left = 10
+ Top = 20
+ Width = 31
+ Height = 13
+ Caption = '&Name:'
+ FocusControl = edtName
+ end
+ object lblBackgroundColor: TLabel
+ Left = 10
+ Top = 64
+ Width = 86
+ Height = 13
+ Caption = '&Background color:'
+ FocusControl = cmbBackgroundColor
+ end
+ object edtName: TEdit
+ Left = 8
+ Top = 35
+ Width = 161
+ Height = 21
+ TabOrder = 0
+ OnChange = edtNameChange
+ end
+ object cmbBackgroundColor: TComboBox
+ Left = 29
+ Top = 79
+ Width = 140
+ Height = 21
+ ItemHeight = 0
+ TabOrder = 2
+ OnChange = cmbBackgroundColorChange
+ OnDblClick = cmbBackgroundColorDblClick
+ OnExit = cmbBackgroundColorExit
+ end
+ object pnlBackgroundColor: TPanel
+ Left = 8
+ Top = 79
+ Width = 20
+ Height = 21
+ BevelOuter = bvNone
+ BorderStyle = bsSingle
+ TabOrder = 1
+ OnClick = cmbBackgroundColorDblClick
+ end
+ end
+ object lbxImages: TListBox
+ Left = 276
+ Top = 8
+ Width = 177
+ Height = 209
+ Style = lbOwnerDrawVariable
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ DragCursor = crDefault
+ DragMode = dmAutomatic
+ ItemHeight = 16
+ MultiSelect = True
+ TabOrder = 3
+ OnClick = lbxImagesClick
+ OnDblClick = lbxImagesDblClick
+ OnDragOver = lbxImagesDragOver
+ OnDrawItem = lbxImagesDrawItem
+ OnEnter = lbxImagesEnter
+ OnExit = lbxImagesExit
+ OnKeyDown = lbxImagesKeyDown
+ OnMeasureItem = lbxImagesMeasureItem
+ OnMouseUp = lbxImagesMouseUp
+ OnStartDrag = lbxImagesStartDrag
+ end
+ object cmbPreviewBackground: TComboBox
+ Left = 276
+ Top = 220
+ Width = 177
+ Height = 21
+ Style = csOwnerDrawFixed
+ Anchors = [akLeft, akRight, akBottom]
+ ItemHeight = 15
+ TabOrder = 4
+ OnChange = cmbPreviewBackgroundChange
+ OnDrawItem = cmbPreviewBackgroundDrawItem
+ Items.Strings = (
+ 'Default background'
+ 'Checkerboard background'
+ 'Diamonds background'
+ 'Slashed background'
+ 'Backslashed background')
+ end
+ object gbxImageInfo: TGroupBox
+ Left = 8
+ Top = 136
+ Width = 177
+ Height = 105
+ Anchors = [akLeft, akBottom]
+ Caption = 'Image information'
+ TabOrder = 1
+ object lblDimensions: TLabel
+ Left = 8
+ Top = 20
+ Width = 70
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Dimensions:'
+ end
+ object lblColorDepth: TLabel
+ Left = 8
+ Top = 36
+ Width = 70
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Color depth:'
+ end
+ object lblTransparency: TLabel
+ Left = 8
+ Top = 52
+ Width = 70
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Transparency:'
+ end
+ object lblCompression: TLabel
+ Left = 8
+ Top = 68
+ Width = 70
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Compression:'
+ end
+ object lblFiltering: TLabel
+ Left = 8
+ Top = 84
+ Width = 70
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Filtering:'
+ end
+ object lblDimensionsValue: TLabel
+ Left = 82
+ Top = 20
+ Width = 87
+ Height = 13
+ AutoSize = False
+ ShowAccelChar = False
+ end
+ object lblColorDepthValue: TLabel
+ Left = 82
+ Top = 36
+ Width = 87
+ Height = 13
+ AutoSize = False
+ ShowAccelChar = False
+ end
+ object lblTransparencyValue: TLabel
+ Left = 82
+ Top = 52
+ Width = 87
+ Height = 13
+ AutoSize = False
+ ShowAccelChar = False
+ end
+ object lblCompressionValue: TLabel
+ Left = 82
+ Top = 68
+ Width = 87
+ Height = 13
+ AutoSize = False
+ ShowAccelChar = False
+ end
+ object lblFilteringValue: TLabel
+ Left = 82
+ Top = 84
+ Width = 87
+ Height = 13
+ AutoSize = False
+ ShowAccelChar = False
+ end
+ end
+ object pnlActionButtons: TPanel
+ Left = 193
+ Top = 35
+ Width = 75
+ Height = 178
+ Anchors = [akLeft]
+ BevelOuter = bvNone
+ TabOrder = 2
+ object btnAdd: TPngBitBtn
+ Left = 0
+ Top = 0
+ Width = 75
+ Height = 25
+ Caption = '&Add'
+ TabOrder = 0
+ OnClick = btnAddClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000002804944415478DA8D925D48145114C7FF33AEBB7725BF52
+ 23B31E8D908C08EB210885A8C0879630B132320A3114C2972232049F22E893BE
+ E82125A32CF13362C3079505832CB34811524837025B4557F7EBEEECDC3BB7AB
+ A3D52846070E773867FEBF39FF734711426021B2CFF454C6547BADA638D29599
+ A92FB648A88E33FE8A85A382852958240A1692A77CD6231A04BFBEA85396015B
+ 4E7BC239FB7625541424A2FECD24FA5EBF178E90FFAAE046CD7F01369579A8EB
+ 643E797800189E05EADC4174B5F4439D186B8CE3BC5AA79AFFDF8013DD34FFD8
+ 7E72710F1033005D01DA87389E37F421F8F1934765AC5C4E31B62660637117CD
+ 2B3944CA738108930D0970DA81FE1F024F1B07E0EBEA1DB569E152A6F1015DDA
+ 5905D8E072D36D2585E4683610D56136653A1DC04408686B1BC14453874F9DF3
+ 5719DC6835F80D2B20A3B0936E2E7691822C6981C3128E7820205FEBE9F662BC
+ FE8586E9C90B42DCBE6B01A41D6CA5C9454564472AC00C53C88539459C0AD864
+ EA36E0C3A00F53B71E4445A8CE6901AC2F7849D523252493008659324FC504E9
+ 6C6114C03FEEC3FC3D0908AE00A4EC7D4623AE5222F558D263A1A51B660AB950
+ 7CFD06743469989D9216EE582D24ED7E428387CB088C65F552CAD115B90331F8
+ 197037FB40035580BD55889BD62526ED7C4C95E36709D89FE529EAA211447A7A
+ A1F7BA47C163A540FC8039DD0A404AEE239A71AE8208DDF4ADCAAF72CA30DDD2
+ 8EE0BBB71E592C973986DFF656005273EED3ED97AB088BCA8D4BBF81F19FF036
+ 77627E64A85156AA25D2FFF7D5AE02ACCBBA16CE3B7F2A216D6B26BC9E610C37
+ 3447B5C08CFC5BEC57CCCBB4C62A80CD79A9D2999C589B909E9A3EE7FD3E140B
+ 856BA45F37D68865C02F696882F0CDD367480000000049454E44AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ object btnDelete: TPngBitBtn
+ Left = 0
+ Top = 29
+ Width = 75
+ Height = 25
+ Caption = '&Delete'
+ TabOrder = 1
+ OnClick = btnDeleteClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C0000026B4944415478DA8D935948545118C7FF779B7BE7CEA233
+ A913068D46E38339916225B43866B48C94630E961562D1438821E44B3D0D483E
+ 842F06D9824259894942168542055AD04B0D0519D1F2580E895B33317366BBB7
+ 338E4533B9F487EF5CEE39DFF73BDFF91F0EA3AA2A1262D85608B2085EA75D08
+ 09BCAC05A793184EE00EC664BD0759391BC578784AA346DA3EDFA8BC325FB712
+ 003CDB1ED69BCEEF38B08539B93F17D7470378FFDC1BFCDAEBD02D0F904593C2
+ 729D6ABEAD618FBB0C9E2A03369881A627C0D0AD51E2BBEDD02E0D90259BC2F3
+ DD86D292F2A38DDBE1B27310689AC0021DAF80B1FEA7C4D7BF7B3180044EE44A
+ E3A2AECFB2B7A2E058C3666C5DC32018051269320FF4BC03BC0323E4FBE0BE54
+ 004B012CC7D42A99E62E6BBDCB525D5308AB1E08856931929204E0FE17E0D3C0
+ 6332F9B02AAD03A6E50CB2733BF21A0F8B3B2BF360A473E11852A4E1801713C0
+ B77B43646AD89506D07B42592D4D5271B1057C04882D6CCBFC19929F37D34064
+ 6890CC3E73A7010C9E5046739394B3DE827868219B2EC569286AF2D74FC173B4
+ 2BD3F05D32337664912398733AF843F5225BB88EF64FEBE3C94E54E5AF735023
+ 331EDD21732F8FA703CED231520BADB10BCE3A0B4A3601D47D28A93E80FA6078
+ 7093F8BD8D8B01128A9682D3F40915CE02795745E27EFEE940E9EF2181B7A796
+ 0224A4DA68741BCAB69567BB6BC0697928D1A4270CBDCAC9ABD7C88FF1D3CB01
+ 12524CD481CE8C427B83B5AE1AC6FCD58851137909186FBF4C663F34AF044072
+ 4B442E88C655AD4527EA24ABA308D31F7D787DA937F873E29CEE3F00BF15756A
+ F4BAF64CEB5A7B7072662AE40FB4C5C8C5F9E7FC0BBF2FFCE106AF47A6000000
+ 0049454E44AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ object btnReplace: TPngBitBtn
+ Left = 0
+ Top = 58
+ Width = 75
+ Height = 25
+ Caption = '&Replace'
+ TabOrder = 2
+ OnClick = btnReplaceClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000003464944415478DA5D525B4C5457145DE70EC3D0995B2582
+ 8A112316FBD12698C6F8200A3206A90A43438C3AB5C6D6261325FAD3F4A3F607
+ DBFEF92121468D1AA2898FD8001518CC84A94AC6AA959AB64322FED854014306
+ 9D1106B833F7FD70DF3B62D49DEC7372CED96BEDB5F73EAC7CFFC05185E5B768
+ 8A9A2E10670EE8B2D6AB4B0AC8161A8CEBD05CDE6A6B3A3DEC1233BB74597DA2
+ 8B0A0C4986264AB074136C6968305BD3B0D6CB341591CEC1143FF33CA82946CC
+ 54D490AF6255FB3707D7221A7E8CA15FA3718FAE345282C43B04A5CDFF668E7D
+ BFDAB7BD0CD877258B3B5DB713FC6CD22F8B6ADDA70D9B4E477FF9040F93C0FE
+ 9FE378168EC65C9619342425F5866049E8817028B48E0F7E0C8C668196EE690C
+ 77FF1ECF9F4A8EAFDCEEFFA2F5BB0A147B80072F8023C7E34847FA7B3851DCAB
+ C98AE410947C3B28ECF9BA92DFB20CD04C2029036DE1098C748451B6B9123F1D
+ FE0C8487270F187C0E9C68BB874C24729EA96AB3695A3A5BB4EFAEB06D4F15BF
+ 613120E980DB0508B45FBE3E0AFEC302046B4BE0B2008BBC8048FE22259DADFD
+ 9007A2672C703FB0E2AFFE10D6EDD8C4571402AA418194CDCD0122030C3A7B69
+ 37E992D973A1C5E306224F4D0C9FEE02E27FB6B1A2604C280FF8F98FBCB912E6
+ 8C63B9DD06CF997DA5D3F93E3535F992649E3B9161453B6F09F3EA6AF945C44C
+ 3D7100D66B02DB5FF33825D80AC7668119C242A5E52C112C68BA2168D5757CBE
+ 95BB538C1C497E01B94DA0E752DBEA32F6FF7239BA806B9DC0D0FD565618880A
+ D3EBB7F2D0904BCD7241ECFFFF607D40752D2975E2E76A60D448ABBF8F4672E3
+ 2475EB47B6A03E22E835F50E01B3C114608C8C41EBBA88BCAA5AB8366C84F3C6
+ E5C0E2CD01A837C3E7A9C066721A63FD75615E4380B7543A521FE4F11798ECB8
+ FAB7369118290C34ED9E5FB3D1A99F235553B7EE61B2B7A787BEE05E922939A2
+ 4A037D99E5C1461FA8F6EC441AA397AE26C4C4845F97D4CFCB76EF3855B2A5D2
+ 513616BE8DF1EEDF62243B48B0D49BC994545DCAAE39F8A557991131D4DE999A
+ 1D7B16E45C793179321D5AB1CDDFBEE670131EF7FD8347172EC74D038D943981
+ B78CCD2F6F3DEAE67D2DA6A4A4332FA70E701CD7ABCE6661AADAC23C8FBBC357
+ 5C549D4D4D0EEBAABC8BC04FF09EBD02E1D692A4E09B28E50000000049454E44
+ AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ object btnClear: TPngBitBtn
+ Left = 0
+ Top = 87
+ Width = 75
+ Height = 25
+ Caption = '&Clear'
+ TabOrder = 3
+ OnClick = btnClearClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000003094944415478DA6D935B48145118C7FFB373E6BA9BDBBA
+ ADB58BE1A5A8970CB4A28C8A966EA696DA45ED22452515296A12BD45E14B4545
+ 0F15223D1414B545216D8558A2A6899544D8432F964611994617775777DD9DE9
+ 9B59A5A80E733867BE6FFEBFF3FDBFE170400D38DE02A6CA608A0C5E95C06471
+ 96A6DA6E730E47068B8E76303D560270434C11C1CB426158B137088AE410F570
+ 1DF70F40163C1126F933B7ADCFCA299A8B2BF5CF11ECED2DE725F1B220F1DE80
+ 7D862FBF24DBA50912DAEFBF08FD05905C518EF7A514AEF35E39BE00F3938075
+ C7DEE0CD83F643B2223E0AD893DA56147B3DD7765AF17000387AF665F0374016
+ 155D55AF3BF2728B4E1DC9C2E2E9C07018A83DFF1A7D0FDBEE45125DC9199B73
+ B2EA364D45AA15F0F501971A9E05E2008E6310C57A6B7EEEDEEAC3CB914DE270
+ 94268013175EA1BFB51BE9A505A82970234906040BF0F80370E36AB701A8B601
+ B1D3CAAA9C83C5B5B95842E23112739489D1F4B57C4660640C651B52318501E3
+ 3140A1B56B1068BAD169002ACF2173694D464531F2D22D088FD3B1BAF9C042D9
+ 106D781E50691DD7084C7191DE5F7F079EDF794200F79911ECAFB2254D63584A
+ 4D635C5C3C390C8831B43F8286857721E0ADBF750270A0CA0691C14EA5A524C4
+ 4FE02684FA84D898DC049011E00B55FAB3B9C5B470862CD46273B19126E3804D
+ 8A9F625A216884B691D1B85822B868C40CD09366B3892AB93B89ECB595DCFA8D
+ D0A3F8EDC1807CFA086E2C047DF61C136EE68C5204606A7753FC375281C4D4EA
+ C535057BD535AB4C886E348C3E8A763D45B4E33184ADBBC1A7A75080727A1CC0
+ DA1F4C028C1153C0B1EBCEC2A2A2C4D5CBA0C5E27DF8D1DE896FFEC65BA2DB93
+ E62CDDB1484E9E0E8DFC7322E5EEFBFF04982D73911D5FF2A62DDE948295D0A8
+ 8AC1962E0CF8EE56D03D69563DEEB6D45DDB3D56B783FE2DF0FEA63FF817C0AC
+ C463E1E19FB7A72C6BEEC685E8B9D888FEA6D67239D171598BC5BC0969337D99
+ FB4A5C925D454FFDCDD07F0026641613E5DB5697332338FCB5231A1E2FB1086C
+ 484CB05155D142DB34678385AE732410ACFB05147F0B83A25F23860000000049
+ 454E44AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ object btnUp: TPngBitBtn
+ Left = 0
+ Top = 124
+ Width = 75
+ Height = 25
+ Caption = '&Up'
+ TabOrder = 4
+ OnClick = btnUpClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C0000021C4944415478DAA5933B68535118C7FFE7DE247D886821
+ 26197C504C8A5894D2461087BA38A874503B89521F9B858E0AA28BA08B1D1C14
+ 412D48EB031D62972E6D8DD84987802D8A1645712AA6A995368F7BCFDB737223
+ B44171C8E17CE783EF5E7EE7FBFEF77F89D61A8D2CD23020753E0B68BBAB07A0
+ ECA121851CF211B9A928835B2A5E9294DE16C50A44C983CDAC5481E6F2EF0025
+ 44BF1F6A79D27B38DD04A530FD7C863A3F0BA714E599FF038448AF8AD0C48143
+ DDF13B27DB400870617411D9B1A97CB357EC931ECBF17F0374CAA37A626BF79E
+ 8ECB2712D81209E65C12C0B587DF309F99FC1C617E1FAFD02FAC585E03B04BA9
+ 362ED4787847EAE0E923ED486E02CA3C78B4C180BE9680FB0F7258CEBE9E218C
+ 1F371DFC5AD781E4629447B70DECEFDD85DD51029F013CD01361076869023E2D
+ 294C8E4CC37BFB664C7371467155034871BDD81ABB92E8DA8B8EA8032103396C
+ 4805840C4098CC4C616E41A0F0E8199C8FB337941BBE4A5267A78E5244322BED
+ FB9AE3B156386B6CA1AB46017C334AA16C46A2A61036B5FC22F0F49EAF970BFD
+ 64E7B957EF56E29D5D7C730C9A0437592BB824080BA4352D1C52231B887AFF01
+ FE8BC7B324399813A1CE1E574BABA301A00E60BB2075F63345C708FB7DF8AE24
+ C981973F123DE9F8C698915DD9B7AB1BEB0C5E07704266A4F905CCDD1AC993ED
+ C7C6075DD71DB697492ACDB765904C40D9E036F35AFCA905F3B0B2A7E86AE962
+ E33F53A380DF494945E019F9A78D0000000049454E44AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ object btnDown: TPngBitBtn
+ Left = 0
+ Top = 153
+ Width = 75
+ Height = 25
+ Caption = '&Down'
+ TabOrder = 5
+ OnClick = btnDownClick
+ Layout = blGlyphRight
+ Margin = 6
+ Spacing = 3
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000002174944415478DAB5934F68134114C6BFCD6E936AFF482B
+ 521A3555AC52D4D21EF620586C4104FF1D2C257810ADA5148AC5A35E144F7A50
+ 111141105A44AD07853482C593158A2749A1912A88550F82D5DA966CB2D96E76
+ 6667C7994D0824F1161C18DEEEDB79BFF7E6FB5885738E6A965235A07D68E682
+ E3A9B719E3014E5D7894C22322120A26222F4617CCFF4EFCC8D2A607C3B8A444
+ 86DFFD8EE85D2DBBDA1AE079E5F8B257259FD3346021F1137337279695D69184
+ 3B7A5E574FB50386535153B254592CF6C620F0F207702DFA8029E1E8EBF9B0DE
+ DD1DED6B459D0A30AFB25042B500F0C70252A249631D30F5E2233E3D9C4C2A6D
+ FD53C7B3448D6D3BDC5B7B68FF26410078D9D812FA6105F8BC0AE404A866750D
+ C6DD7B39ACA70694ADC79E83DBCE75AB297C65FB913EEC6856C10A105EE8BE68
+ 00DF5205A2EB02938F80AFC91B40E8AA123E2A000E0535ADC774E7DE73F53D07
+ 119417155DA5C32601D67252004914C9780C48CC3E11730C4A7C1E202CA2996C
+ 13B349DCEE3CD0EB76E9E06EFEBCEF8C1C430887B733C09B57B3E2A91F08F833
+ 1501C4B4C032D66E97B269D673628FB6AF03ACE04A6003E0BC4F82C49F7E1182
+ 9C14D9C5A2462500D3064D9B3AD782D35BA2A75BEA3B223E21B3F01D4B13E3CB
+ CC324571CD5C89431580EC3A889119A86DDEFCAC73EC6C480A317F67DCB1577E
+ 9D11F7885558FC2F80BF4DEB62A8B1E1163C8E5CDAB82C54BCFF7F7EA66A017F
+ 01C92B1C3633E7F2D20000000049454E44AE426082}
+ PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
+ end
+ end
+ end
+ object pnlButtons: TPanel
+ Left = 0
+ Top = 249
+ Width = 461
+ Height = 37
+ BevelOuter = bvNone
+ TabOrder = 1
+ DesignSize = (
+ 461
+ 37)
+ object pnlModalButtons: TPanel
+ Left = 152
+ Top = 4
+ Width = 158
+ Height = 25
+ Anchors = [akBottom]
+ BevelOuter = bvNone
+ TabOrder = 0
+ object btnOK: TPngBitBtn
+ Left = 0
+ Top = 0
+ Width = 75
+ Height = 25
+ Caption = '&OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 0
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000001D44944415478DAC5934148146118869F7F669ADD550221
+ 5C5110090FDB25820E2B052D754848F010648487D214098930A443E521F02228
+ E52D4AA873744828DA20483A48D6C15B5D4294D2924A6D0F5B63EB36BEF3AF44
+ 222D8287061E66BEE17B9F9DEF9B1D1386213B39CC8E05DCA49E353E9257F543
+ FC146BC213BED8F5D7B5B751FB34FA31BA5C97FD8661A629709D55B26505D1D9
+ A58E18E771E85115188F36E30C39AF5DDF6D2C7C2BB44934B145109D43F65049
+ 77554355673C164F2DCE2C4E4A72C654326FCC35D39FCC24477273B9F9E06D70
+ 5AEDAF242A050D35929CF4EABD3EF5A4BC658F85C9856CB150ECA6824FA6226A
+ E925E337FBCF9D238E1FDC096699E394A2EF44070D7498C3A629914E60A60CF9
+ A7F9871AA38738DF05254117493566B9CC41BE28768F198DB14486348754578B
+ 47E209A3FAD51BEC266747FB23E85451E43617B9404AD71F84236A4534CA036D
+ E40DB7B4BCABDA435112360BDAA37D6AB327B8CB513D60B8D1B0221E8B69AE28
+ 38226C68ABA0D53EC13EF6F292731A277A5DCB625CDAF75C5270CC8612FF12B4
+ 584174E3859EE318BFECBC2B1AA55FCDF76D205E4E705CC56FFB4719E000837C
+ E6ABC267F51A9F6D0A9615948EB41893AC4F4B9CB07762DB10FCF7AF711D7610
+ 84C5CCB842D50000000049454E44AE426082}
+ end
+ object btnCancel: TPngBitBtn
+ Left = 83
+ Top = 0
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = '&Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000002E24944415478DA6D93CB4F135114C6BF79B5451E022D42
+ B0C5C82321206A58812B4AD8B8D2981077B22BB4087F4C1BCA232E64E38618FF
+ 00096C30411E0B44A031214140A10FFAA02D7DCCDCB99E3B8A4074929399CC9D
+ EF37F77EDF39D2D1230012C00DDCA1EA3638964B65A05C02741D600C372EC380
+ 9773EC98266206AD49478F495C42BDEA541750533198DFCB064837FD3F0089FD
+ 352E255CCA9A4BD92C1FE640523A7C8066B5D6365FF7EAC590E66EC149F88D99
+ DE4C4E3219537AF90A40B07197C7166CEFF7C8D9E30CBE7D4E2CE62E30221D76
+ 6240BB5FB5DCF03A00D9D104F3C7571CBF7D6F24B7321304991100128FB9DCF6
+ 506BBF5BD5B802964C636B258E54867BA5C387908A598CDDEA72061B5F3E5315
+ 471DD8E93E0EDE7DC45924EFD309E074DBE63AFA3D50B80C3D914164FDCC8825
+ D8A4AC604600502A02C5738C5777DD0EDD7DEE9514AD0A2C7A80FD0F9BE0BA89
+ D63E37344B9C16621E4D98130A1D51986F01CA04289169A53CFCD5ED95E196A7
+ BDD0640758220A295F806CC012EF6D9C211637038A8269CB180BD0F33B3201B0
+ EE45F86AEF55CCB60D744021217279B0740EBB6B0944636C94C4737F63118055
+ 273DF0ABA8C8309FCB639F6D7FD20245A7855C810017D8FD92C6CF241F953801
+ E8B5F94723ADD6DF10FBC9B0701B1926CECCCE32405E87526428A78AD8FD5EC6
+ 4901018563FA1F80C8D9E9B185DAFA3C92884A4FA410D94852F798E86CD0A015
+ 4CE8E706B6D3E0511313B493A94B80441D36E674DB83E4B67AE9F6DEBA65984F
+ F451A30373DD0E40CBD28FA8B9B6097B0A4CCAA018576A3040EDB9DCE5BD0799
+ ABD0E356544634CE26C8B019EA799419C61A65847A18544DEC966A832A057805
+ A0D96697E7DB7BEB872A1D32226B09331A3727AD9CE9120046454336DEC411A4
+ D064DA08B680454A7F44FA546B45586FB761C1AE4A83C90C0F9078FAD2D84B00
+ 4D201887BF0E089370290F0CAB6298048051DE659DC699A15B96B17C7D7CAF03
+ 44D1A75E05D8A1168889F55F525F839E0094AAF50000000049454E44AE426082}
+ end
+ end
+ object chkUseFilenames: TCheckBox
+ Left = 341
+ Top = 7
+ Width = 112
+ Height = 17
+ Anchors = [akTop, akRight]
+ Caption = 'Use Filenames'
+ Checked = True
+ State = cbChecked
+ TabOrder = 1
+ end
+ end
+ object dlgOpenPicture: TOpenPictureDialog
+ DefaultExt = 'png'
+ Filter = 'Portable Network Graphics (*.png)|*.png'
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Title = 'Browse for a PNG file'
+ Left = 40
+ Top = 251
+ end
+ object dlgColor: TColorDialog
+ Options = [cdAnyColor]
+ Left = 72
+ Top = 251
+ end
+ object Images: TPngImageCollection
+ Items = <>
+ Left = 8
+ Top = 251
+ end
+end
diff --git a/official/1.2.0/Design/PngImageListEditor.pas b/official/1.2.0/Design/PngImageListEditor.pas
new file mode 100644
index 0000000..48137ee
--- /dev/null
+++ b/official/1.2.0/Design/PngImageListEditor.pas
@@ -0,0 +1,1216 @@
+unit PngImageListEditor;
+
+interface
+
+uses
+ Windows, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
+ ExtDlgs, pngimage, PngFunctions, PngBitBtn, PngImageList, Buttons;
+
+type
+ TPngImageListEditorDlg = class(TForm)
+ cmbBackgroundColor: TComboBox;
+ cmbPreviewBackground: TComboBox;
+ dlgColor: TColorDialog;
+ dlgOpenPicture: TOpenPictureDialog;
+ edtName: TEdit;
+ gbxImageInfo: TGroupBox;
+ gbxProperties: TGroupBox;
+ lblBackgroundColor: TLabel;
+ lblColorDepth: TLabel;
+ lblColorDepthValue: TLabel;
+ lblCompression: TLabel;
+ lblCompressionValue: TLabel;
+ lblDimensions: TLabel;
+ lblDimensionsValue: TLabel;
+ lblFiltering: TLabel;
+ lblFilteringValue: TLabel;
+ lblName: TLabel;
+ lblTransparency: TLabel;
+ lblTransparencyValue: TLabel;
+ lbxImages: TListBox;
+ pnlActionButtons: TPanel;
+ pnlBackgroundColor: TPanel;
+ pnlMain: TPanel;
+ btnAdd: TPngBitBtn;
+ btnDelete: TPngBitBtn;
+ btnReplace: TPngBitBtn;
+ btnClear: TPngBitBtn;
+ btnUp: TPngBitBtn;
+ btnDown: TPngBitBtn;
+ Images: TPngImageCollection;
+ pnlButtons: TPanel;
+ pnlModalButtons: TPanel;
+ btnOK: TPngBitBtn;
+ btnCancel: TPngBitBtn;
+ chkUseFilenames: TCheckBox;
+ procedure btnAddClick(Sender: TObject);
+ procedure btnClearClick(Sender: TObject);
+ procedure btnDeleteClick(Sender: TObject);
+ procedure btnDownClick(Sender: TObject);
+ procedure btnReplaceClick(Sender: TObject);
+ procedure btnUpClick(Sender: TObject);
+ procedure cmbBackgroundColorChange(Sender: TObject);
+ procedure cmbBackgroundColorDblClick(Sender: TObject);
+ procedure cmbBackgroundColorExit(Sender: TObject);
+ procedure cmbPreviewBackgroundChange(Sender: TObject);
+ procedure cmbPreviewBackgroundDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+ procedure edtNameChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormCreate(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure lbxImagesClick(Sender: TObject);
+ procedure lbxImagesDblClick(Sender: TObject);
+ procedure lbxImagesDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+ procedure lbxImagesDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+ procedure lbxImagesEnter(Sender: TObject);
+ procedure lbxImagesExit(Sender: TObject);
+ procedure lbxImagesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure lbxImagesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
+ procedure lbxImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure lbxImagesStartDrag(Sender: TObject; var DragObject: TDragObject);
+ private
+ FDraggingIndex: Integer;
+ FImageHeight: Integer;
+ FImageWidth: Integer;
+ FMaxWidth: Integer;
+ FSelectionBodyColor: TColor;
+ FSelectionBorderColor: TColor;
+ function ConformDimensions(Png: TPngImage): Boolean;
+ function FirstSelected: Integer;
+ function LastSelected: Integer;
+ procedure DrawBackground(Canvas: TCanvas; const ARect: TRect; ScrollPos, Index: Integer;
+ BlendColor: TColor = clNone; IgnoreScrollPos: Boolean = False);
+ procedure GetColorProc(const S: string);
+ procedure ParseBackgroundColor(Sender: TObject; CanDisplayError, CanChangeText: Boolean);
+ procedure SelectBackgroundColor(Sender: TObject; Color: TColor);
+ public
+ property ImageHeight: Integer read FImageHeight write FImageHeight;
+ property ImageWidth: Integer read FImageWidth write FImageWidth;
+ end;
+
+var
+ PngImageListEditorDlg: TPngImageListEditorDlg;
+
+implementation
+
+uses
+ SysUtils, Math;
+
+resourcestring
+ SAreYouSureYouWantToDelete = 'Are you sure you want to delete %s?';
+ SAnd = ' and ';
+ SThisWillClearTheEntireImageList = 'This will clear the entire image list. Are you sure you want to do this?';
+ SIsNotAValidColorValue = '"%s" is not a valid color value';
+
+{$R *.dfm}
+
+//For calculating OfficeXP colors
+const
+ WeightR: single = 0.764706;
+ WeightG: single = 1.52941;
+ WeightB: single = 0.254902;
+
+const
+ SIncorrectSize =
+ 'The selected PNG "%s" must be %dx%d in size, while its actual size is %dx%d';
+
+var
+ ResX, ResY: Integer;
+
+ { Globals }
+
+function Blend(C1, C2: TColor; W1: Integer): TColor;
+var
+ W2, A1, A2, D, F, G: Integer;
+begin
+ if C1 < 0 then
+ C1 := GetSysColor(C1 and $FF);
+ if C2 < 0 then
+ C2 := GetSysColor(C2 and $FF);
+
+ if W1 >= 100 then
+ D := 1000
+ else
+ D := 100;
+
+ W2 := D - W1;
+ F := D div 2;
+
+ A2 := C2 shr 16 * W2;
+ A1 := C1 shr 16 * W1;
+ G := (A1 + A2 + F) div D and $FF;
+ Result := G shl 16;
+
+ A2 := (C2 shr 8 and $FF) * W2;
+ A1 := (C1 shr 8 and $FF) * W1;
+ G := (A1 + A2 + F) div D and $FF;
+ Result := Result or G shl 8;
+
+ A2 := (C2 and $FF) * W2;
+ A1 := (C1 and $FF) * W1;
+ G := (A1 + A2 + F) div D and $FF;
+ Result := Result or G;
+end;
+
+function ColorDistance(C1, C2: Integer): Single;
+var
+ DR, DG, DB: Integer;
+begin
+ DR := (C1 and $FF) - (C2 and $FF);
+ Result := Sqr(DR * WeightR);
+ DG := (C1 shr 8 and $FF) - (C2 shr 8 and $FF);
+ Result := Result + Sqr(DG * WeightG);
+ DB := (C1 shr 16) - (C2 shr 16);
+ Result := Result + Sqr(DB * WeightB);
+ Result := Sqrt(Result);
+end;
+
+function GetAdjustedThreshold(BkgndIntensity, Threshold: Single): Single;
+begin
+ if BkgndIntensity < 220 then
+ Result := (2 - BkgndIntensity / 220) * Threshold
+ else
+ Result := Threshold;
+end;
+
+function IsContrastEnough(AColor, ABkgndColor: Integer; DoAdjustThreshold: Boolean; Threshold: Single): Boolean;
+begin
+ if DoAdjustThreshold then
+ Threshold := GetAdjustedThreshold(ColorDistance(ABkgndColor, $000000),
+ Threshold);
+ Result := ColorDistance(ABkgndColor, AColor) > Threshold;
+end;
+
+procedure AdjustContrast(var AColor: Integer; ABkgndColor: Integer; Threshold: Single);
+var
+ X, Y, Z: Single;
+ R, G, B: Single;
+ RR, GG, BB: Integer;
+ I1, I2, S, Q, W: Single;
+ DoInvert: Boolean;
+begin
+ I1 := ColorDistance(AColor, $000000);
+ I2 := ColorDistance(ABkgndColor, $000000);
+ Threshold := GetAdjustedThreshold(I2, Threshold);
+
+ if I1 > I2 then
+ DoInvert := I2 < 442 - Threshold
+ else
+ DoInvert := I2 < Threshold;
+
+ X := (ABkgndColor and $FF) * WeightR;
+ Y := (ABkgndColor shr 8 and $FF) * WeightG;
+ Z := (ABkgndColor shr 16) * WeightB;
+
+ R := (AColor and $FF) * WeightR;
+ G := (AColor shr 8 and $FF) * WeightG;
+ B := (AColor shr 16) * WeightB;
+
+ if DoInvert then begin
+ R := 195 - R;
+ G := 390 - G;
+ B := 65 - B;
+ X := 195 - X;
+ Y := 390 - Y;
+ Z := 65 - Z;
+ end;
+
+ S := Sqrt(Sqr(B) + Sqr(G) + Sqr(R));
+ if S < 0.01 then
+ S := 0.01;
+
+ Q := (R * X + G * Y + B * Z) / S;
+
+ X := Q / S * R - X;
+ Y := Q / S * G - Y;
+ Z := Q / S * B - Z;
+
+ W := Sqrt(Sqr(Threshold) - Sqr(X) - Sqr(Y) - Sqr(Z));
+
+ R := (Q - W) * R / S;
+ G := (Q - W) * G / S;
+ B := (Q - W) * B / S;
+
+ if DoInvert then begin
+ R := 195 - R;
+ G := 390 - G;
+ B := 65 - B;
+ end;
+
+ if R < 0 then
+ R := 0
+ else if R > 195 then
+ R := 195;
+ if G < 0 then
+ G := 0
+ else if G > 390 then
+ G := 390;
+ if B < 0 then
+ B := 0
+ else if B > 65 then
+ B := 65;
+
+ RR := Trunc(R * (1 / WeightR) + 0.5);
+ GG := Trunc(G * (1 / WeightG) + 0.5);
+ BB := Trunc(B * (1 / WeightB) + 0.5);
+
+ if RR > $FF then
+ RR := $FF
+ else if RR < 0 then
+ RR := 0;
+ if GG > $FF then
+ GG := $FF
+ else if GG < 0 then
+ GG := 0;
+ if BB > $FF then
+ BB := $FF
+ else if BB < 0 then
+ BB := 0;
+
+ AColor := (BB and $FF) shl 16 or (GG and $FF) shl 8 or (RR and $FF);
+end;
+
+procedure SetContrast(var Color: TColor; BkgndColor: TColor; Threshold: Integer);
+var
+ T: Single;
+begin
+ if Color < 0 then
+ Color := GetSysColor(Color and $FF);
+ if BkgndColor < 0 then
+ BkgndColor := GetSysColor(BkgndColor and $FF);
+ T := Threshold;
+ if not IsContrastEnough(Color, BkgndColor, True, T) then
+ AdjustContrast(Integer(Color), BkgndColor, T);
+end;
+
+function ResizeProportionalX(InitialValue: Integer): Integer;
+begin
+ Result := InitialValue * ResX div 96;
+end;
+
+function ResizeProportionalY(InitialValue: Integer): Integer;
+begin
+ Result := InitialValue * ResY div 96;
+end;
+
+procedure InitResolution;
+var
+ DC: HDC;
+begin
+ DC := GetDC(0);
+ ResX := GetDeviceCaps(DC, LOGPIXELSX);
+ ResY := GetDeviceCaps(DC, LOGPIXELSY);
+ ReleaseDC(0, DC);
+end;
+
+{ TPngImageListEditorDlg }
+
+function TPngImageListEditorDlg.ConformDimensions(Png: TPngImage): Boolean;
+begin
+ //Returns whether an image conforms the specified dimensions, if available
+ Result := ((ImageHeight = 0) and (ImageWidth = 0)) or ((ImageHeight =
+ Png.Height) and (ImageWidth = Png.Width));
+end;
+
+function TPngImageListEditorDlg.FirstSelected: Integer;
+begin
+ //Return the first selected image
+ Result := 0;
+ while not lbxImages.Selected[Result] and (Result < lbxImages.Items.Count) do
+ Inc(Result);
+end;
+
+function TPngImageListEditorDlg.LastSelected: Integer;
+begin
+ //Return the last selected image
+ Result := lbxImages.Items.Count - 1;
+ while not lbxImages.Selected[Result] and (Result >= 0) do
+ Dec(Result);
+end;
+
+procedure TPngImageListEditorDlg.DrawBackground(Canvas: TCanvas; const ARect: TRect;
+ ScrollPos, Index: Integer; BlendColor: TColor; IgnoreScrollPos: Boolean);
+var
+ I, X, Y: Integer;
+ PatBitmap, BkBitmap: TBitmap;
+ Even: Boolean;
+begin
+ //Draw the background of the listbox, if any
+ if Index = 0 then begin
+ //No background, then skip the hard part
+ if BlendColor = clNone then
+ Canvas.Brush.Color := clWindow
+ else
+ Canvas.Brush.Color := BlendColor;
+ Canvas.FillRect(ARect);
+ Exit;
+ end;
+
+ //Draw the background
+ BkBitmap := TBitmap.Create;
+ PatBitmap := TBitmap.Create;
+ try
+ PatBitmap.Height := 16;
+ PatBitmap.Width := 16;
+ with PatBitmap.Canvas do begin
+ //First, draw the background for the pattern bitmap
+ if BlendColor = clNone then begin
+ Brush.Color := clWindow;
+ FillRect(Rect(0, 0, PatBitmap.Height, PatBitmap.Width));
+ Brush.Color := Blend(clWindow, clBtnFace, 50);
+ end
+ else begin
+ Brush.Color := Blend(clWindow, BlendColor, 50);
+ FillRect(Rect(0, 0, PatBitmap.Height, PatBitmap.Width));
+ Brush.Color := BlendColor;
+ end;
+
+ //Then, draw the foreground on the pattern bitmap
+ Pen.Color := Brush.Color;
+ case Index of
+ 1: begin
+ //Checkerboard background
+ FillRect(Rect(PatBitmap.Width div 2, 0, PatBitmap.Width, PatBitmap.Height div 2));
+ FillRect(Rect(0, PatBitmap.Height div 2, PatBitmap.Width div 2, PatBitmap.Height));
+ end;
+ 2: begin
+ //Diamonds background
+ PatBitmap.Width := 10;
+ PatBitmap.Height := 10;
+ Polygon([Point(PatBitmap.Width div 2, 0), Point(PatBitmap.Width,
+ PatBitmap.Height div 2), Point(PatBitmap.Width div 2,
+ PatBitmap.Height), Point(0, PatBitmap.Height div 2)]);
+ end;
+ 3: begin
+ //Slashed background
+ Even := True;
+ I := 2;
+ while I < PatBitmap.Width + PatBitmap.Height do begin
+ if I < PatBitmap.Width then begin
+ MoveTo(I, 0);
+ LineTo(-1, I + 1);
+ end
+ else begin
+ MoveTo(PatBitmap.Width, I - PatBitmap.Width);
+ LineTo(I - PatBitmap.Width, PatBitmap.Height);
+ end;
+ if Even then
+ Inc(I, 1)
+ else
+ Inc(I, 3);
+ Even := not Even;
+ end;
+ end;
+ 4: begin
+ //Backslashed background
+ Even := True;
+ I := 2;
+ while I < PatBitmap.Width + PatBitmap.Height do begin
+ if I < PatBitmap.Width then begin
+ MoveTo(I, 0);
+ LineTo(PatBitmap.Width, PatBitmap.Height - I);
+ end
+ else begin
+ MoveTo(0, I - PatBitmap.Width - 1);
+ LineTo(PatBitmap.Width - (I - PatBitmap.Width) + 1,
+ PatBitmap.Height);
+ end;
+ if Even then
+ Inc(I, 1)
+ else
+ Inc(I, 3);
+ Even := not Even;
+ end;
+ end;
+ end;
+ end;
+
+ //The actual background bitmap, its width and height are increased to compensate
+ //for scrolling distance
+ BkBitmap.Width := ARect.Left mod PatBitmap.Width + ARect.Right - ARect.Left;
+ if IgnoreScrollPos then
+ ScrollPos := 0
+ else
+ ScrollPos := (ARect.Top + ScrollPos) mod PatBitmap.Height;
+ BkBitmap.Height := ScrollPos + ARect.Bottom - ARect.Top;
+
+ //Now repeat the pattern bitmap onto the background bitmap
+ with BkBitmap.Canvas do begin
+ Y := 0;
+ while Y < BkBitmap.Height do begin
+ X := 0;
+ while X < BkBitmap.Width do begin
+ Draw(X, Y, PatBitmap);
+ Inc(X, PatBitmap.Width);
+ end;
+ Inc(Y, PatBitmap.Height);
+ end;
+ end;
+
+ //And finally, draw the background bitmap to the canvas
+ BitBlt(Canvas.Handle, ARect.Left, ARect.Top, ARect.Right - ARect.Left,
+ ARect.Bottom - ARect.Top, BkBitmap.Canvas.Handle, ARect.Left mod
+ PatBitmap.Width, ScrollPos, SRCCOPY);
+ finally
+ BkBitmap.Free;
+ PatBitmap.Free;
+ end;
+end;
+
+//Method for getting color values
+
+procedure TPngImageListEditorDlg.GetColorProc(const S: string);
+begin
+ cmbBackgroundColor.Items.Add(S);
+end;
+
+//Parse a background color name or code
+
+procedure TPngImageListEditorDlg.ParseBackgroundColor(Sender: TObject; CanDisplayError, CanChangeText: Boolean);
+var
+ S: string;
+ I, ParsedColor: Integer;
+begin
+ with cmbBackgroundColor do begin
+ //First, see if its a known color name
+ if IdentToColor(Text, ParsedColor) then begin
+ ItemIndex := Items.IndexOf(Text);
+ pnlBackgroundColor.Color := ParsedColor;
+ end
+ else begin
+ S := Text;
+ //Replace # with $ so StringToColor recognizes it
+ if (Length(S) > 0) and (S[1] = '#') then
+ S[1] := '$';
+ try
+ //Try to convert to a real color value
+ ParsedColor := StringToColor(S);
+ if CanChangeText then begin
+ //And try to convert back to an identifier (i.e. if you type in $000000, it'll become clBlack)
+ if ColorToIdent(ParsedColor, S) then
+ ItemIndex := Items.IndexOf(S)
+ else
+ Text := S;
+ end;
+ pnlBackgroundColor.Color := ParsedColor;
+ except
+ //If it fails, display a message if neccesary
+ on EConvertError do
+ if CanDisplayError then begin
+ MessageBox(Self.Handle,
+ PChar(Format(SIsNotAValidColorValue, [Text])),
+ PChar(Self.Caption), MB_ICONERROR or MB_OK);
+ SetFocus;
+ end;
+ end;
+ end;
+ end;
+ //And finally, set the background color to every selected image
+ if (Sender <> lbxImages) then
+ for I := 0 to lbxImages.Items.Count - 1 do
+ if lbxImages.Selected[I] then
+ Images.Items[I].Background := pnlBackgroundColor.Color;
+end;
+
+procedure TPngImageListEditorDlg.SelectBackgroundColor(Sender: TObject; Color: TColor);
+var
+ S: string;
+begin
+ //This happens after a background color has been slected from the color dialog
+ //Try to convert a color into an identifier, or else into a hexadecimal representation
+ if ColorToIdent(Color, S) then
+ cmbBackgroundColor.ItemIndex := cmbBackgroundColor.Items.IndexOf(S)
+ else
+ cmbBackgroundColor.Text := '$' + IntToHex(dlgColor.Color, 6);
+ ParseBackgroundColor(Sender, False, True);
+end;
+
+procedure TPngImageListEditorDlg.btnAddClick(Sender: TObject);
+var
+ Png: TPngImageCollectionItem;
+ I, Selected, FirstSelected: Integer;
+begin
+ //The Add button is pressed, let the programmer look for an image
+ dlgOpenPicture.Options := dlgOpenPicture.Options + [ofAllowMultiSelect];
+ if dlgOpenPicture.Execute then begin
+ for I := 0 to lbxImages.Items.Count - 1 do
+ lbxImages.Selected[I] := False;
+ FirstSelected := -1;
+ for I := 0 to dlgOpenPicture.Files.Count - 1 do begin
+ Png := Images.Items.Add;
+ with Png.PngImage do begin
+ //Load the image, but remove any gamma, so that the gamma won't be reapplied
+ //when loading the image from the DFM
+ LoadFromFile(dlgOpenPicture.Files[I]);
+ if Png.PngImage.Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA,
+ COLOR_PALETTE] then
+ Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
+ end;
+ //Does the image conform the specified dimensions, if any?
+ if ConformDimensions(Png.PngImage) then begin
+ //Update maximum image width
+ if FMaxWidth < Png.PngImage.Width then
+ FMaxWidth := Png.PngImage.Width;
+
+ //Invent a name for the image, and initialize its background color
+ if chkUseFilenames.Checked then
+ Png.Name := ChangeFileExt(ExtractFileName(dlgOpenPicture.Files[I]), '')
+ else
+ Png.Name := 'PngImage' + IntToStr(Images.Items.Count - 1); // do not localize
+ Png.Background := clWindow;
+
+ //Finally, add it and select it
+ Selected := lbxImages.Items.AddObject(Png.Name, Png);
+ lbxImages.Selected[Selected] := True;
+ if FirstSelected = -1 then
+ FirstSelected := Selected;
+ end
+ else begin
+ //The image does not conform the specified dimensions
+ MessageBox(Handle, PChar(Format(SIncorrectSize,
+ [ExtractFilename(dlgOpenPicture.Files[I]), ImageWidth, ImageHeight,
+ Png.PngImage.Width, Png.PngImage.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
+ Images.Items.Delete(Png.Index);
+ end;
+ end;
+
+ //Focus the first selected (added) image
+ lbxImages.ItemIndex := FirstSelected;
+ lbxImages.SetFocus;
+ lbxImagesClick(nil);
+ end;
+end;
+
+procedure TPngImageListEditorDlg.btnClearClick(Sender: TObject);
+begin
+ //Clear the listbox and the collection
+ if (lbxImages.Items.Count > 0) and (MessageBox(Handle,
+ PChar(SThisWillClearTheEntireImageList),
+ PChar(Self.Caption), MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2) =
+ IDYES) then begin
+ lbxImages.Items.Clear;
+ Images.Items.Clear;
+ lbxImagesClick(nil);
+ end;
+end;
+
+procedure TPngImageListEditorDlg.btnDeleteClick(Sender: TObject);
+
+ function GetCommaList: string;
+ var
+ I: Integer;
+ S: TStringList;
+ begin
+ //Get a comma list of the names of the selected images in the form "name1,
+ //name2 and name3"
+ Result := '';
+ S := TStringList.Create;
+ try
+ for I := 0 to lbxImages.Items.Count - 1 do
+ if lbxImages.Selected[I] then
+ S.Add(Images.Items[I].Name);
+ for I := 0 to S.Count - 1 do begin
+ Result := Result + S[I];
+ if I < S.Count - 2 then
+ Result := Result + ', '
+ else if I < S.Count - 1 then
+ Result := Result + SAnd;
+ end;
+ finally
+ S.Free;
+ end;
+ end;
+
+var
+ I, NewIndex: Integer;
+begin
+ with lbxImages do
+ if (SelCount > 0) and (MessageBox(Handle,
+ PChar(Format(SAreYouSureYouWantToDelete, [GetCommaList])),
+ PChar(Self.Caption), MB_ICONEXCLAMATION or MB_YESNO) = IDYES) then begin
+ //Delete every selected image from the listbox and from the collection
+ NewIndex := -1;
+ I := 0;
+ while I < Items.Count do
+ if Selected[I] then begin
+ if NewIndex = -1 then
+ NewIndex := I;
+ lbxImages.Items.Delete(I);
+ Images.Items.Delete(I);
+ end
+ else
+ Inc(I);
+
+ //Figure out the new selection index
+ if NewIndex > Items.Count - 1 then
+ NewIndex := Items.Count - 1
+ else if (NewIndex = -1) and (Items.Count > 0) then
+ NewIndex := 0;
+ Selected[NewIndex] := True;
+ ItemIndex := NewIndex;
+ lbxImagesClick(nil);
+ end;
+end;
+
+procedure TPngImageListEditorDlg.btnDownClick(Sender: TObject);
+var
+ I: Integer;
+begin
+ //Move the selected items one position down
+ with lbxImages do
+ if (SelCount > 0) and (LastSelected < Items.Count - 1) then
+ for I := Items.Count - 1 downto 0 do
+ if Selected[I] then begin
+ Images.Items[I].Index := I + 1;
+ Items.Exchange(I, I + 1);
+ Selected[I + 1] := True;
+ end;
+ lbxImagesClick(nil);
+end;
+
+procedure TPngImageListEditorDlg.btnReplaceClick(Sender: TObject);
+var
+ Item: TPngImageCollectionItem;
+ Index: Integer;
+ Png: TPngImage;
+begin
+ //The Replace button is pressed, let the programmer look for an image
+ Index := FirstSelected;
+ Item := Images.Items[Index];
+ dlgOpenPicture.FileName := Item.Name;
+ dlgOpenPicture.Options := dlgOpenPicture.Options - [ofAllowMultiSelect];
+ with lbxImages do
+ if (SelCount = 1) and dlgOpenPicture.Execute then begin
+ Png := TPngImage.Create;
+ try
+ //First see if the image conforms the specified dimensions
+ Png.LoadFromFile(dlgOpenPicture.Filename);
+ if ConformDimensions(Png) then begin
+ //Then remove any gamma, so that the gamma won't be reapplied when loading the
+ //image from the DFM
+ if Png.Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA] then
+ Png.Chunks.RemoveChunk(Png.Chunks.ItemFromClass(TChunkgAMA));
+ Item.PngImage := Png;
+
+ //Update the maximum image width
+ if FMaxWidth < Item.PngImage.Width then
+ FMaxWidth := Item.PngImage.Width;
+
+ //Repaint and update everything, to be sure
+ lbxImages.Repaint;
+ lbxImagesClick(nil);
+ end
+ else
+ MessageBox(Handle, PChar(Format(SIncorrectSize,
+ [ExtractFilename(dlgOpenPicture.Filename), ImageWidth, ImageHeight,
+ Png.Width, Png.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
+ finally
+ Png.Free;
+ end;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.btnUpClick(Sender: TObject);
+var
+ I: Integer;
+begin
+ //Move the selected items one position up
+ with lbxImages do
+ if (SelCount > 0) and (FirstSelected > 0) then
+ for I := 0 to Items.Count - 1 do
+ if Selected[I] then begin
+ Images.Items[I].Index := I - 1;
+ Items.Exchange(I, I - 1);
+ Selected[I - 1] := True;
+ end;
+ lbxImagesClick(nil);
+end;
+
+procedure TPngImageListEditorDlg.cmbBackgroundColorChange(Sender: TObject);
+begin
+ //While typing, try parsing the background color, but without any error messages
+ ParseBackgroundColor(Sender, False, False);
+end;
+
+procedure TPngImageListEditorDlg.cmbBackgroundColorDblClick(Sender: TObject);
+begin
+ //Just like in Delphi, when doubleclicking a color, the color dialog pops up
+ dlgColor.Color := pnlBackgroundColor.Color;
+ if dlgColor.Execute then
+ SelectBackgroundColor(Sender, dlgColor.Color);
+end;
+
+procedure TPngImageListEditorDlg.cmbBackgroundColorExit(Sender: TObject);
+begin
+ //When leaving the background combobox, parse the color, but this with error
+ //message, if neccesary
+ ParseBackgroundColor(Sender, True, True);
+end;
+
+procedure TPngImageListEditorDlg.cmbPreviewBackgroundChange(Sender: TObject);
+begin
+ //Pewview background is changes, repaint all items
+ lbxImages.Repaint;
+end;
+
+procedure TPngImageListEditorDlg.cmbPreviewBackgroundDrawItem(Control: TWinControl;
+ Index: Integer; ARect: TRect; State: TOwnerDrawState);
+var
+ IconWidth: Integer;
+begin
+ with cmbPreviewBackground do begin
+ //Draw the background "icon" of the preview background combobox
+ IconWidth := (ARect.Bottom - ARect.Top) * 4 div 3;
+ DrawBackground(Canvas, Rect(ARect.Left, ARect.Top, ARect.Left + IconWidth, ARect.Bottom),
+ 0, Index, clNone, True);
+ Inc(ARect.Left, IconWidth);
+
+ //Background color of the rest of the item
+ if odSelected in State then
+ Canvas.Brush.Color := clHighlight
+ else
+ Canvas.Brush.Color := clWindow;
+ Canvas.FillRect(ARect);
+ Inc(ARect.Left, 4);
+
+ //And the text
+ DrawText(Canvas.Handle, PChar(Items[Index]), -1, ARect, DT_LEFT or DT_NOPREFIX
+ or DT_SINGLELINE or DT_VCENTER);
+
+ Canvas.Brush.Color := clWindow;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.edtNameChange(Sender: TObject);
+begin
+ //Update the selected image with the entered name, in realtime
+ with lbxImages do
+ if ItemIndex >= 0 then begin
+ Images.Items[ItemIndex].Name := edtName.Text;
+ Items[ItemIndex] := edtName.Text;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+end;
+
+procedure TPngImageListEditorDlg.FormCreate(Sender: TObject);
+var
+ Space8H: Integer;
+begin
+ //Initialize OfficeXP colors for selection
+ FSelectionBodyColor := Blend(clHighlight, clWindow, 30);
+ SetContrast(FSelectionBodyColor, Blend(clWindow, clBtnFace, 165), 50);
+ FSelectionBorderColor := clHighlight;
+
+ //Initialize a value that keeps track of dragging
+ FDraggingIndex := -1;
+
+ //Get all available color names
+ GetColorValues(GetColorProc);
+
+ //Initialize the background to clWindow
+ cmbBackgroundColor.ItemIndex := cmbBackgroundColor.Items.IndexOf('clWindow'); // do not localize
+ cmbBackgroundColorChange(nil);
+
+ //Do not specify image width and height by default (the imagelist will fill
+ //these up, so that you cannot select an image other than these dimensions)
+ ImageWidth := 0;
+ ImageHeight := 0;
+
+ //Resize everything to make it fit on "large fonts" setting. Note that these
+ //operations are also needed on normal setting.
+ Space8H := lbxImages.Top;
+ Width := ResizeProportionalX(Width);
+ Height := ResizeProportionalY(Height);
+ Constraints.MinHeight := gbxProperties.Top + cmbBackgroundColor.Top +
+ cmbBackgroundColor.Height + Space8H + Space8H + gbxImageInfo.Height + Space8H
+ + (Height - pnlMain.Height);
+ Constraints.MinWidth := Width;
+ pnlButtons.Align := alBottom;
+ pnlMain.Align := alClient;
+ cmbPreviewBackground.ItemHeight :=
+ ResizeProportionalY(cmbPreviewBackground.ItemHeight);
+ pnlBackgroundColor.Height := cmbBackgroundColor.Height;
+
+ //Make sure the background color isn't reset when themes are enabled
+ pnlBackgroundColor.ParentBackground := True;
+ pnlBackgroundColor.ParentBackground := False;
+end;
+
+procedure TPngImageListEditorDlg.FormResize(Sender: TObject);
+begin
+ //There appears to be a bug that prevents a listbox from being redrawn correctly
+ //when the form is resized
+ lbxImages.Repaint;
+end;
+
+procedure TPngImageListEditorDlg.FormShow(Sender: TObject);
+var
+ I: Integer;
+begin
+ //Initialize the maximum width of the images, to align text in the listbox
+ FMaxWidth := 0;
+ for I := 0 to Images.Items.Count - 1 do
+ if Images.Items[I].PngImage.Width > FMaxWidth then
+ FMaxWidth := Images.Items[I].PngImage.Width;
+
+ //Fill the listbox with the images
+ for I := 0 to Images.Items.Count - 1 do
+ lbxImages.Items.AddObject(Images.Items[I].Name, Images.Items[I]);
+ if lbxImages.Items.Count > 0 then begin
+ lbxImages.Selected[0] := True;
+ lbxImages.ItemIndex := 0;
+ end;
+ lbxImages.SetFocus;
+ lbxImagesClick(nil);
+
+ cmbPreviewBackground.ItemIndex := 0;
+ FormResize(nil);
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesClick(Sender: TObject);
+
+ function GetDimensions(Png: TPngImage): string;
+ begin
+ //Return the formatted dimensions of an image
+ Result := Format('%dx%d', [Png.Width, Png.Height]);
+ if Png.InterlaceMethod <> imNone then
+ Result := Result + ' interlace';
+ end;
+
+ function GetColorDepth(Png: TPngImage): string;
+ begin
+ //Return the color depth, including whether the image is grayscale or paletted
+ case Png.Header.ColorType of
+ COLOR_GRAYSCALE, COLOR_GRAYSCALEALPHA:
+ Result := Format('%d-bits grayscale', [Png.Header.BitDepth]);
+ COLOR_RGB, COLOR_RGBALPHA:
+ Result := Format('%d-bits', [Png.Header.BitDepth * 3]);
+ COLOR_PALETTE:
+ Result := Format('%d-bits paletted', [Png.Header.BitDepth]);
+ end;
+ end;
+
+ function GetTransparency(Png: TPngImage): string;
+ begin
+ //Return the formatted transparency depth, or transparency mode
+ if Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then
+ Result := Format('%d-bits alpha', [Png.Header.BitDepth])
+ else
+ case Png.TransparencyMode of
+ ptmBit: Result := 'bitmask';
+ ptmPartial: Result := 'indexed';
+ else
+ Result := 'none';
+ end;
+ end;
+
+ function GetCompression(Png: TPngImage): string;
+ begin
+ //Return the formatted compression level
+ Result := Format('level %d', [Png.CompressionLevel]);
+ end;
+
+ function GetFiltering(Png: TPngImage): string;
+ begin
+ //Return the formatted filtering method
+ case Png.Header.FilterMethod of
+ FILTER_SUB: Result := 'sub';
+ FILTER_UP: Result := 'up';
+ FILTER_AVERAGE: Result := 'average';
+ FILTER_PAETH: Result := 'paeth';
+ else
+ Result := 'none';
+ end;
+ end;
+
+ function SameBackgroundColor: Boolean;
+ var
+ FirstBgColor: TColor;
+ I: Integer;
+ First: Boolean;
+ begin
+ //Determine whether the background color of all selected images is the same
+ FirstBgColor := clNone;
+ First := True;
+ Result := True;
+ for I := 0 to lbxImages.Items.Count - 1 do
+ if lbxImages.Selected[I] then
+ if First then begin
+ //Found the first selected and its background color
+ FirstBgColor := Images.Items[I].Background;
+ First := False;
+ end
+ else begin
+ //If not equal to first background color, then break, continue otherwise
+ Result := FirstBgColor = Images.Items[I].Background;
+ if not Result then
+ Break;
+ end;
+ end;
+
+const
+ NoneSelected = '[ none ]';
+ MultipleSelected = '[ multiple ]';
+begin
+ with lbxImages do begin
+ //Refresh the enabled state of the buttons and controls
+ btnReplace.Enabled := SelCount = 1;
+ btnDelete.Enabled := SelCount > 0;
+ btnClear.Enabled := Items.Count > 0;
+ btnUp.Enabled := (SelCount > 0) and (FirstSelected > 0);
+ btnDown.Enabled := (SelCount > 0) and (LastSelected < Items.Count - 1);
+ lblName.Enabled := SelCount = 1;
+ edtName.Enabled := SelCount = 1;
+ lblBackgroundColor.Enabled := SelCount > 0;
+ cmbBackgroundColor.Enabled := SelCount > 0;
+ case SelCount of
+ 0: begin
+ //None is selected, so no information to display
+ lblDimensionsValue.Caption := NoneSelected;
+ lblColorDepthValue.Caption := NoneSelected;
+ lblTransparencyValue.Caption := NoneSelected;
+ lblCompressionValue.Caption := NoneSelected;
+ lblFilteringValue.Caption := NoneSelected;
+ end;
+ 1: with Images.Items[FirstSelected] do begin
+ edtName.OnChange := nil;
+ try
+ //One item is selected, display its properties and information
+ edtName.Text := Name;
+ SelectBackgroundColor(Sender, Background);
+ lblDimensionsValue.Caption := GetDimensions(PngImage);
+ lblColorDepthValue.Caption := GetColorDepth(PngImage);
+ lblTransparencyValue.Caption := GetTransparency(PngImage);
+ lblCompressionValue.Caption := GetCompression(PngImage);
+ lblFilteringValue.Caption := GetFiltering(PngImage);
+ finally
+ edtName.OnChange := edtNameChange;
+ end;
+ end;
+ else begin
+ //More than 1 is selected, so no image information can be displayed
+ if SameBackgroundColor then
+ SelectBackgroundColor(Sender, Images.Items[FirstSelected].Background)
+ else
+ SelectBackgroundColor(Sender, clNone);
+ lblDimensionsValue.Caption := MultipleSelected;
+ lblColorDepthValue.Caption := MultipleSelected;
+ lblTransparencyValue.Caption := MultipleSelected;
+ lblCompressionValue.Caption := MultipleSelected;
+ lblFilteringValue.Caption := MultipleSelected;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesDblClick(Sender: TObject);
+begin
+ //Doubleclicking is the same as the Replace button
+ if lbxImages.SelCount = 1 then
+ btnReplaceClick(nil);
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesDragOver(Sender, Source: TObject;
+ X, Y: Integer; State: TDragState; var Accept: Boolean);
+
+ procedure MoveItem(Index, Delta: Integer);
+ begin
+ //Move a single item up or down, depending on Delta
+ if lbxImages.Selected[Index] then begin
+ Images.Items[Index].Index := Index + Delta;
+ lbxImages.Items.Exchange(Index, Index + Delta);
+ lbxImages.Selected[Index + Delta] := True;
+ end;
+ end;
+
+ function InRange(Index: Integer): Boolean;
+ begin
+ //Return whether Index exists in the listbox
+ Result := (Index >= 0) and (Index < lbxImages.Items.Count);
+ end;
+
+var
+ NewIndex, NewItemIndex, Delta, I: Integer;
+begin
+ Accept := FDraggingIndex >= 0;
+ if Accept then begin
+ //Figure out to which index is dragged
+ NewIndex := lbxImages.ItemAtPos(Point(X, Y), False);
+ if NewIndex > lbxImages.Items.Count - 1 then
+ NewIndex := lbxImages.Items.Count - 1;
+
+ //Figure out the distance (delta) of the drag
+ Delta := NewIndex - FDraggingIndex;
+
+ //The destination index has to exist and has to be differend from where we
+ //started the drag. On to pof that, the drag destination of the first and
+ //last selected items have to be in range.
+ if (NewIndex >= 0) and (NewIndex <> FDraggingIndex) and InRange(FirstSelected
+ + Delta) and InRange(LastSelected + Delta) then begin
+ //Calc the new focus index
+ NewItemIndex := lbxImages.ItemIndex + Delta;
+
+ //To prevent things to get messed up, moving downwards needs walking through the
+ //images in opposite direction
+ if Delta < 0 then
+ for I := 0 to lbxImages.Items.Count - 1 do
+ MoveItem(I, Delta)
+ else
+ for I := lbxImages.Items.Count - 1 downto 0 do
+ MoveItem(I, Delta);
+
+ //Set the new focus index and tracking value of the drag
+ lbxImages.ItemIndex := NewItemIndex;
+ FDraggingIndex := NewIndex;
+
+ lbxImagesClick(nil);
+ end;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
+var
+ DrawRect: TRect;
+ ScrollInfo: TScrollInfo;
+ I, ScrollPos: Integer;
+begin
+ //Get the scrolling distance
+ ScrollPos := 0;
+ ScrollInfo.cbSize := SizeOf(ScrollInfo);
+ ScrollInfo.fMask := SIF_POS;
+ if GetScrollInfo(lbxImages.Handle, SB_VERT, ScrollInfo) then
+ for I := 0 to ScrollInfo.nPos - 1 do
+ with lbxImages.ItemRect(I) do
+ Inc(ScrollPos, Bottom - Top);
+
+ //First, draw the background
+ if odSelected in State then
+ if lbxImages.Focused then
+ DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
+ cmbPreviewBackground.ItemIndex, FSelectionBodyColor)
+ else
+ DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
+ cmbPreviewBackground.ItemIndex, Blend(FSelectionBodyColor, clWindow, 50))
+ else
+ DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
+ cmbPreviewBackground.ItemIndex);
+ with lbxImages.Canvas do begin
+ //Then, draw a focus border, if focused
+ Brush.Style := bsClear;
+ if odFocused in State then begin
+ if lbxImages.Focused then
+ Pen.Color := FSelectionBorderColor
+ else
+ Pen.Color := Blend(FSelectionBorderColor, clWindow, 50);
+ Pen.Style := psSolid;
+ Rectangle(ARect);
+ end;
+
+ //Draw the image at the center of (ARect.Left, ARect.Top, ARect.Left + FMaxWidth, ARect.Bottom)
+ with Images.Items[Index] do begin
+ DrawRect.Left := ARect.Left + (FMaxWidth - PngImage.Width) div 2 + 2;
+ DrawRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - PngImage.Height) div 2;
+ DrawRect.Right := DrawRect.Left + PngImage.Width;
+ DrawRect.Bottom := DrawRect.Top + PngImage.Height;
+ PngImage.Draw(lbxImages.Canvas, DrawRect);
+ end;
+
+ //Draw the image index number and the name
+ Font.Color := clWindowText;
+ DrawRect := Rect(ARect.Left + FMaxWidth + 8, ARect.Top, ARect.Left +
+ FMaxWidth + Canvas.TextWidth(IntToStr(lbxImages.Items.Count - 1)) + 8,
+ ARect.Bottom);
+ DrawText(Handle, PChar(IntToStr(Index)), -1, DrawRect, DT_RIGHT or
+ DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);
+ DrawRect.Left := DrawRect.Right;
+ DrawRect.Right := ARect.Right;
+ DrawText(Handle, PChar(' - ' + Images.Items[Index].Name), -1, DrawRect,
+ DT_END_ELLIPSIS or DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);
+
+ //Draw the normal focusrect, so that it'll become invisible
+ if (odFocused in State) and lbxImages.Focused then
+ DrawFocusRect(ARect);
+ end;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesEnter(Sender: TObject);
+begin
+ //Just to be sure
+ lbxImages.Repaint;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesExit(Sender: TObject);
+begin
+ //Just to be sure
+ lbxImages.Repaint;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ //I would expect this "ctrl"-navigation would work standardly, but appearantly
+ //it doesn't, so we'll have to code it ourselves
+ with lbxImages do
+ if ssCtrl in Shift then begin
+ case Key of
+ VK_DOWN: begin
+ if ItemIndex < Items.Count - 1 then
+ ItemIndex := ItemIndex + 1;
+ Key := 0;
+ end;
+ VK_UP: begin
+ if ItemIndex > 0 then
+ ItemIndex := ItemIndex - 1;
+ Key := 0;
+ end;
+ VK_SPACE: begin
+ Selected[ItemIndex] := not Selected[ItemIndex];
+ lbxImagesClick(nil);
+ Key := 0;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
+var
+ Temp: Integer;
+begin
+ //Figure out the height of an item, when editing an image collection, the height
+ //of an image may differ
+ Height := Images.Items[Index].PngImage.Height + 4;
+ Temp := lbxImages.Canvas.TextHeight('0') + 4;
+ if Temp > Height then
+ Height := Temp;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+ //If the mouse button is released, the tracking value of the drag needs to be
+ //reset as well
+ FDraggingIndex := -1;
+end;
+
+procedure TPngImageListEditorDlg.lbxImagesStartDrag(Sender: TObject; var DragObject: TDragObject);
+var
+ Pos: TPoint;
+begin
+ //Figure out where this drag start is
+ GetCursorPos(Pos);
+ FDraggingIndex := lbxImages.ItemAtPos(lbxImages.ScreenToClient(Pos), True);
+ if FDraggingIndex >= 0 then
+ lbxImages.ItemIndex := FDraggingIndex;
+end;
+
+initialization
+ InitResolution;
+
+end.
+
diff --git a/official/1.2.0/Docs/Changelog.txt b/official/1.2.0/Docs/Changelog.txt
new file mode 100644
index 0000000..c046216
--- /dev/null
+++ b/official/1.2.0/Docs/Changelog.txt
@@ -0,0 +1,45 @@
+PngComponents 1.1:
+- Common: "adopted" the project from Martijn Saly
+- Common: added D2009 support (mostly changed PngObject to PngImage)
+- Common: removed compatibility with versions below Delphi 7
+- Common: removed references to Thany.Inc (use RTLVersion instead)
+- Common: cleaned up the code (mostly to use my formatting style)
+- Editor: added "use file name" in PngImageListEditor (sets the name of the image to it's filename)
+
+PngComponents 1.0 RC3:
+- Editor: Fixed "invalid header" exception when adding a PNG to the list.
+- Editor: Everything should now look good on "large fonts" setting.
+- PngBitBtn: Positioning and drawing of the glyph was sometimes a bit odd.
+- PngBitBtn: Removed the need to draw an empty TBitmap glyph, prior to drawing the PNG glyph.
+- PngSpeedButton: The image is now shifted down-right by 1 pixel, when the button is down but not pressed, to match the behavior of a normal SpeedButton.
+- PngImageList: Fixed range check errors in PngToIcon32.
+- PngImageList: Fixed possible AccessViolation in PngToIcon32.
+- PngImageList: Fixed AccessViolation in AddImages.
+- PngImageList: Fixed memory leak in CopyPngs.
+- PngImageList: Added BeginUpdate and EndUpdate methods, to temporarily prevent the internal imagelist from being updated.
+- PngImageList: The patched methods are more efficient, because they now manipulate the internal imagelist directly, rather than relying on CopyPngs.
+- PngImageList: Added calls to Change in the patched methods.
+
+PngComponents 1.0 RC2:
+- Editor: Fixed endless loop when repetitively removing the last image in a list of at least 3 (thanks to Aleksander Oven).
+- Editor: Fixed possible out-of-bounds error when moving an image down using the Down button (thanks to Spiril).
+- Editor: Now using Graphics.GetColorValues to retrieve available color identifiers (thanks to LJ and Ryan Mills).
+- Editor: Rewritten ParseBackgroundColor and SelectBackgroundColor to use IdentToColor, StringToColor and ColorToIdent from Gaphics unit (thanks to LJ and Ryan Mills).
+- Editor: It is now possible to set the background color to more than 1 selected image.
+- Editor: Minor GUI fixes
+- PngBitBtn: When Margin <> -1 and the button is focused, the image must be shifted 1 pixel, to match the behavior of a normal BitBtn.
+- PngBitBtn: Fixed EPngHeaderNotPresent when assigning a nil to the PngImage property.
+- PngBitBtn: PngImage property now behaves correctly when assigning an action. Note that the image will not be stored in the DFM if it came from a TActionList.ImageList (thanks to robvdl)
+- PngSpeedButton: The same fixes that apply to PngBitBtn, applied to PngSpeedButton.
+- PngImageList: Adding a default action to an imagelist no longer results in out of bounds errors (thanks to robvdl).
+- PngImageList: 14 methods that couldn't be overridden are now patched (thanks to Vladimir Bochkarev). However, adding a default action to an imagelist still doesn't call the "new" Add method, but supposedly the legacy ImageList_Add() function, which cannot be patched.
+- PngImageList: Fixed memory leak in CopyPngs (thanks to M. Youssfi).
+- Common: Added Amount parameter to MakeImageBlended and MakeImageGrayscale.
+- Common: Added function ConvertToPNG, which converts a TGraphic to a PNG object, if not already.
+- Common: Added functions CreatePNG and CreatePNGMasked, which create a new PNG object based on a bitmap and a (color or bitmap) mask.
+- Common: Added function CopyImageFromImageList, which effectively copies an image from a normal imagelist or a PngImageList into a PNG.
+- Common: Added function SlicePNG for future use. This slices a large PNG object into smaller, equally-sized ones.
+- Common: Added zlib version 1.2.2 to the PNG package (thanks to Vladimir Bochkarev).
+
+PngComponents 1.0 RC1:
+- Initial public release
\ No newline at end of file
diff --git a/official/1.2.0/Docs/License.txt b/official/1.2.0/Docs/License.txt
new file mode 100644
index 0000000..b279ad4
--- /dev/null
+++ b/official/1.2.0/Docs/License.txt
@@ -0,0 +1,73 @@
+END-USER LICENSE AGREEMENT
+
+All files included in this archive are Copyright (C) 2002-2005
Martijn Saly.
+Use and/or distribution of them requires acceptance of the following License
+Agreement.
+
+--------------------------------------------------------------------------------
+
+- "Author" herein refers to Martijn Saly (the creator of this package and
+ containing files and software).
+- "Software" herein refers to all files bearing this notice, as well as any
+ other files and source code included with this package (typically extracted
+ from a .zip or .cab archive), and all content in them, regardless of whether
+ any modifications have been made.
+- "Compile" herein refers to the automatic process of translating the Software's
+ source code into executable machine code by a compiler such as the one
+ included with Borland's Delphi or C++Builder.
+
+Except where otherwise noted, all of the documentation and Software included in
+the this package is copyrighted by Martijn Saly (the Author).
+
+Copyright (C) 2002-2005 Martijn Saly. All rights reserved.
+
+
+Use and distribution of the software is permitted provided that all of the
+following terms are accepted. Terms 5 through 8 apply only to distributions
+which include source code that one can Compile.
+
+1) The Software is provided "as-is," without any express or implied warranty. In
+ no event shall the Author be held liable for any damages arising from the use
+ or Compile of the Software.
+
+2) All redistributions of the Software's files must be in their original,
+ unmodified form. Distributions of modified versions of the files is not
+ permitted without express written permission of the Author.
+
+3) All redistributions of the Software's files must retain all copyright notices
+ and web site addresses that are currently in place, and must include this
+ list of conditions in its original, unmodified form.
+
+4) None of the Software's files may be redistributed for profit or as part of
+ another software package without express written permission of the Author.
+
+5) If applicable, you are permitted to Compile the Software, in orginal or
+ modified form, into any kind of application, including commercial or
+ shareware applications, or any application you are profiting from.
+
+6) If applicable, redistribution of any of the Software's files in object form
+ (including but not limited to .DCU and .OBJ formats) is strictly prohibited
+ without express written permission of the Author.
+
+7) If applicable, distribution of the Software in compiled package format
+ (the BPL file) is permitted, as long as the Software is distributed as part
+ of an application.
+
+8) If applicable, distribution of the Software in compiled package format
+ (the BPL file) is prohibed if the distribution does not specifically belong
+ to an application, written by the same author as the application was written
+ by.
+
+9) Full backward compatibility in future versions of the Software is not
+ guaranteed. In no event shall the Author be held liable for any inconvenience
+ or damages arising from lack of backward compatibility.
+
+If you do not agree to all of the above terms, you are not permitted to use or
+Compile the Software in any way, and all copies of it must be deleted from your
+system(s).
+
+----------------------------------------------------------------------------
+
+Martijn Saly
+martijn@thany.org
+http://www.thany.org/
\ No newline at end of file
diff --git a/official/1.2.0/Docs/PngComponents.html b/official/1.2.0/Docs/PngComponents.html
new file mode 100644
index 0000000..1e3922c
--- /dev/null
+++ b/official/1.2.0/Docs/PngComponents.html
@@ -0,0 +1,105 @@
+
+
+
+ PngComponents
+
+
+
+
+
PngComponents
+
This version: 1.0 RC2
+
+
What is PngComponents?
+
PngComponents is a set of components that allows you to include in your application real PNG files. PNG files on their own do not generate an enourmous advantage, but their support for an alpha-channel does indeed have quite a charm to it. The PngComponents library supports alpha-channels to their full extend, using a modified version of the excellent pngdelphi library.
+
+
+
+
+
+
+
+
Examples of PNG images with alpha-channels. Note that these don't work correctly in Internet Explorer (all versions up to 6).
+
+
+
PngComponents' main and most important component is the PngImageList. This is a descendant of the normal TImageList, with in addition full support for PNGs with an alpha-channel. This will enable you to keep using most components that take advantage of imagelists, while actually feeding them icons with alphablending capabilities. Two other very nice components are the PngSpeedButton and the PngBitBtn. These two buttons do not have a Glyph anymore, but in stead, they accept a PNG file to be assigned directly to the button, without the need for an imagelist (just like the normal SpeedButton and BitBtn). And since the PNG glyphs are drawn in realtime, there's no more hassling with WM_DISPLAYCHANGE when the user changes the clBtnFace color in his display settings...
+
Two other components included in the library are the PngImageCollection, which is simply a collection of PNG images. Nothing more, nothing less. The last one is the PngCheckListBox. This one accepts PNG glyphs for the check states. Beside that, it's a completely normal CheckListBox.
+
I've also added a "fix" for Alex Desinov's awesome addon for Jordan Russell's Toolbar2000, called TBX. This fix is a replacement for the OfficeXP theme. Just replace TBXOfficeXPTheme in your uses clause with PngTBXOfficeXPTheme and that's it! Beautiful alphablended icons become possible in the OfficeXP theme as well.
+
+
Why should I use PngComponents?
+
The PngComponents library offers a major leap forward in creating nice GUI's in designtime. Not only does it speed up the implementation of alphablended icons in your application, it eases the way you can use them throughout your software. No longer do you need to put them in a resource file manually and then manually drawing them on a temporary bitmap and assigning that to somewhere. Adding beautiful alphablended icons to your interface is but a few clicks away.
+
+
Usage
+
+
Common
+
The PngBitBtn and PngSpeedButton both have two extra properties, PngImage and PngOptions. PngImage substitutes the Glyph property with a PNG image, so only PNG files can be loaded into it. PngOptions determines what a disabled glyph looks like. You can choose from a combination of having it blended and having it grayscaled.
+
The PngImageList and PngImageCollection share the same editor. This editor can be used to load PNG files into the respective component. When editing a PngImageList, the editor will only allow PNG files that have the correct dimensions. When editing a PngImageCollection, any PNG can be added. Note that in either case, it doesn't matter if you mix color depths or other properties.
+
Note: the beta versions of PngComponents required that you use a PngImageCollection and assign it to the PngImageList.PngImages property. That is no longer the case, i.o.w. the components have been separated completely.
+
+
The editor
+
As said before, the PngImageList and PngImageCollection share an editor that allows to modify the contents of the respective component:
+
+
The Add button will ask for a PNG image. After that, you may set its name and background color. Note that you can select multiple files and add them all at once.
+
The Delete button deletes the currently selected image(s), after having asked for confirmation.
+
The Replace button only works when a single image is selected. It will ask for a PNG file and will replace the actual image.
+
The Clear button empties the list, after having asked for confirmation.
+
The Up button moves the currently selected images one position up, if possible.
+
The Down button moves the currently selected images one position down, if possible.
+
You can also drag images in the listbox. They'll be moved as you drag them, in realtime.
+
Remember that you can select multiple images, for your convenience.
+
+
The editor will show up when you doubleclick the PngImageList or PngImageCollection component. You may also select Edit images... from its context menu, or doubleclick the PngImageList.PngImages or PngImageCollection.Items property.
+
+
The ImageList
+
The ImageList has some features and issues you should probably know about:
+
+
The images you add to the list are internally pumped into the "real" imagelist, so that native "API" windows controls, like listviews and treeviews, can take advantage of it. Even though PngImageList tries to make the best out of it, Windows 2000 and earlier simply do not support an alpha channel in an icon and may therefor display it incorrectly. This also applies on Windows XP and later, if you forget to add a manifest to your application. Note that themes support is not required for this to work, just a manifest is enough (themes may even be unavailable).
+
The editor will not crop or resize images that do not conform the dimensions of the imagelist. Unfortunately, this is extremely hard when working with PNG images, due to limitations in the pngdelphi library.
+
Components that do not natively support the PngImageList will not draw disabled images correctly. Those components usually have their own algorithm to generate disabled images, which will not work with the modern-style flashy colorful alpha-blended PNG images. You may want to include another imagelist with the same images, but with the EnabledImages property set to False.
+
+
+
The OfficeXP fix
+
A small introduction: Jordan Russell's Toolbar2000 is a set of components for creating Office 2000-style toolbars and such. Alex Desinov's TBX is an add-on package that adds even more functionality as well as theming. This allows for themes like "OfficeXP", "Office2003" and more.
+
The OfficeXP theme comes standard with TBX and it's the one getting in major trouble when using in combination with PngComponents. The alpha-blended area's look ugly, images may show dark borders, and other kinds of artefacts may show up.
+
The fix I've included is as simple as it is effective; it's a unit called PngTBXOfficeXPTheme. If you replace TBXOfficeXPTheme in your uses clauses with PngTBXOfficeXPTheme, you should be all set! You will not have the fancy looks in designtime, but in runtime your application will look better than ever.
+
Warning! If you still need TBXOfficeXPTheme included in your uses clause, then make sure PngTBXOfficeXPTheme gets initialized after TBXOfficeXPTheme, or it will not work as expected.
+
+
Miscellaneous
+
Feedback
+
I love to get feedback! You can either go to the newsgroup or send me an e-mail if you have a specific question.
+
Legal
+
See the License.txt file included in the archive. If the file is not there, the ZIP file is not a genuine PngComponents download!
+
+
+
This page is best viewed with Opera or Firefox. This page is also optmized for printing.
+
+
\ No newline at end of file
diff --git a/official/1.2.0/Docs/pngimage.chm b/official/1.2.0/Docs/pngimage.chm
new file mode 100644
index 0000000..c7e51b2
Binary files /dev/null and b/official/1.2.0/Docs/pngimage.chm differ
diff --git a/official/1.2.0/Example Images/Computer_32.png b/official/1.2.0/Example Images/Computer_32.png
new file mode 100644
index 0000000..a9b6ac5
Binary files /dev/null and b/official/1.2.0/Example Images/Computer_32.png differ
diff --git a/official/1.2.0/Example Images/FolderClosed_32.png b/official/1.2.0/Example Images/FolderClosed_32.png
new file mode 100644
index 0000000..42ad8ac
Binary files /dev/null and b/official/1.2.0/Example Images/FolderClosed_32.png differ
diff --git a/official/1.2.0/Example Images/FolderOpen_32.png b/official/1.2.0/Example Images/FolderOpen_32.png
new file mode 100644
index 0000000..370b5c4
Binary files /dev/null and b/official/1.2.0/Example Images/FolderOpen_32.png differ
diff --git a/official/1.2.0/Example Images/RemoteComputer_32.png b/official/1.2.0/Example Images/RemoteComputer_32.png
new file mode 100644
index 0000000..8e514d1
Binary files /dev/null and b/official/1.2.0/Example Images/RemoteComputer_32.png differ
diff --git a/official/1.2.0/Packages/PngComponents.dpk b/official/1.2.0/Packages/PngComponents.dpk
new file mode 100644
index 0000000..58a82f8
--- /dev/null
+++ b/official/1.2.0/Packages/PngComponents.dpk
@@ -0,0 +1,44 @@
+package PngComponents;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS OFF}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO OFF}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'Png Components'}
+{$LIBSUFFIX '120'}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+ vclactnband,
+ vcl,
+ rtl,
+ vclimg;
+
+contains
+ PngSpeedButton in '..\Source\PngSpeedButton.pas',
+ PngFunctions in '..\Source\PngFunctions.pas',
+ PngImageList in '..\Source\PngImageList.pas',
+ PngBitBtn in '..\Source\PngBitBtn.pas',
+ PngButtonFunctions in '..\Source\PngButtonFunctions.pas',
+ PngCheckListBox in '..\Source\PngCheckListBox.pas';
+
+end.
diff --git a/official/1.2.0/Packages/PngComponents.dproj b/official/1.2.0/Packages/PngComponents.dproj
new file mode 100644
index 0000000..78825f0
--- /dev/null
+++ b/official/1.2.0/Packages/PngComponents.dproj
@@ -0,0 +1,118 @@
+
+
+ {F25C3775-B8A8-4DEE-B53F-72E25C9DD51E}
+ PngComponents.dpk
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ C:\Documents and Settings\All Users\Documentos\RAD Studio\6.0\Bpl\PngComponents120.bpl
+ false
+ Png Components
+ true
+ 120
+ true
+ true
+ false
+ 0
+ 00400000
+ x86
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ PngComponents.dpk
+
+
+ False
+ True
+ False
+
+
+ True
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 3082
+ 1252
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ 12
+
+
diff --git a/official/1.2.0/Packages/PngComponents.dproj.2007 b/official/1.2.0/Packages/PngComponents.dproj.2007
new file mode 100644
index 0000000..78825f0
--- /dev/null
+++ b/official/1.2.0/Packages/PngComponents.dproj.2007
@@ -0,0 +1,118 @@
+
+
+ {F25C3775-B8A8-4DEE-B53F-72E25C9DD51E}
+ PngComponents.dpk
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ C:\Documents and Settings\All Users\Documentos\RAD Studio\6.0\Bpl\PngComponents120.bpl
+ false
+ Png Components
+ true
+ 120
+ true
+ true
+ false
+ 0
+ 00400000
+ x86
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ PngComponents.dpk
+
+
+ False
+ True
+ False
+
+
+ True
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 3082
+ 1252
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ 12
+
+
diff --git a/official/1.2.0/Packages/PngComponents.res b/official/1.2.0/Packages/PngComponents.res
new file mode 100644
index 0000000..1f00344
Binary files /dev/null and b/official/1.2.0/Packages/PngComponents.res differ
diff --git a/official/1.2.0/Packages/PngComponentsDesign.dpk b/official/1.2.0/Packages/PngComponentsDesign.dpk
new file mode 100644
index 0000000..abdd0b7
--- /dev/null
+++ b/official/1.2.0/Packages/PngComponentsDesign.dpk
@@ -0,0 +1,41 @@
+package PngComponentsDesign;
+
+{$R *.res}
+{$R '..\Design\PngComponents.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS OFF}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO OFF}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'Png components designtime'}
+{$LIBSUFFIX '120'}
+{$DESIGNONLY}
+{$IMPLICITBUILD ON}
+{$DEFINE RELEASE}
+
+requires
+ designide,
+ PngComponents;
+
+contains
+ PngComponentsRegister in '..\Design\PngComponentsRegister.pas',
+ PngComponentEditors in '..\Design\PngComponentEditors.pas',
+ PngImageListEditor in '..\Design\PngImageListEditor.pas' {PngImageListEditorDlg};
+
+end.
diff --git a/official/1.2.0/Packages/PngComponentsDesign.res b/official/1.2.0/Packages/PngComponentsDesign.res
new file mode 100644
index 0000000..260785b
Binary files /dev/null and b/official/1.2.0/Packages/PngComponentsDesign.res differ
diff --git a/official/1.2.0/Source/PngBitBtn.pas b/official/1.2.0/Source/PngBitBtn.pas
new file mode 100644
index 0000000..60faf44
--- /dev/null
+++ b/official/1.2.0/Source/PngBitBtn.pas
@@ -0,0 +1,240 @@
+unit PngBitBtn;
+
+interface
+
+uses
+ Windows, Messages, Classes, Graphics, Controls, Buttons, pngimage, PngFunctions;
+
+type
+ TPngBitBtn = class(TBitBtn)
+ private
+ FPngImage: TPngImage;
+ FPngOptions: TPngOptions;
+ FCanvas: TCanvas;
+ FLastKind: TBitBtnKind;
+ FImageFromAction: Boolean;
+ FMouseInControl: Boolean;
+ IsFocused: Boolean;
+ function PngImageStored: Boolean;
+ procedure SetPngImage(const Value: TPngImage);
+ procedure SetPngOptions(const Value: TPngOptions);
+ procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
+ procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
+ procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
+ protected
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure SetButtonStyle(ADefault: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property PngImage: TPngImage read FPngImage write SetPngImage stored PngImageStored;
+ property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
+ property Glyph stored False;
+ property NumGlyphs stored False;
+ end;
+
+implementation
+
+uses
+ ActnList, Themes, PngButtonFunctions;
+
+{ TPngBitBtn }
+
+constructor TPngBitBtn.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPngImage := TPngImage.Create;
+ FPngOptions := [pngBlendOnDisabled];
+ FCanvas := TCanvas.Create;
+ FLastKind := bkCustom;
+ FImageFromAction := False;
+end;
+
+destructor TPngBitBtn.Destroy;
+begin
+ FPngImage.Free;
+ FCanvas.Free;
+ inherited Destroy;
+end;
+
+procedure TPngBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ inherited ActionChange(Sender, CheckDefaults);
+ if Sender is TCustomAction then begin
+ with TCustomAction(Sender) do begin
+ //Copy image from action's imagelist
+ if (PngImage.Empty or FImageFromAction) and (ActionList <> nil) and
+ (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex <
+ ActionList.Images.Count) then begin
+ CopyImageFromImageList(FPngImage, ActionList.Images, ImageIndex);
+ FImageFromAction := True;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngBitBtn.SetButtonStyle(ADefault: Boolean);
+begin
+ inherited SetButtonStyle(ADefault);
+ if ADefault <> IsFocused then begin
+ IsFocused := ADefault;
+ Refresh;
+ end;
+end;
+
+function TPngBitBtn.PngImageStored: Boolean;
+begin
+ Result := not FImageFromAction;
+end;
+
+procedure TPngBitBtn.SetPngImage(const Value: TPngImage);
+begin
+ //This is all neccesary, because you can't assign a nil to a TPngImage
+ if Value = nil then begin
+ FPngImage.Free;
+ FPngImage := TPngImage.Create;
+ end
+ else begin
+ FPngImage.Assign(Value);
+ end;
+
+ //To work around the gamma-problem
+ with FPngImage do
+ if not Empty and (Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA, COLOR_PALETTE]) then
+ Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
+
+ FImageFromAction := False;
+ Repaint;
+end;
+
+procedure TPngBitBtn.SetPngOptions(const Value: TPngOptions);
+begin
+ if FPngOptions <> Value then begin
+ FPngOptions := Value;
+ Repaint;
+ end;
+end;
+
+procedure TPngBitBtn.CNDrawItem(var Message: TWMDrawItem);
+var
+ R, PaintRect: TRect;
+ GlyphPos, TextPos: TPoint;
+ IsDown, IsDefault: Boolean;
+ Flags: Cardinal;
+ Button: TThemedButton;
+ Details: TThemedElementDetails;
+begin
+ R := ClientRect;
+ FCanvas.Handle := Message.DrawItemStruct^.hDC;
+ FCanvas.Font := Self.Font;
+ IsDown := Message.DrawItemStruct^.itemState and ODS_SELECTED <> 0;
+ IsDefault := Message.DrawItemStruct^.itemState and ODS_FOCUS <> 0;
+
+ //Draw the border
+ if ThemeServices.ThemesEnabled then begin
+ //Themed border
+ if not Enabled then
+ Button := tbPushButtonDisabled
+ else if IsDown then
+ Button := tbPushButtonPressed
+ else if FMouseInControl then
+ Button := tbPushButtonHot
+ else if IsFocused or IsDefault then
+ Button := tbPushButtonDefaulted
+ else
+ Button := tbPushButtonNormal;
+
+ //Paint the background, border, and finally get the inner rect
+ Details := ThemeServices.GetElementDetails(Button);
+ ThemeServices.DrawParentBackground(Handle, Message.DrawItemStruct.hDC, @Details, True);
+ ThemeServices.DrawElement(Message.DrawItemStruct.hDC, Details, Message.DrawItemStruct.rcItem);
+ R := ThemeServices.ContentRect(FCanvas.Handle, Details, Message.DrawItemStruct.rcItem);
+ end
+ else begin
+ //Draw the outer border, when focused
+ if IsFocused or IsDefault then begin
+ FCanvas.Pen.Color := clWindowFrame;
+ FCanvas.Pen.Width := 1;
+ FCanvas.Brush.Style := bsClear;
+ FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
+ InflateRect(R, -1, -1);
+ end;
+ //Draw the inner border
+ if IsDown then begin
+ FCanvas.Pen.Color := clBtnShadow;
+ FCanvas.Pen.Width := 1;
+ FCanvas.Brush.Color := clBtnFace;
+ FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
+ InflateRect(R, -1, -1);
+ end
+ else begin
+ Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
+ if Message.DrawItemStruct.itemState and ODS_DISABLED <> 0 then
+ Flags := Flags or DFCS_INACTIVE;
+ DrawFrameControl(Message.DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
+ end;
+ //Adjust the rect when focused and/or down
+ if IsFocused then begin
+ R := ClientRect;
+ InflateRect(R, -1, -1);
+ end;
+ if IsDown then
+ OffsetRect(R, 1, 1);
+ end;
+
+ //Calculate the position of the PNG glyph
+ CalcButtonLayout(FCanvas, FPngImage, ClientRect, IsDown, False, Caption,
+ Layout, Margin, Spacing, GlyphPos, TextPos, DrawTextBiDiModeFlags(0));
+
+ //Draw the image
+ if (FPngImage <> nil) and (Kind = bkCustom) and not FPngImage.Empty then begin
+ PaintRect := Bounds(GlyphPos.X, GlyphPos.Y, FPngImage.Width, FPngImage.Height);
+ if Enabled then
+ DrawPNG(FPngImage, FCanvas, PaintRect, [])
+ else
+ DrawPNG(FPngImage, FCanvas, PaintRect, FPngOptions);
+ end;
+
+ //Draw the text
+ if Length(Caption) > 0 then begin
+ PaintRect := Rect(TextPos.X, TextPos.Y, Width, Height);
+ FCanvas.Brush.Style := bsClear;
+ DrawText(FCanvas.Handle, PChar(Caption), -1, PaintRect,
+ DrawTextBiDiModeFlags(0) or DT_TOP or DT_LEFT or DT_SINGLELINE);
+ end;
+
+ //Draw the focus rectangle
+ if IsFocused and IsDefault then begin
+ if not ThemeServices.ThemesEnabled then begin
+ R := ClientRect;
+ InflateRect(R, -3, -3);
+ end;
+ FCanvas.Pen.Color := clWindowFrame;
+ FCanvas.Brush.Color := clBtnFace;
+ DrawFocusRect(FCanvas.Handle, R);
+ end;
+
+ FLastKind := Kind;
+ FCanvas.Handle := 0;
+end;
+
+procedure TPngBitBtn.CMMouseEnter(var Message: TMessage);
+begin
+ inherited;
+ if ThemeServices.ThemesEnabled and not FMouseInControl and not (csDesigning in ComponentState) then begin
+ FMouseInControl := True;
+ Repaint;
+ end;
+end;
+
+procedure TPngBitBtn.CMMouseLeave(var Message: TMessage);
+begin
+ inherited;
+ if ThemeServices.ThemesEnabled and FMouseInControl then begin
+ FMouseInControl := False;
+ Repaint;
+ end;
+end;
+
+end.
diff --git a/official/1.2.0/Source/PngButtonFunctions.pas b/official/1.2.0/Source/PngButtonFunctions.pas
new file mode 100644
index 0000000..4f9d69f
--- /dev/null
+++ b/official/1.2.0/Source/PngButtonFunctions.pas
@@ -0,0 +1,120 @@
+unit PngButtonFunctions;
+
+interface
+
+uses
+ Windows, Buttons, Graphics, pngimage;
+
+{$IF RTLVersion < 20.0 }
+type
+ TPngImage = TPNGObject;
+{$IFEND}
+
+procedure CalcButtonLayout(Canvas: TCanvas; PngImage: TPngImage; const Client:
+ TRect; Pressed, Down: Boolean; const Caption: string; Layout: TButtonLayout;
+ Margin, Spacing: Integer; var GlyphPos, TextPos: TPoint; BiDiFlags: LongInt);
+
+implementation
+
+uses
+ Classes;
+
+procedure CalcButtonLayout(Canvas: TCanvas; PngImage: TPngImage; const Client:
+ TRect; Pressed, Down: Boolean; const Caption: string; Layout: TButtonLayout;
+ Margin, Spacing: Integer; var GlyphPos, TextPos: TPoint; BiDiFlags: LongInt);
+var
+ ClientSize, GlyphSize, TextSize, TotalSize: TPoint;
+ TextBounds: TRect;
+begin
+ if (BiDiFlags and DT_RIGHT) = DT_RIGHT then begin
+ if Layout = blGlyphLeft then
+ Layout := blGlyphRight
+ else if Layout = blGlyphRight then
+ Layout := blGlyphLeft;
+ end;
+
+ //Calculate the item sizes
+ ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
+
+ if PngImage <> nil then
+ GlyphSize := Point(PngImage.Width, PngImage.Height)
+ else
+ GlyphSize := Point(0, 0);
+
+ if Length(Caption) > 0 then begin
+ TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
+ DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
+ DT_CALCRECT or BiDiFlags);
+ TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
+ TextBounds.Top);
+ end
+ else begin
+ TextBounds := Rect(0, 0, 0, 0);
+ TextSize := Point(0, 0);
+ end;
+
+ //If the layout has the glyph on the right or the left, then both the
+ //text and the glyph are centered vertically. If the glyph is on the top
+ //or the bottom, then both the text and the glyph are centered horizontally.
+ if Layout in [blGlyphLeft, blGlyphRight] then
+ GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2
+ else
+ GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
+
+ //If there is no text or no bitmap, then Spacing is irrelevant
+ if (TextSize.X = 0) or (GlyphSize.X = 0) then
+ Spacing := 0;
+
+ //Adjust Margin and Spacing
+ if Margin = -1 then begin
+ if Spacing = -1 then begin
+ TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
+ if Layout in [blGlyphLeft, blGlyphRight] then
+ Margin := (ClientSize.X - TotalSize.X) div 3
+ else
+ Margin := (ClientSize.Y - TotalSize.Y) div 3;
+ end
+ else begin
+ TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
+ Spacing + TextSize.Y);
+ if Layout in [blGlyphLeft, blGlyphRight] then
+ Margin := (ClientSize.X - TotalSize.X) div 2
+ else
+ Margin := (ClientSize.Y - TotalSize.Y) div 2;
+ end
+ end
+ else if Spacing = -1 then begin
+ TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
+ (Margin + GlyphSize.Y));
+ end;
+
+ case Layout of
+ blGlyphLeft: GlyphPos.X := Margin;
+ blGlyphRight: GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
+ blGlyphTop: GlyphPos.Y := Margin;
+ blGlyphBottom: GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
+ end;
+
+ if Layout in [blGlyphLeft, blGlyphRight] then
+ TextPos.Y := (ClientSize.Y - TextSize.Y) div 2
+ else
+ TextPos.X := (ClientSize.X - TextSize.X) div 2;
+ case Layout of
+ blGlyphLeft: TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
+ blGlyphRight: TextPos.X := GlyphPos.X - Spacing - TextSize.X;
+ blGlyphTop: TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
+ blGlyphBottom: TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
+ end;
+
+ //Fixup the result variables
+ with GlyphPos do begin
+ Inc(X, Client.Left + Integer(Pressed or Down));
+ Inc(Y, Client.Top + Integer(Pressed or Down));
+ end;
+ with TextPos do begin
+ Inc(X, Client.Left + Integer(Pressed or Down));
+ Inc(Y, Client.Top + Integer(Pressed or Down));
+ end;
+end;
+
+end.
diff --git a/official/1.2.0/Source/PngCheckListBox.pas b/official/1.2.0/Source/PngCheckListBox.pas
new file mode 100644
index 0000000..0fc2eaa
--- /dev/null
+++ b/official/1.2.0/Source/PngCheckListBox.pas
@@ -0,0 +1,206 @@
+unit PngCheckListBox;
+
+interface
+
+uses
+ Windows, Classes, CheckLst, pngimage, PngFunctions;
+
+type
+ TPngCheckListBox = class(TCheckListBox)
+ private
+ FPngUnchecked: TPngImage;
+ FPngChecked: TPngImage;
+ FPngOptions: TPngOptions;
+ FPngGrayed: TPngImage;
+ procedure SetPngChecked(const Value: TPngImage);
+ procedure SetPngUnchecked(const Value: TPngImage);
+ procedure SetPngOptions(const Value: TPngOptions);
+ procedure SetPngGrayed(const Value: TPngImage);
+ protected
+ procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
+ function GetCheckWidth: Integer; reintroduce;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property PngChecked: TPngImage read FPngChecked write SetPngChecked;
+ property PngUnchecked: TPngImage read FPngUnchecked write SetPngUnchecked;
+ property PngGrayed: TPngImage read FPngGrayed write SetPngGrayed;
+ property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
+ end;
+
+implementation
+
+uses
+ Graphics, StdCtrls, Math;
+
+{ TPngCheckListBox }
+
+constructor TPngCheckListBox.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPngChecked := TPngImage.Create;
+ FPngUnchecked := TPngImage.Create;
+ FPngGrayed := TPngImage.Create;
+end;
+
+destructor TPngCheckListBox.Destroy;
+begin
+ FPngChecked.Free;
+ FPngUnchecked.Free;
+ FPngGrayed.Free;
+ inherited Destroy;
+end;
+
+procedure TPngCheckListBox.DrawItem(Index: Integer; ARect: TRect; State:
+ TOwnerDrawState);
+
+ procedure DrawCheck(R: TRect; AState: TCheckBoxState; AEnabled: Boolean);
+ var
+ Png: TPngImage;
+ OldColor: TColor;
+ begin
+ //Draws the check image, if it's a PNG, otherwise the inherited would have
+ //been called
+ OldColor := Canvas.Brush.Color;
+ Canvas.Brush.Color := Color;
+ Canvas.FillRect(R);
+ Canvas.Brush.Color := OldColor;
+ case AState of
+ cbUnchecked: Png := FPngUnchecked;
+ cbChecked: Png := FPngChecked;
+ else
+ Png := FPngGrayed;
+ end;
+ DrawPNG(Png, Canvas, Rect(R.Left, R.Top, R.Left + Png.Width, R.Top +
+ Png.Height), FPngOptions);
+ end;
+
+ procedure DrawText;
+ var
+ Flags: Integer;
+ Data: string;
+ begin
+ //Draws the text for an item
+ if Assigned(OnDrawItem) then
+ OnDrawItem(Self, Index, ARect, State)
+ else begin
+ Canvas.FillRect(ARect);
+ if Index < Items.Count then begin
+ Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or
+ DT_NOPREFIX);
+ if not UseRightToLeftAlignment then
+ Inc(ARect.Left, 2)
+ else
+ Dec(ARect.Right, 2);
+ Data := '';
+ if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
+ Data := DoGetData(Index)
+ else
+ Data := Items[Index];
+ Windows.DrawText(Canvas.Handle, PChar(Data), Length(Data), ARect, Flags);
+ end;
+ end;
+ end;
+
+var
+ R: TRect;
+ SaveEvent: TDrawItemEvent;
+ ACheckWidth: Integer;
+ Enable: Boolean;
+begin
+ if FPngChecked.Empty and FPngUnchecked.Empty and FPngGrayed.Empty then
+ inherited DrawItem(Index, ARect, State)
+ else begin
+ ACheckWidth := GetCheckWidth;
+ if Index < Items.Count then begin
+ R := ARect;
+ Enable := Self.Enabled and ItemEnabled[Index];
+ if not Header[Index] then begin
+ if not UseRightToLeftAlignment then begin
+ R.Right := ARect.Left;
+ R.Left := R.Right - ACheckWidth;
+ end
+ else begin
+ R.Left := ARect.Right;
+ R.Right := R.Left + ACheckWidth;
+ end;
+ DrawCheck(R, Self.State[Index], Enable);
+ end
+ else begin
+ Canvas.Font.Color := HeaderColor;
+ Canvas.Brush.Color := HeaderBackgroundColor;
+ end;
+ if not Enable then
+ Canvas.Font.Color := clGrayText;
+ end;
+
+ if (Style = lbStandard) and Assigned(OnDrawItem) then begin
+ //Force lbStandard list to ignore OnDrawItem event.
+ SaveEvent := OnDrawItem;
+ OnDrawItem := nil;
+ try
+ DrawText;
+ finally
+ OnDrawItem := SaveEvent;
+ end;
+ end
+ else
+ DrawText;
+ end;
+end;
+
+function TPngCheckListBox.GetCheckWidth: Integer;
+begin
+ //CheckWidth is equal to the widest PNG
+ if not (FPngChecked.Empty and FPngUnchecked.Empty and FPngGrayed.Empty) then
+ Result := Max(FPngChecked.Width, Max(FPngUnchecked.Width, FPngGrayed.Width))
+ else
+ Result := inherited GetCheckWidth;
+end;
+
+procedure TPngCheckListBox.SetPngChecked(const Value: TPngImage);
+begin
+ //This is all neccesary, because you can't assign a nil to a TPngImage
+ if Value = nil then begin
+ FPngChecked.Free;
+ FPngChecked := TPngImage.Create;
+ end
+ else
+ FPngChecked.Assign(Value);
+ Repaint;
+end;
+
+procedure TPngCheckListBox.SetPngUnchecked(const Value: TPngImage);
+begin
+ //This is all neccesary, because you can't assign a nil to a TPngImage
+ if Value = nil then begin
+ FPngUnchecked.Free;
+ FPngUnchecked := TPngImage.Create;
+ end
+ else
+ FPngUnchecked.Assign(Value);
+ Repaint;
+end;
+
+procedure TPngCheckListBox.SetPngGrayed(const Value: TPngImage);
+begin
+ //This is all neccesary, because you can't assign a nil to a TPngImage
+ if Value = nil then begin
+ FPngGrayed.Free;
+ FPngGrayed := TPngImage.Create;
+ end
+ else
+ FPngGrayed.Assign(Value);
+ Repaint;
+end;
+
+procedure TPngCheckListBox.SetPngOptions(const Value: TPngOptions);
+begin
+ if FPngOptions <> Value then begin
+ FPngOptions := Value;
+ Repaint;
+ end;
+end;
+
+end.
diff --git a/official/1.2.0/Source/PngFunctions.pas b/official/1.2.0/Source/PngFunctions.pas
new file mode 100644
index 0000000..a7997da
--- /dev/null
+++ b/official/1.2.0/Source/PngFunctions.pas
@@ -0,0 +1,552 @@
+unit PngFunctions;
+
+interface
+
+uses
+ Windows, Graphics, ImgList, Contnrs, pngimage;
+
+{$IF RTLVersion < 20.0 }
+ {$IF RTLVersion < 15.0 }
+ PngComponents are only compatible with Delphi 7 and higher!
+ {$IFEND}
+type
+ TPngImage = TPNGObject;
+{$IFEND}
+
+type
+ TPngOption = (pngBlendOnDisabled, pngGrayscaleOnDisabled);
+ TPngOptions = set of TPngOption;
+ TRGBLine = array[Word] of TRGBTriple;
+ PRGBLine = ^TRGBLine;
+ TRGBALine = array[Word] of TRGBQuad;
+ PRGBALine = ^TRGBALine;
+
+procedure MakeImageBlended(Image: TPngImage; Amount: Byte = 127);
+procedure MakeImageGrayscale(Image: TPngImage; Amount: Byte = 255);
+procedure DrawPNG(Png: TPngImage; Canvas: TCanvas; const ARect: TRect; const Options: TPngOptions);
+procedure ConvertToPNG(Source: TGraphic; out Dest: TPngImage);
+procedure CreatePNG(Color, Mask: TBitmap; out Dest: TPngImage; InverseMask: Boolean = False);
+procedure CreatePNGMasked(Bitmap: TBitmap; Mask: TColor; out Dest: TPngImage);
+procedure CopyImageFromImageList(Dest: TPngImage; ImageList: TCustomImageList; Index: Integer);
+procedure SlicePNG(JoinedPNG: TPngImage; Columns, Rows: Integer; out SlicedPNGs: TObjectList);
+
+implementation
+
+uses
+ SysUtils, PngImageList;
+
+function ColorToTriple(Color: TColor): TRGBTriple;
+var
+ ColorRGB: Longint;
+begin
+ ColorRGB := ColorToRGB(Color);
+ Result.rgbtBlue := ColorRGB shr 16 and $FF;
+ Result.rgbtGreen := ColorRGB shr 8 and $FF;
+ Result.rgbtRed := ColorRGB and $FF;
+end;
+
+procedure MakeImageBlended(Image: TPngImage; Amount: Byte = 127);
+
+ procedure ForceAlphachannel(BitTransparency: Boolean; TransparentColor: TColor);
+ var
+ Assigner: TBitmap;
+ Temp: TPngImage;
+ X, Y: Integer;
+ Line: pngimage.PByteArray;
+ Current: TColor;
+ begin
+ //Not all formats of PNG support an alpha-channel (paletted images for example),
+ //so with this function, I simply recreate the PNG as being 32-bits, effectivly
+ //forcing an alpha-channel on it.
+ Temp := TPngImage.Create;
+ try
+ Assigner := TBitmap.Create;
+ try
+ Assigner.Width := Image.Width;
+ Assigner.Height := Image.Height;
+ Temp.Assign(Assigner);
+ finally
+ Assigner.Free;
+ end;
+ Temp.CreateAlpha;
+ for Y := 0 to Image.Height - 1 do begin
+ Line := Temp.AlphaScanline[Y];
+ for X := 0 to Image.Width - 1 do begin
+ Current := Image.Pixels[X, Y];
+ Temp.Pixels[X, Y] := Current;
+ if BitTransparency and (Current = TransparentColor) then
+ Line[X] := 0
+ else
+ Line[X] := Amount;
+ end;
+ end;
+ Image.Assign(Temp);
+ finally
+ Temp.Free;
+ end;
+ end;
+
+var
+ X, Y: Integer;
+ Line: pngimage.PByteArray;
+ Forced: Boolean;
+ TransparentColor: TColor;
+ BitTransparency: Boolean;
+begin
+ //If the PNG doesn't have an alpha channel, then add one
+ BitTransparency := Image.TransparencyMode = ptmBit;
+ TransparentColor := Image.TransparentColor;
+ Forced := False;
+ if not (Image.Header.ColorType in [COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA]) then begin
+ Forced := Image.Header.ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE];
+ if Forced then
+ ForceAlphachannel(BitTransparency, TransparentColor)
+ else
+ Image.CreateAlpha;
+ end;
+
+ //Divide the alpha values by 2
+ if not Forced and (Image.Header.ColorType in [COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA]) then begin
+ for Y := 0 to Image.Height - 1 do begin
+ Line := Image.AlphaScanline[Y];
+ for X := 0 to Image.Width - 1 do begin
+ if BitTransparency and (Image.Pixels[X, Y] = TransparentColor) then
+ Line[X] := 0
+ else
+ Line[X] := Round(Line[X] / 256 * (Amount + 1));
+ end;
+ end;
+ end;
+end;
+
+procedure MakeImageGrayscale(Image: TPngImage; Amount: Byte = 255);
+
+ procedure GrayscaleRGB(var R, G, B: Byte);
+ var
+ X: Byte;
+ begin
+ X := Round(R * 0.30 + G * 0.59 + B * 0.11);
+ R := Round(R / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1));
+ G := Round(G / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1));
+ B := Round(B / 256 * (256 - Amount - 1)) + Round(X / 256 * (Amount + 1));
+ end;
+
+var
+ X, Y, PalCount: Integer;
+ Line: PRGBLine;
+ PaletteHandle: HPalette;
+ Palette: array[Byte] of TPaletteEntry;
+begin
+ //Don't do anything if the image is already a grayscaled one
+ if not (Image.Header.ColorType in [COLOR_GRAYSCALE, COLOR_GRAYSCALEALPHA]) then begin
+ if Image.Header.ColorType = COLOR_PALETTE then begin
+ //Grayscale every palette entry
+ PaletteHandle := Image.Palette;
+ PalCount := GetPaletteEntries(PaletteHandle, 0, 256, Palette);
+ for X := 0 to PalCount - 1 do
+ GrayscaleRGB(Palette[X].peRed, Palette[X].peGreen, Palette[X].peBlue);
+ SetPaletteEntries(PaletteHandle, 0, PalCount, Palette);
+ Image.Palette := PaletteHandle;
+ end
+ else begin
+ //Grayscale every pixel
+ for Y := 0 to Image.Height - 1 do begin
+ Line := Image.Scanline[Y];
+ for X := 0 to Image.Width - 1 do
+ GrayscaleRGB(Line[X].rgbtRed, Line[X].rgbtGreen, Line[X].rgbtBlue);
+ end;
+ end;
+ end;
+end;
+
+procedure DrawPNG(Png: TPngImage; Canvas: TCanvas; const ARect: TRect; const Options: TPngOptions);
+var
+ PngCopy: TPngImage;
+begin
+ if Options <> [] then begin
+ PngCopy := TPngImage.Create;
+ try
+ PngCopy.Assign(Png);
+ if pngBlendOnDisabled in Options then
+ MakeImageBlended(PngCopy);
+ if pngGrayscaleOnDisabled in Options then
+ MakeImageGrayscale(PngCopy);
+ PngCopy.Draw(Canvas, ARect);
+ finally
+ PngCopy.Free;
+ end;
+ end
+ else begin
+ Png.Draw(Canvas, ARect);
+ end;
+end;
+
+procedure ConvertToPNG(Source: TGraphic; out Dest: TPngImage);
+var
+ MaskLines: array of pngimage.PByteArray;
+
+ function CompareColors(const Color1: TRGBTriple; const Color2: TColor): Boolean;
+ begin
+ Result := (Color1.rgbtBlue = Color2 shr 16 and $FF) and
+ (Color1.rgbtGreen = Color2 shr 8 and $FF) and
+ (Color1.rgbtRed = Color2 and $FF);
+ end;
+
+ function ColorToTriple(const Color: TColor): TRGBTriple;
+ begin
+ Result.rgbtBlue := Color shr 16 and $FF;
+ Result.rgbtGreen := Color shr 8 and $FF;
+ Result.rgbtRed := Color and $FF;
+ end;
+
+ procedure GetAlphaMask(SourceColor: TBitmap);
+ type
+ TBitmapInfo = packed record
+ bmiHeader: TBitmapV4Header;
+ //Otherwise I may not get per-pixel alpha values.
+ bmiColors: array[0..0] of TRGBQuad;
+ end;
+ var
+ Bits: PRGBALine;
+ BitmapInfo: TBitmapInfo;
+ I, X, Y: Integer;
+ HasAlpha: Boolean;
+ BitsSize: Integer;
+ begin
+ BitsSize := 4 * SourceColor.Width * SourceColor.Height;
+ Bits := AllocMem(BitsSize);
+ try
+ ZeroMemory(Bits, BitsSize);
+ ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
+ BitmapInfo.bmiHeader.bV4Size := SizeOf(BitmapInfo.bmiHeader);
+ BitmapInfo.bmiHeader.bV4Width := SourceColor.Width;
+ BitmapInfo.bmiHeader.bV4Height := -SourceColor.Height;
+ //Otherwise the image is upside down.
+ BitmapInfo.bmiHeader.bV4Planes := 1;
+ BitmapInfo.bmiHeader.bV4BitCount := 32;
+ BitmapInfo.bmiHeader.bV4V4Compression := BI_BITFIELDS;
+ BitmapInfo.bmiHeader.bV4SizeImage := BitsSize;
+
+ if GetDIBits(SourceColor.Canvas.Handle, SourceColor.Handle, 0,
+ SourceColor.Height, Bits, Windows.PBitmapInfo(@BitmapInfo)^,
+ DIB_RGB_COLORS) > 0 then begin
+ //Because Win32 API is a piece of crap when it comes to icons, I have to check
+ //whether an has an alpha-channel the hard way.
+ HasAlpha := False;
+ for I := 0 to (SourceColor.Height * SourceColor.Width) - 1 do begin
+ if Bits[I].rgbReserved <> 0 then begin
+ HasAlpha := True;
+ Break;
+ end;
+ end;
+ if HasAlpha then begin
+ //OK, so not all alpha-values are 0, which indicates the existence of an
+ //alpha-channel.
+ I := 0;
+ for Y := 0 to SourceColor.Height - 1 do
+ for X := 0 to SourceColor.Width - 1 do begin
+ MaskLines[Y][X] := Bits[I].rgbReserved;
+ Inc(I);
+ end;
+ end;
+ end;
+ finally
+ FreeMem(Bits, BitsSize);
+ end;
+ end;
+
+ function WinXPOrHigher: Boolean;
+ var
+ Info: TOSVersionInfo;
+ begin
+ Info.dwOSVersionInfoSize := SizeOf(Info);
+ GetVersionEx(Info);
+ Result := (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and
+ ((Info.dwMajorVersion > 5) or
+ ((Info.dwMajorVersion = 5) and (Info.dwMinorVersion >= 1)));
+ end;
+
+var
+ Temp, SourceColor, SourceMask: TBitmap;
+ X, Y: Integer;
+ Line: PRGBLine;
+ MaskLine, AlphaLine: pngimage.PByteArray;
+ TransparentColor, CurrentColor: TColor;
+ IconInfo: TIconInfo;
+ AlphaNeeded: Boolean;
+begin
+ //A PNG does not have to be converted
+ if Source is TPngImage then begin
+ Dest := TPngImage.Create;
+ Dest.Assign(Source);
+ Exit;
+ end;
+
+ AlphaNeeded := False;
+ Temp := TBitmap.Create;
+ SetLength(MaskLines, Source.Height);
+ for Y := 0 to Source.Height - 1 do begin
+ MaskLines[Y] := AllocMem(Source.Width);
+ FillMemory(MaskLines[Y], Source.Width, 255);
+ end;
+ try
+ //Initialize intermediate color bitmap
+ Temp.Width := Source.Width;
+ Temp.Height := Source.Height;
+ Temp.PixelFormat := pf24bit;
+
+ //Now figure out the transparency
+ if Source is TBitmap then begin
+ if Source.Transparent then begin
+ //TBitmap is just about comparing the drawn colors against the TransparentColor
+ if TBitmap(Source).TransparentMode = tmFixed then
+ TransparentColor := TBitmap(Source).TransparentColor
+ else
+ TransparentColor := TBitmap(Source).Canvas.Pixels[0, Source.Height - 1];
+
+ for Y := 0 to Temp.Height - 1 do begin
+ Line := Temp.ScanLine[Y];
+ MaskLine := MaskLines[Y];
+ for X := 0 to Temp.Width - 1 do begin
+ CurrentColor := GetPixel(TBitmap(Source).Canvas.Handle, X, Y);
+ if CurrentColor = TransparentColor then begin
+ MaskLine^[X] := 0;
+ AlphaNeeded := True;
+ end;
+ Line[X] := ColorToTriple(CurrentColor);
+ end;
+ end;
+ end
+ else begin
+ Temp.Canvas.Draw(0, 0, Source);
+ end;
+ end
+ else if Source is TIcon then begin
+ //TIcon is more complicated, because there are bitmasked (classic) icons and
+ //alphablended (modern) icons. Not to forget about the "inverse" color.
+ GetIconInfo(TIcon(Source).Handle, IconInfo);
+ SourceColor := TBitmap.Create;
+ SourceMask := TBitmap.Create;
+ try
+ SourceColor.Handle := IconInfo.hbmColor;
+ SourceMask.Handle := IconInfo.hbmMask;
+ Temp.Canvas.Draw(0, 0, SourceColor);
+ for Y := 0 to Temp.Height - 1 do begin
+ MaskLine := MaskLines[Y];
+ for X := 0 to Temp.Width - 1 do begin
+ if GetPixel(SourceMask.Canvas.Handle, X, Y) <> 0 then begin
+ MaskLine^[X] := 0;
+ AlphaNeeded := True;
+ end;
+ end;
+ end;
+ if (GetDeviceCaps(SourceColor.Canvas.Handle, BITSPIXEL) = 32) and WinXPOrHigher then begin
+ //This doesn't neccesarily mean we actually have 32bpp in the icon, because the
+ //bpp of an icon is always the same as the display settings, regardless of the
+ //actual color depth of the icon :(
+ AlphaNeeded := True;
+ GetAlphaMask(SourceColor);
+ end;
+ //This still doesn't work for alphablended icons...
+ finally
+ SourceColor.Free;
+ SourceMask.Free
+ end;
+ end;
+
+ //And finally, create the destination PNG image
+ Dest := TPngImage.Create;
+ Dest.Assign(Temp);
+ if AlphaNeeded then begin
+ Dest.CreateAlpha;
+ for Y := 0 to Dest.Height - 1 do begin
+ AlphaLine := Dest.AlphaScanline[Y];
+ CopyMemory(AlphaLine, MaskLines[Y], Temp.Width);
+ end;
+ end;
+
+ finally
+ for Y := 0 to Source.Height - 1 do
+ FreeMem(MaskLines[Y], Source.Width);
+ Temp.Free;
+ end;
+end;
+
+procedure CreatePNG(Color, Mask: TBitmap; out Dest: TPngImage; InverseMask: Boolean = False);
+var
+ Temp: TBitmap;
+ Line: pngimage.PByteArray;
+ X, Y: Integer;
+begin
+ //Create a PNG from two separate color and mask bitmaps. InverseMask should be
+ //True if white means transparent, and black means opaque.
+ Dest := TPngImage.Create;
+ if not (Color.PixelFormat in [pf24bit, pf32bit]) then begin
+ Temp := TBitmap.Create;
+ try
+ Temp.Assign(Color);
+ Temp.PixelFormat := pf24bit;
+ Dest.Assign(Temp);
+ finally
+ Temp.Free;
+ end;
+ end
+ else begin
+ Dest.Assign(Color);
+ end;
+
+ //Copy the alpha channel.
+ Dest.CreateAlpha;
+ for Y := 0 to Dest.Height - 1 do begin
+ Line := Dest.AlphaScanline[Y];
+ for X := 0 to Dest.Width - 1 do begin
+ if InverseMask then
+ Line[X] := 255 - (GetPixel(Mask.Canvas.Handle, X, Y) and $FF)
+ else
+ Line[X] := GetPixel(Mask.Canvas.Handle, X, Y) and $FF;
+ end;
+ end;
+end;
+
+procedure CreatePNGMasked(Bitmap: TBitmap; Mask: TColor; out Dest: TPngImage);
+var
+ Temp: TBitmap;
+ Line: pngimage.PByteArray;
+ X, Y: Integer;
+begin
+ //Create a PNG from two separate color and mask bitmaps. InverseMask should be
+ //True if white means transparent, and black means opaque.
+ Dest := TPngImage.Create;
+ if not (Bitmap.PixelFormat in [pf24bit, pf32bit]) then begin
+ Temp := TBitmap.Create;
+ try
+ Temp.Assign(Bitmap);
+ Temp.PixelFormat := pf24bit;
+ Dest.Assign(Temp);
+ finally
+ Temp.Free;
+ end;
+ end
+ else begin
+ Dest.Assign(Bitmap);
+ end;
+
+ //Copy the alpha channel.
+ Dest.CreateAlpha;
+ for Y := 0 to Dest.Height - 1 do begin
+ Line := Dest.AlphaScanline[Y];
+ for X := 0 to Dest.Width - 1 do
+ Line[X] := Integer(TColor(GetPixel(Bitmap.Canvas.Handle, X, Y)) <> Mask) * $FF;
+ end;
+end;
+
+procedure CopyImageFromImageList(Dest: TPngImage; ImageList: TCustomImageList; Index: Integer);
+var
+ Icon: TIcon;
+ IconInfo: TIconInfo;
+ ColorBitmap, MaskBitmap: TBitmap;
+ X, Y: Integer;
+ AlphaLine: pngimage.PByteArray;
+ Png: TPngImageCollectionItem;
+begin
+ if ImageList is TPngImageList then begin
+ //This is easy, just copy the PNG object from the imagelist to the PNG object
+ //from the button
+ Png := TPNGImageList(ImageList).PngImages[Index];
+ if Png <> nil then
+ Dest.Assign(Png.PngImage);
+ end
+ else begin
+ Icon := TIcon.Create;
+ ColorBitmap := TBitmap.Create;
+ MaskBitmap := TBitmap.Create;
+ try
+ //Try to copy an icon to a PNG object, including transparency
+ ImageList.GetIcon(Index, Icon);
+ if GetIconInfo(Icon.Handle, IconInfo) then begin
+ //First, pump the colors into the PNG object
+ ColorBitmap.Handle := IconInfo.hbmColor;
+ ColorBitmap.PixelFormat := pf24bit;
+ Dest.Assign(ColorBitmap);
+
+ //Finally, copy the transparency
+ Dest.CreateAlpha;
+ MaskBitmap.Handle := IconInfo.hbmMask;
+ for Y := 0 to Dest.Height - 1 do begin
+ AlphaLine := Dest.AlphaScanline[Y];
+ for X := 0 to Dest.Width - 1 do
+ AlphaLine^[X] := Integer(GetPixel(MaskBitmap.Canvas.Handle, X, Y) = COLORREF(clBlack)) * $FF;
+ end;
+ end;
+ finally
+ MaskBitmap.Free;
+ ColorBitmap.Free;
+ Icon.Free;
+ end;
+ end;
+end;
+
+procedure SlicePNG(JoinedPNG: TPngImage; Columns, Rows: Integer; out SlicedPNGs: TObjectList);
+var
+ X, Y, ImageX, ImageY, OffsetX, OffsetY: Integer;
+ Width, Height: Integer;
+ Bitmap: TBitmap;
+ BitmapLine: PRGBLine;
+ AlphaLineA, AlphaLineB: pngimage.PByteArray;
+ PNG: TPngImage;
+begin
+ //This function slices a large PNG file (e.g. an image with all images for a
+ //toolbar) into smaller, equally-sized pictures.
+ SlicedPNGs := TObjectList.Create(False);
+ Width := JoinedPNG.Width div Columns;
+ Height := JoinedPNG.Height div Rows;
+
+ //Loop through the columns and rows to create each individual image
+ for ImageY := 0 to Rows - 1 do begin
+ for ImageX := 0 to Columns - 1 do begin
+ OffsetX := ImageX * Width;
+ OffsetY := ImageY * Height;
+ Bitmap := TBitmap.Create;
+ try
+ Bitmap.Width := Width;
+ Bitmap.Height := Height;
+ Bitmap.PixelFormat := pf24bit;
+
+ //Copy the color information into a temporary bitmap. We can't use TPngImage.Draw
+ //here, because that would combine the color and alpha values.
+ for Y := 0 to Bitmap.Height - 1 do begin
+ BitmapLine := Bitmap.Scanline[Y];
+ for X := 0 to Bitmap.Width - 1 do
+ BitmapLine[X] := ColorToTriple(JoinedPNG.Pixels[X + OffsetX, Y + OffsetY]);
+ end;
+
+ PNG := TPngImage.Create;
+ PNG.Assign(Bitmap);
+
+ if JoinedPNG.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then begin
+ //Copy the alpha channel
+ PNG.CreateAlpha;
+ for Y := 0 to PNG.Height - 1 do begin
+ AlphaLineA := JoinedPNG.AlphaScanline[Y + OffsetY];
+ AlphaLineB := JoinedPNG.AlphaScanline[Y];
+ for X := 0 to PNG.Width - 1 do
+ AlphaLineB[X] := AlphaLineA[X + OffsetX];
+ end;
+ end;
+
+ SlicedPNGs.Add(PNG);
+ finally
+ Bitmap.Free;
+ end;
+ end;
+ end;
+end;
+
+{$IF RTLVersion >= 20.0 }
+type
+ TPNGObject = class(TPngImage);
+begin
+ TPicture.RegisterFileFormat('', '', TPNGObject);
+{$IFEND}
+end.
+
diff --git a/official/1.2.0/Source/PngImageList.pas b/official/1.2.0/Source/PngImageList.pas
new file mode 100644
index 0000000..3ea3d0b
--- /dev/null
+++ b/official/1.2.0/Source/PngImageList.pas
@@ -0,0 +1,1252 @@
+unit PngImageList;
+
+{$IF RTLVersion < 15.0 }
+This unit only compiles with Delphi 7 and higher!
+{$IFEND}
+
+interface
+
+uses
+ Windows, Classes, SysUtils, Controls, Graphics, ImgList, PngImage,
+ PngFunctions;
+
+type
+ TPngImageCollection = class;
+ TPngImageCollectionItem = class;
+ TPngImageCollectionItems = class;
+
+ TPngImageList = class(TImageList)
+ private
+ FEnabledImages: Boolean;
+ FLocked: Integer;
+ FPngImages: TPngImageCollectionItems;
+ FPngOptions: TPngOptions;
+ function GetHeight: Integer;
+ function GetWidth: Integer;
+ procedure SetHeight(const Value: Integer);
+ procedure SetPngOptions(const Value: TPngOptions);
+ procedure SetWidth(const Value: Integer);
+ protected
+ procedure AssignTo(Dest: TPersistent); override;
+ procedure CopyPngs; virtual;
+ procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean = True); override;
+ function PngToIcon(const Png: TPngImage; Background: TColor = clNone): HICON;
+ procedure ReadData(Stream: TStream); override;
+ procedure SetEnabledImages(const Value: Boolean); virtual;
+ procedure SetPngImages(const Value: TPngImageCollectionItems); virtual;
+ procedure WriteData(Stream: TStream); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ //Patched methods
+ function Add(Image, Mask: TBitmap): Integer; virtual;
+ function AddIcon(Image: TIcon): Integer; virtual;
+ function AddImage(Value: TCustomImageList; Index: Integer): Integer; virtual;
+ procedure AddImages(Value: TCustomImageList); virtual;
+ function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; virtual;
+ procedure BeginUpdate;
+ procedure Clear; virtual;
+ procedure Delete(Index: Integer); virtual;
+ procedure EndUpdate(Update: Boolean = True);
+ procedure Insert(Index: Integer; Image, Mask: TBitmap); virtual;
+ procedure InsertIcon(Index: Integer; Image: TIcon); virtual;
+ procedure InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor); virtual;
+ procedure InsertPng(Index: Integer; const Png: TPngImage; Background: TColor = clNone);
+ procedure Move(CurIndex, NewIndex: Integer); virtual;
+ procedure Replace(Index: Integer; Image, Mask: TBitmap); virtual;
+ procedure ReplaceIcon(Index: Integer; Image: TIcon); virtual;
+ procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor); virtual;
+ published
+ property EnabledImages: Boolean read FEnabledImages write SetEnabledImages default True;
+ property Height read GetHeight write SetHeight default 16;
+ property PngImages: TPngImageCollectionItems read FPngImages write SetPngImages;
+ property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
+ property Width read GetWidth write SetWidth default 16;
+ end;
+
+ TPngImageCollection = class(TComponent)
+ private
+ FItems: TPngImageCollectionItems;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Items: TPngImageCollectionItems read FItems write FItems;
+ end;
+
+ TPngImageCollectionItems = class(TCollection)
+ private
+ FOwner: TPersistent;
+ function GetItem(Index: Integer): TPngImageCollectionItem;
+ procedure SetItem(Index: Integer; const Value: TPngImageCollectionItem);
+ protected
+ function GetOwner: TPersistent; override;
+ procedure Update(Item: TCollectionItem); override;
+ public
+ constructor Create(AOwner: TPersistent);
+ function Add(DontCreatePNG: Boolean = False): TPngImageCollectionItem; reintroduce;
+ procedure Assign(Source: TPersistent); override;
+ function Insert(Index: Integer; DontCreatePNG: Boolean = False): TPngImageCollectionItem; reintroduce;
+ property Items[index: Integer]: TPngImageCollectionItem read GetItem write SetItem; default;
+ end;
+
+ TPngImageCollectionItem = class(TCollectionItem)
+ private
+ FBackground: TColor;
+ FName: string;
+ FPngImage: TPngImage;
+ procedure SetBackground(const Value: TColor);
+ procedure SetPngImage(const Value: TPngImage);
+ protected
+ procedure AssignTo(Dest: TPersistent); override;
+ function GetDisplayName: string; override;
+ public
+ constructor Create(Collection: TCollection); overload; override;
+ constructor Create(Collection: TCollection; DontCreatePNG: Boolean = False); reintroduce; overload;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ function Duplicate: TPngImage;
+ published
+ property Background: TColor read FBackground write SetBackground default clBtnFace;
+ property Name: string read FName write FName;
+ property PngImage: TPngImage read FPngImage write SetPngImage;
+ end;
+
+implementation
+
+uses
+ Math, Contnrs, CommCtrl, ComCtrls;
+
+var
+ ImageListCount: Integer = 0;
+ MethodPatches: TObjectList = nil;
+
+type
+ TMethodPatch = class
+ private
+ Name: string;
+ OldBody: array[0..5] of Byte;
+ OldPointer, NewPointer: Pointer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure BeginInvokeOldMethod;
+ procedure FinishInvokeOldMethod;
+ function PatchBack: Boolean;
+ end;
+
+{ Global }
+
+function FindMethodPatch(const Name: string): TMethodPatch;
+var
+ I: Integer;
+begin
+ Result := nil;
+ for I := 0 to MethodPatches.Count - 1 do begin
+ if TMethodPatch(MethodPatches[I]).Name = Name then begin
+ Result := TMethodPatch(MethodPatches[I]);
+ Break;
+ end;
+ end;
+end;
+
+function PatchPtr(OldPtr, NewPtr: Pointer; const Name: string; Patch: TMethodPatch): Boolean;
+var
+ Access: Cardinal;
+begin
+ Result := False;
+ Patch.Name := Name;
+ if OldPtr <> NewPtr then begin
+ Patch.OldPointer := OldPtr;
+ Patch.NewPointer := NewPtr;
+ Move(PByte(OldPtr)^, Patch.OldBody[0], SizeOf(Patch.OldBody));
+ if VirtualProtect(OldPtr, 16, PAGE_EXECUTE_READWRITE, @Access) then begin
+ PByte(OldPtr)^ := $E9; // Near jump
+ PCardinal(Cardinal(OldPtr) + 1)^ := Cardinal(NewPtr) - Cardinal(OldPtr) - 5;
+ VirtualProtect(OldPtr, 16, Access, @Access);
+ Result := True;
+ end;
+ end;
+ if not Result then
+ Patch.OldPointer := nil;
+end;
+
+procedure ApplyMethodPatches;
+type
+ TPointerCombo = record
+ OldPtr, NewPtr: Pointer;
+ Name: string;
+ end;
+
+ function Combo(OldPtr, NewPtr: Pointer; const Name: string): TPointerCombo;
+ begin
+ Result.OldPtr := OldPtr;
+ Result.NewPtr := NewPtr;
+ Result.Name := Name;
+ end;
+
+const
+ EmptyCombo: TPointerCombo = (OldPtr: nil; NewPtr: nil; Name: '');
+var
+ Pointers: array of TPointerCombo;
+ Patch: TMethodPatch;
+ I: Integer;
+begin
+ if ImageListCount = 0 then begin
+ SetLength(Pointers, 14);
+ Pointers[0] := Combo(@TCustomImageList.Add, @TPngImageList.Add, 'Add');
+ Pointers[1] := Combo(@TCustomImageList.AddIcon, @TPngImageList.AddIcon, 'AddIcon');
+ Pointers[2] := Combo(@TCustomImageList.AddImage, @TPngImageList.AddImage, 'AddImage');
+ Pointers[3] := Combo(@TCustomImageList.AddImages, @TPngImageList.AddImages, 'AddImages');
+ Pointers[4] := Combo(@TCustomImageList.AddMasked, @TPngImageList.AddMasked, 'AddMasked');
+ Pointers[5] := Combo(@TCustomImageList.Clear, @TPngImageList.Clear, 'Clear');
+ Pointers[6] := Combo(@TCustomImageList.Delete, @TPngImageList.Delete, 'Delete');
+ Pointers[7] := Combo(@TCustomImageList.Insert, @TPngImageList.Insert, 'Insert');
+ Pointers[8] := Combo(@TCustomImageList.InsertIcon, @TPngImageList.InsertIcon, 'InsertIcon');
+ Pointers[9] := Combo(@TCustomImageList.InsertMasked, @TPngImageList.InsertMasked, 'InsertMasked');
+ Pointers[10] := Combo(@TCustomImageList.Move, @TPngImageList.Move, 'Move');
+ Pointers[11] := Combo(@TCustomImageList.Replace, @TPngImageList.Replace, 'Replace');
+ Pointers[12] := Combo(@TCustomImageList.ReplaceIcon, @TPngImageList.ReplaceIcon, 'ReplaceIcon');
+ Pointers[13] := Combo(@TCustomImageList.ReplaceMasked, @TPngImageList.ReplaceMasked, 'ReplaceMasked');
+
+ MethodPatches := TObjectList.Create;
+ for I := Low(Pointers) to High(Pointers) do begin
+ if Pointers[I].OldPtr <> nil then begin
+ Patch := TMethodPatch.Create;
+ if PatchPtr(Pointers[I].OldPtr, Pointers[I].NewPtr, Pointers[I].Name, Patch) then
+ MethodPatches.Add(Patch)
+ else
+ Patch.Free;
+ end;
+ end;
+ end;
+end;
+
+procedure RevertPatchedMethods;
+begin
+ if ImageListCount = 0 then
+ FreeAndNil(MethodPatches);
+end;
+
+{ TMethodPatch }
+
+constructor TMethodPatch.Create;
+begin
+ inherited Create;
+ OldPointer := nil;
+end;
+
+destructor TMethodPatch.Destroy;
+begin
+ if OldPointer <> nil then
+ PatchBack;
+ inherited Destroy;
+end;
+
+procedure TMethodPatch.BeginInvokeOldMethod;
+begin
+ PatchBack;
+end;
+
+procedure TMethodPatch.FinishInvokeOldMethod;
+begin
+ PatchPtr(OldPointer, NewPointer, Name, Self);
+end;
+
+function TMethodPatch.PatchBack: Boolean;
+var
+ Access: Cardinal;
+begin
+ Result := False;
+ if VirtualProtect(OldPointer, 16, PAGE_EXECUTE_READWRITE, @Access) then begin
+ Move(OldBody[0], OldPointer^, SizeOf(OldBody));
+ VirtualProtect(OldPointer, 16, Access, @Access);
+ Result := True;
+ end;
+end;
+
+constructor TPngImageList.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ if ImageListCount = 0 then
+ ApplyMethodPatches;
+ Inc(ImageListCount);
+ FEnabledImages := True;
+ FPngOptions := [pngBlendOnDisabled];
+ FPngImages := TPngImageCollectionItems.Create(Self);
+ FLocked := 0;
+end;
+
+destructor TPngImageList.Destroy;
+begin
+ FPngImages.Free;
+ Dec(ImageListCount);
+ if ImageListCount = 0 then
+ RevertPatchedMethods;
+ inherited Destroy;
+end;
+
+//--- Patched methods ---
+
+function TPngImageList.Add(Image, Mask: TBitmap): Integer;
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then
+ if Image = nil then
+ Result := -1
+ else begin
+ BeginUpdate;
+ try
+ Item := FPngImages.Add(True);
+ CreatePNG(Image, Mask, Item.FPngImage);
+ Result := Item.Index;
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Add');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ Result := TCustomImageList(Self).Add(Image, Mask);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end
+ else
+ Result := -1;
+ end;
+end;
+
+function TPngImageList.AddIcon(Image: TIcon): Integer;
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then
+ if Image = nil then
+ Result := -1
+ else begin
+ BeginUpdate;
+ try
+ Item := FPngImages.Add(True);
+ ConvertToPNG(Image, Item.FPngImage);
+ Result := Item.Index;
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('AddIcon');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ Result := TCustomImageList(Self).AddIcon(Image);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end
+ else
+ Result := -1;
+ end;
+end;
+
+function TPngImageList.AddImage(Value: TCustomImageList; Index: Integer): Integer;
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Add a new PNG based on the image from another imagelist. If this happens to be
+ //a PngImageList, the PNG object is simply copied.
+ BeginUpdate;
+ try
+ Item := FPngImages.Add(False);
+ CopyImageFromImageList(Item.FPngImage, Value, Index);
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ Result := Item.Index;
+ Change;
+ finally
+ EndUpdate;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('AddImage');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ Result := TCustomImageList(Self).AddImage(Value, Index);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end
+ else
+ Result := -1;
+ end;
+end;
+
+procedure TPngImageList.AddImages(Value: TCustomImageList);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ I: Integer;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then begin
+ BeginUpdate;
+ try
+ //Copy every image from Value into this imagelist.
+ for I := 0 to Value.Count - 1 do begin
+ Item := FPngImages.Add(False);
+ CopyImageFromImageList(Item.FPngImage, Value, I);
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ end;
+ Change;
+ finally
+ EndUpdate;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('AddImages');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).AddImages(Value);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+function TPngImageList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then
+ if Image = nil then
+ Result := -1
+ else begin
+ BeginUpdate;
+ try
+ //Add a new PNG based on the image and a colored mask.
+ Item := FPngImages.Add(True);
+ CreatePNGMasked(Image, MaskColor, Item.FPngImage);
+ Result := Item.Index;
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('AddMasked');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ Result := TCustomImageList(Self).AddMasked(Image, MaskColor);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end
+ else
+ Result := -1;
+ end;
+end;
+
+{ TPngImageList }
+
+procedure TPngImageList.AssignTo(Dest: TPersistent);
+begin
+ inherited;
+ if Dest is TPngImageList then begin
+ TPngImageList(Dest).PngImages := FPngImages;
+ TPngImageList(Dest).EnabledImages := FEnabledImages;
+ end;
+end;
+
+procedure TPngImageList.BeginUpdate;
+begin
+ Inc(FLocked);
+end;
+
+procedure TPngImageList.Clear;
+var
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Clear the PngImages collection and the internal imagelist.
+ BeginUpdate;
+ try
+ FPngImages.Clear;
+ ImageList_Remove(Handle, -1);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Clear');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).Clear;
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.CopyPngs;
+var
+ I: Integer;
+ Png: TPngImage;
+ Icon: HIcon;
+begin
+ //Are we adding a bunch of images?
+ if FLocked > 0 then
+ Exit;
+
+ //Copy PNG images to the imagelist. These images will not be stored in the DFM.
+ ImageList_Remove(Handle, -1);
+ Handle := ImageList_Create(Width, Height, ILC_COLOR32 or (Integer(Masked) *
+ ILC_MASK), 0, AllocBy);
+
+ if not FEnabledImages and (FPngOptions <> []) then
+ Png := TPngImage.Create
+ else
+ Png := nil; //<- To prevent a compiler warning
+ try
+ for I := 0 to FPngImages.Count - 1 do begin
+ if TPngImageCollectionItem(FPngImages.Items[I]).PngImage = nil then
+ Continue;
+ if FEnabledImages or (FPngOptions = []) then
+ Icon := PngToIcon(FPngImages.Items[I].PngImage,
+ FPngImages.Items[I].Background)
+ else begin
+ //Basically the same as in the DrawPNG function
+ Png.Assign(TPngImageCollectionItem(FPngImages.Items[I]).PngImage);
+ if pngBlendOnDisabled in FPngOptions then
+ MakeImageBlended(Png);
+ if pngGrayscaleOnDisabled in FPngOptions then
+ MakeImageGrayscale(Png);
+ Icon := PngToIcon(Png);
+ end;
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ end;
+ finally
+ if not FEnabledImages and (FPngOptions <> []) then
+ Png.Free;
+ end;
+end;
+
+procedure TPngImageList.Delete(Index: Integer);
+var
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Delete an image from the PngImages collection and from the internal imagelist.
+ if (Index >= 0) and (Index < Count) then begin
+ BeginUpdate;
+ try
+ FPngImages.Delete(Index);
+ ImageList_Remove(Handle, Index);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Delete');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).Delete(Index);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+//--- End of patched methods ---
+
+procedure TPngImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
+var
+ PaintRect: TRect;
+ Options: TPngOptions;
+ Png: TPngImageCollectionItem;
+begin
+ //Draw a PNG directly to the Canvas. This is the preferred method to call,
+ //because this omits the API calls that use a fixed background.
+ PaintRect := Bounds(X, Y, Width, Height);
+ if Enabled then
+ Options := []
+ else
+ Options := FPngOptions;
+ Png := TPngImageCollectionItem(FPngImages.Items[Index]);
+ if Png <> nil then
+ DrawPNG(Png.PngImage, Canvas, PaintRect, Options);
+end;
+
+procedure TPngImageList.EndUpdate(Update: Boolean);
+begin
+ Dec(FLocked);
+ if Update and (FLocked = 0) then
+ CopyPngs;
+end;
+
+function TPngImageList.GetHeight: Integer;
+begin
+ Result := inherited Height;
+end;
+
+function TPngImageList.GetWidth: Integer;
+begin
+ Result := inherited Width;
+end;
+
+procedure TPngImageList.Insert(Index: Integer; Image, Mask: TBitmap);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Insert a new PNG based on the image and its mask.
+ if Image <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages.Insert(Index, True);
+ CreatePNG(Image, Mask, Item.FPngImage);
+ InsertPng(Index, Item.PngImage, Item.Background);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Insert');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).Insert(Index, Image, Mask);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.InsertIcon(Index: Integer; Image: TIcon);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Insert a new PNG based on the image.
+ if Image <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages.Insert(Index, True);
+ ConvertToPNG(Image, Item.FPngImage);
+ InsertPng(Index, Item.PngImage, Item.Background);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('InsertIcon');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).InsertIcon(Index, Image);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Insert a new PNG based on the image and a colored mask.
+ if Image <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages.Insert(Index, True);
+ CreatePNGMasked(Image, MaskColor, Item.FPngImage);
+ InsertPng(Index, Item.PngImage, Item.Background);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('InsertMasked');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).InsertMasked(Index, Image, MaskColor);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.InsertPng(Index: Integer; const Png: TPngImage; Background: TColor);
+var
+ I: Integer;
+ Icon: HICON;
+ TempList: TCustomImageList;
+begin
+ TempList := TCustomImageList.Create(nil);
+ try
+ TempList.Assign(Self);
+ ImageList_RemoveAll(Handle);
+ for I := 0 to Index - 1 do begin
+ Icon := ImageList_GetIcon(TempList.Handle, I, ILD_NORMAL);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ end;
+ Icon := PngToIcon(Png, Background);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ for I := Index to TempList.Count - 1 do begin
+ Icon := ImageList_GetIcon(TempList.Handle, I, ILD_NORMAL);
+ ImageList_AddIcon(Handle, Icon);
+ DestroyIcon(Icon);
+ end;
+ finally
+ TempList.Free;
+ end;
+end;
+
+procedure TPngImageList.Move(CurIndex, NewIndex: Integer);
+var
+ Patch: TMethodPatch;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Move an image from one position to another. Don't try doing so in the internal
+ //imagelist, just recreate it, since this method won't be called very often.
+ BeginUpdate;
+ try
+ ImageList_Remove(Handle, CurIndex);
+ InsertPng(NewIndex, FPngImages[CurIndex].PngImage,
+ FPngImages[CurIndex].Background);
+ FPngImages[CurIndex].Index := NewIndex;
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Move');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).Move(CurIndex, NewIndex);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+function TPngImageList.PngToIcon(const Png: TPngImage; Background: TColor): HICON;
+const
+ MaxRGBQuads = MaxInt div SizeOf(TRGBQuad) - 1;
+type
+ TRGBQuadArray = array[0..MaxRGBQuads] of TRGBQuad;
+ PRGBQuadArray = ^TRGBQuadArray;
+ TBitmapInfo4 = packed record
+ bmiHeader: TBitmapV4Header;
+ bmiColors: array[0..0] of TRGBQuad;
+ end;
+
+ function PngToIcon32(Png: TPngImage): HIcon;
+ var
+ ImageBits: PRGBQuadArray;
+ BitmapInfo: TBitmapInfo4;
+ IconInfo: TIconInfo;
+ AlphaBitmap: HBitmap;
+ MaskBitmap: TBitmap;
+ X, Y: Integer;
+ AlphaLine: PByteArray;
+ HasAlpha, HasBitmask: Boolean;
+ Color, TransparencyColor: TColor;
+ begin
+ //Convert a PNG object to an alpha-blended icon resource
+ ImageBits := nil;
+
+ //Allocate a DIB for the color data and alpha channel
+ with BitmapInfo.bmiHeader do begin
+ bV4Size := SizeOf(BitmapInfo.bmiHeader);
+ bV4Width := Png.Width;
+ bV4Height := Png.Height;
+ bV4Planes := 1;
+ bV4BitCount := 32;
+ bV4V4Compression := BI_BITFIELDS;
+ bV4SizeImage := 0;
+ bV4XPelsPerMeter := 0;
+ bV4YPelsPerMeter := 0;
+ bV4ClrUsed := 0;
+ bV4ClrImportant := 0;
+ bV4RedMask := $00FF0000;
+ bV4GreenMask := $0000FF00;
+ bV4BlueMask := $000000FF;
+ bV4AlphaMask := $FF000000;
+ end;
+ AlphaBitmap := CreateDIBSection(0, PBitmapInfo(@BitmapInfo)^,
+ DIB_RGB_COLORS, Pointer(ImageBits), 0, 0);
+ try
+ //Spin through and fill it with a wash of color and alpha.
+ AlphaLine := nil;
+ HasAlpha := Png.Header.ColorType in [COLOR_GRAYSCALEALPHA,
+ COLOR_RGBALPHA];
+ HasBitmask := Png.TransparencyMode = ptmBit;
+ TransparencyColor := Png.TransparentColor;
+ for Y := 0 to Png.Height - 1 do begin
+ if HasAlpha then
+ AlphaLine := Png.AlphaScanline[Png.Height - Y - 1];
+ for X := 0 to Png.Width - 1 do begin
+ Color := Png.Pixels[X, Png.Height - Y - 1];
+ ImageBits^[Y * Png.Width + X].rgbRed := Color and $FF;
+ ImageBits^[Y * Png.Width + X].rgbGreen := Color shr 8 and $FF;
+ ImageBits^[Y * Png.Width + X].rgbBlue := Color shr 16 and $FF;
+ if HasAlpha then
+ ImageBits^[Y * Png.Width + X].rgbReserved := AlphaLine^[X]
+ else if HasBitmask then
+ ImageBits^[Y * Png.Width + X].rgbReserved := Integer(Color <>
+ TransparencyColor) * 255;
+ end;
+ end;
+
+ //Create an empty mask
+ MaskBitmap := TBitmap.Create;
+ try
+ MaskBitmap.Width := Png.Width;
+ MaskBitmap.Height := Png.Height;
+ MaskBitmap.PixelFormat := pf1bit;
+ MaskBitmap.Canvas.Brush.Color := clBlack;
+ MaskBitmap.Canvas.FillRect(Rect(0, 0, MaskBitmap.Width,
+ MaskBitmap.Height));
+
+ //Create the alpha blended icon
+ IconInfo.fIcon := True;
+ IconInfo.hbmColor := AlphaBitmap;
+ IconInfo.hbmMask := MaskBitmap.Handle;
+ Result := CreateIconIndirect(IconInfo);
+ finally
+ MaskBitmap.Free;
+ end;
+ finally
+ DeleteObject(AlphaBitmap);
+ end;
+ end;
+
+ function PngToIcon24(Png: TPngImage; Background: TColor): HIcon;
+ var
+ ColorBitmap, MaskBitmap: TBitmap;
+ X, Y: Integer;
+ AlphaLine: PByteArray;
+ IconInfo: TIconInfo;
+ TransparencyColor: TColor;
+ begin
+ ColorBitmap := TBitmap.Create;
+ MaskBitmap := TBitmap.Create;
+ try
+ ColorBitmap.Width := Png.Width;
+ ColorBitmap.Height := Png.Height;
+ ColorBitmap.PixelFormat := pf32bit;
+ MaskBitmap.Width := Png.Width;
+ MaskBitmap.Height := Png.Height;
+ MaskBitmap.PixelFormat := pf32bit;
+
+ //Draw the color bitmap
+ ColorBitmap.Canvas.Brush.Color := Background;
+ ColorBitmap.Canvas.FillRect(Rect(0, 0, Png.Width, Png.Height));
+ Png.Draw(ColorBitmap.Canvas, Rect(0, 0, Png.Width, Png.Height));
+
+ //Create the mask bitmap
+ if Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then
+ for Y := 0 to Png.Height - 1 do begin
+ AlphaLine := Png.AlphaScanline[Y];
+ for X := 0 to Png.Width - 1 do
+ if AlphaLine^[X] = 0 then
+ SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clWhite)
+ else
+ SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clBlack);
+ end
+ else if Png.TransparencyMode = ptmBit then begin
+ TransparencyColor := Png.TransparentColor;
+ for Y := 0 to Png.Height - 1 do
+ for X := 0 to Png.Width - 1 do
+ if Png.Pixels[X, Y] = TransparencyColor then
+ SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clWhite)
+ else
+ SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clBlack);
+ end;
+
+ //Create the icon
+ IconInfo.fIcon := True;
+ IconInfo.hbmColor := ColorBitmap.Handle;
+ IconInfo.hbmMask := MaskBitmap.Handle;
+ Result := CreateIconIndirect(IconInfo);
+ finally
+ ColorBitmap.Free;
+ MaskBitmap.Free;
+ end;
+ end;
+
+begin
+ if GetComCtlVersion >= ComCtlVersionIE6 then begin
+ //Windows XP or later, using the modern method: convert every PNG to
+ //an icon resource with alpha channel
+ Result := PngToIcon32(Png);
+ end
+ else begin
+ //No Windows XP, using the legacy method: copy every PNG to a normal
+ //bitmap using a fixed background color
+ Result := PngToIcon24(Png, Background);
+ end;
+end;
+
+procedure TPngImageList.ReadData(Stream: TStream);
+begin
+ //Make sure nothing gets read from the DFM
+end;
+
+procedure TPngImageList.Replace(Index: Integer; Image, Mask: TBitmap);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Replace an existing PNG based with a new image and its mask.
+ if Image <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages[Index];
+ Item.FPngImage.Free;
+ CreatePNG(Image, Mask, Item.FPngImage);
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_ReplaceIcon(Handle, Index, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end;
+ end
+ else begin
+ Patch := FindMethodPatch('Replace');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).Replace(Index, Image, Mask);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.ReplaceIcon(Index: Integer; Image: TIcon);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Replace an existing PNG based with a new image.
+ if Image <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages[Index];
+ Item.FPngImage.Free;
+ ConvertToPNG(Image, Item.FPngImage);
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_ReplaceIcon(Handle, Index, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end
+ end
+ else begin
+ Patch := FindMethodPatch('ReplaceIcon');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).ReplaceIcon(Index, Image);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
+var
+ Item: TPngImageCollectionItem;
+ Patch: TMethodPatch;
+ Icon: HICON;
+begin
+ if TObject(Self) is TPngImageList then begin
+ //Replace an existing PNG based with a new image and a colored mask.
+ if NewImage <> nil then begin
+ BeginUpdate;
+ try
+ Item := FPngImages[Index];
+ Item.FPngImage.Free;
+ CreatePNGMasked(NewImage, MaskColor, Item.FPngImage);
+ Icon := PngToIcon(Item.PngImage, Item.Background);
+ ImageList_ReplaceIcon(Handle, Index, Icon);
+ DestroyIcon(Icon);
+ Change;
+ finally
+ EndUpdate(False);
+ end;
+ end
+ end
+ else begin
+ Patch := FindMethodPatch('ReplaceMasked');
+ if Patch <> nil then begin
+ Patch.BeginInvokeOldMethod;
+ try
+ TCustomImageList(Self).ReplaceMasked(Index, NewImage, MaskColor);
+ finally
+ Patch.FinishInvokeOldMethod;
+ end;
+ end;
+ end;
+end;
+
+procedure TPngImageList.SetEnabledImages(const Value: Boolean);
+begin
+ if FEnabledImages xor Value then begin
+ FEnabledImages := Value;
+ CopyPngs;
+ end;
+end;
+
+procedure TPngImageList.SetHeight(const Value: Integer);
+begin
+ if inherited Height <> Value then begin
+ inherited Height := Value;
+ Clear;
+ end;
+end;
+
+procedure TPngImageList.SetPngImages(const Value: TPngImageCollectionItems);
+begin
+ if FPngImages <> Value then begin
+ FPngImages.Assign(Value);
+ Change;
+ end;
+end;
+
+procedure TPngImageList.SetPngOptions(const Value: TPngOptions);
+begin
+ if FPngOptions <> Value then begin
+ FPngOptions := Value;
+ CopyPngs;
+ end;
+end;
+
+procedure TPngImageList.SetWidth(const Value: Integer);
+begin
+ if inherited Width <> Value then begin
+ inherited Width := Value;
+ Clear;
+ end;
+end;
+
+procedure TPngImageList.WriteData(Stream: TStream);
+begin
+ //Make sure nothing gets written to the DFM
+end;
+
+{ TPngImageCollection }
+
+constructor TPngImageCollection.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FItems := TPngImageCollectionItems.Create(Self);
+end;
+
+destructor TPngImageCollection.Destroy;
+begin
+ FItems.Free;
+ inherited Destroy;
+end;
+
+{ TPngImageCollectionItems }
+
+constructor TPngImageCollectionItems.Create(AOwner: TPersistent);
+begin
+ inherited Create(TPngImageCollectionItem);
+ FOwner := AOwner;
+end;
+
+function TPngImageCollectionItems.Add(DontCreatePNG: Boolean = False): TPngImageCollectionItem;
+begin
+ {$WARN SYMBOL_DEPRECATED OFF}
+ Result := TPngImageCollectionItem.Create(Self, DontCreatePNG);
+ Added(TCollectionItem(Result));
+end;
+
+procedure TPngImageCollectionItems.Assign(Source: TPersistent);
+begin
+ inherited Assign(Source);
+ Update(nil);
+end;
+
+function TPngImageCollectionItems.GetItem(Index: Integer): TPngImageCollectionItem;
+begin
+ if (Index >= 0) and (Index < Count) then
+ Result := TPngImageCollectionItem(inherited Items[Index])
+ else
+ Result := nil;
+end;
+
+function TPngImageCollectionItems.GetOwner: TPersistent;
+begin
+ Result := FOwner;
+end;
+
+function TPngImageCollectionItems.Insert(Index: Integer; DontCreatePNG: Boolean = False): TPngImageCollectionItem;
+begin
+ Result := Add(DontCreatePNG);
+ Result.Index := Index;
+end;
+
+procedure TPngImageCollectionItems.SetItem(Index: Integer; const Value: TPngImageCollectionItem);
+begin
+ if (Index >= 0) and (Index < Count) then
+ inherited Items[Index] := Value;
+end;
+
+procedure TPngImageCollectionItems.Update(Item: TCollectionItem);
+begin
+ inherited Update(Item);
+ if FOwner is TPngImageList then
+ TPngImageList(FOwner).CopyPngs;
+end;
+
+constructor TPngImageCollectionItem.Create(Collection: TCollection);
+begin
+ inherited Create(Collection);
+ FPngImage := TPngImage.Create;
+ FName := Format('PngImage%d', [Index]);
+ FBackground := clBtnFace;
+end;
+
+constructor TPngImageCollectionItem.Create(Collection: TCollection; DontCreatePNG: Boolean = False);
+begin
+ inherited Create(Collection);
+ if DontCreatePng then
+ FPngImage := nil
+ else
+ FPngImage := TPngImage.Create;
+ FName := Format('PngImage%d', [Index]);
+ FBackground := clBtnFace;
+end;
+
+destructor TPngImageCollectionItem.Destroy;
+begin
+ FPngImage.Free;
+ inherited Destroy;
+end;
+
+procedure TPngImageCollectionItem.Assign(Source: TPersistent);
+begin
+ if Source is TPngImageCollectionItem then begin
+ PngImage.Assign(TPngImageCollectionItem(Source).PngImage);
+ Background := TPngImageCollectionItem(Source).Background;
+ Name := TPngImageCollectionItem(Source).Name;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+{ TPngImageCollectionItem }
+
+procedure TPngImageCollectionItem.AssignTo(Dest: TPersistent);
+begin
+ inherited AssignTo(Dest);
+ if (Dest is TPngImageCollectionItem) then
+ TPngImageCollectionItem(Dest).PngImage := PngImage;
+end;
+
+function TPngImageCollectionItem.Duplicate: TPngImage;
+begin
+ Result := TPngImage.Create;
+ Result.Assign(FPngImage);
+end;
+
+function TPngImageCollectionItem.GetDisplayName: string;
+begin
+ if Length(FName) = 0 then
+ Result := inherited GetDisplayName
+ else
+ Result := FName;
+end;
+
+procedure TPngImageCollectionItem.SetBackground(const Value: TColor);
+begin
+ if FBackground <> Value then begin
+ FBackground := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TPngImageCollectionItem.SetPngImage(const Value: TPngImage);
+begin
+ FPngImage.Assign(Value);
+ Changed(False);
+end;
+
+initialization
+
+finalization
+ MethodPatches.Free;
+
+end.
+
diff --git a/official/1.2.0/Source/PngSpeedButton.pas b/official/1.2.0/Source/PngSpeedButton.pas
new file mode 100644
index 0000000..3846d97
--- /dev/null
+++ b/official/1.2.0/Source/PngSpeedButton.pas
@@ -0,0 +1,147 @@
+unit PngSpeedButton;
+
+interface
+
+uses
+ Windows, Classes, Buttons, pngimage, PngFunctions;
+
+type
+ TPngSpeedButton = class(TSpeedButton)
+ private
+ FPngImage: TPngImage;
+ FPngOptions: TPngOptions;
+ FImageFromAction: Boolean;
+ function PngImageStored: Boolean;
+ procedure SetPngImage(const Value: TPngImage);
+ procedure SetPngOptions(const Value: TPngOptions);
+ procedure CreatePngGlyph;
+ protected
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure Paint; override;
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property PngImage: TPngImage read FPngImage write SetPngImage stored PngImageStored;
+ property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
+ property Glyph stored False;
+ property NumGlyphs stored False;
+ end;
+
+implementation
+
+uses
+ Graphics, ActnList, PngButtonFunctions;
+
+{ TPngSpeedButton }
+
+constructor TPngSpeedButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPngImage := TPngImage.Create;
+ FPngOptions := [pngBlendOnDisabled];
+ FImageFromAction := False;
+end;
+
+destructor TPngSpeedButton.Destroy;
+begin
+ FPngImage.Free;
+ inherited Destroy;
+end;
+
+procedure TPngSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ inherited ActionChange(Sender, CheckDefaults);
+ if Sender is TCustomAction then
+ with TCustomAction(Sender) do begin
+ //Copy image from action's imagelist
+ if (PngImage.Empty or FImageFromAction) and (ActionList <> nil) and
+ (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex <
+ ActionList.Images.Count) then begin
+ CopyImageFromImageList(FPngImage, ActionList.Images, ImageIndex);
+ CreatePngGlyph;
+ FImageFromAction := True;
+ end;
+ end;
+end;
+
+procedure TPngSpeedButton.Paint;
+var
+ PaintRect: TRect;
+ GlyphPos, TextPos: TPoint;
+begin
+ inherited Paint;
+
+ if FPngImage <> nil then begin
+ //Calculate the position of the PNG glyph
+ CalcButtonLayout(Canvas, FPngImage, ClientRect, FState = bsDown, Down,
+ Caption, Layout, Margin, Spacing, GlyphPos, TextPos, DrawTextBiDiModeFlags(0));
+ PaintRect := Bounds(GlyphPos.X, GlyphPos.Y, FPngImage.Width, FPngImage.Height);
+
+ if Enabled then
+ DrawPNG(FPngImage, Canvas, PaintRect, [])
+ else
+ DrawPNG(FPngImage, Canvas, PaintRect, FPngOptions);
+ end;
+end;
+
+procedure TPngSpeedButton.Loaded;
+begin
+ inherited Loaded;
+ CreatePngGlyph;
+end;
+
+function TPngSpeedButton.PngImageStored: Boolean;
+begin
+ Result := not FImageFromAction;
+end;
+
+procedure TPngSpeedButton.SetPngImage(const Value: TPngImage);
+begin
+ //This is all neccesary, because you can't assign a nil to a TPngImage
+ if Value = nil then begin
+ FPngImage.Free;
+ FPngImage := TPngImage.Create;
+ end
+ else
+ FPngImage.Assign(Value);
+
+ //To work around the gamma-problem
+ with FPngImage do
+ if Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA, COLOR_PALETTE] then
+ Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
+
+ FImageFromAction := False;
+ CreatePngGlyph;
+ Repaint;
+end;
+
+procedure TPngSpeedButton.SetPngOptions(const Value: TPngOptions);
+begin
+ if FPngOptions <> Value then begin
+ FPngOptions := Value;
+ CreatePngGlyph;
+ Repaint;
+ end;
+end;
+
+procedure TPngSpeedButton.CreatePngGlyph;
+var
+ Bmp: TBitmap;
+begin
+ //Create an empty glyph, just to align the text correctly
+ Bmp := TBitmap.Create;
+ try
+ Bmp.Width := FPngImage.Width;
+ Bmp.Height := FPngImage.Height;
+ Bmp.Canvas.Brush.Color := clBtnFace;
+ Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
+ Glyph.Assign(Bmp);
+ NumGlyphs := 1;
+ finally
+ Bmp.Free;
+ end;
+end;
+
+end.
+ 
+ 
+ 
+ 