mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-14 05:41:16 +02:00
lcl: implement .icns (osx icon resource) graphic reader
git-svn-id: trunk@15612 -
This commit is contained in:
paul
parent
fb5d6501e3
commit
145033569a
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -2811,6 +2811,7 @@ lcl/graphtype.pp svneol=native#text/pascal
|
||||
lcl/graphutil.pp svneol=native#text/pascal
|
||||
lcl/grids.pas svneol=native#text/pascal
|
||||
lcl/helpintfs.pas svneol=native#text/plain
|
||||
lcl/icnstypes.pas svneol=native#text/pascal
|
||||
lcl/imagelistcache.pas svneol=native#text/pascal
|
||||
lcl/images/README.txt svneol=native#text/plain
|
||||
lcl/images/btncalccancel.xpm -text svneol=native#image/x-xpixmap
|
||||
@ -2963,6 +2964,7 @@ lcl/include/graphiccontrol.inc svneol=native#text/pascal
|
||||
lcl/include/graphicsobject.inc svneol=native#text/pascal
|
||||
lcl/include/headercontrol.inc svneol=native#text/pascal
|
||||
lcl/include/hintwindow.inc svneol=native#text/pascal
|
||||
lcl/include/icnsicon.inc svneol=native#text/pascal
|
||||
lcl/include/icon.inc svneol=native#text/pascal
|
||||
lcl/include/idletimer.inc svneol=native#text/pascal
|
||||
lcl/include/imglist.inc svneol=native#text/pascal
|
||||
|
||||
@ -42,7 +42,7 @@ uses
|
||||
IntfGraphics,
|
||||
AvgLvlTree,
|
||||
LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
|
||||
GraphType, GraphMath, InterfaceBase, WSReferences;
|
||||
GraphType, IcnsTypes, GraphMath, InterfaceBase, WSReferences;
|
||||
|
||||
|
||||
type
|
||||
@ -1489,6 +1489,8 @@ type
|
||||
property Current: Integer read FCurrent write SetCurrent;
|
||||
property Count: Integer read GetCount;
|
||||
end;
|
||||
|
||||
{ TIcon }
|
||||
|
||||
TIcon = class(TCustomIcon)
|
||||
private
|
||||
@ -1500,6 +1502,45 @@ type
|
||||
function ReleaseHandle: HICON;
|
||||
property Handle: HICON read GetIconHandle write SetIconHandle;
|
||||
end;
|
||||
|
||||
TIcnsRec = record
|
||||
IconType: TicnsIconType;
|
||||
RawImage: TRawImage;
|
||||
end;
|
||||
PIcnsRec = ^TIcnsRec;
|
||||
|
||||
{ TIcnsList }
|
||||
|
||||
TIcnsList = class(TList)
|
||||
private
|
||||
function GetItem(Index: Integer): PIcnsRec;
|
||||
procedure SetItem(Index: Integer; const AValue: PIcnsRec);
|
||||
protected
|
||||
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
||||
public
|
||||
function Add(AIconType: TicnsIconType; ARawImage: TRawImage): Integer; reintroduce;
|
||||
property Items[Index: Integer]: PIcnsRec read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
{ TIcnsIcon }
|
||||
|
||||
TIcnsIcon = class(TCustomIcon)
|
||||
private
|
||||
FImageList: TIcnsList;
|
||||
FMaskList: TIcnsList;
|
||||
procedure IcnsAdd(AIconType: TicnsIconType; ARawImage: TRawImage);
|
||||
procedure IcnsProcess;
|
||||
protected
|
||||
procedure ReadData(Stream: TStream); override;
|
||||
procedure ReadStream(AStream: TMemoryStream; ASize: Longint); override;
|
||||
procedure WriteStream(AStream: TMemoryStream); override;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
class function GetFileExtensions: string; override;
|
||||
function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
|
||||
end;
|
||||
|
||||
{ TSharedCursorImage }
|
||||
|
||||
@ -2173,6 +2214,7 @@ end;
|
||||
{$I jpegimage.inc}
|
||||
{$I cursorimage.inc}
|
||||
{$I icon.inc}
|
||||
{$I icnsicon.inc}
|
||||
{$I fpimagebitmap.inc}
|
||||
{$I bitmap.inc}
|
||||
|
||||
|
||||
252
lcl/icnstypes.pas
Normal file
252
lcl/icnstypes.pas
Normal file
@ -0,0 +1,252 @@
|
||||
{ $Id$ }
|
||||
{
|
||||
/***************************************************************************
|
||||
IcnsTypes.pas
|
||||
---------------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Author: Paul Ishenin
|
||||
|
||||
Abstract:
|
||||
Types, consts and functions we need to read MAC osx icon resource files - icns
|
||||
Most defines present here were taken from univint package of fpc
|
||||
}
|
||||
unit IcnsTypes;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
FourCharCode = array[0..3] of char;
|
||||
|
||||
type
|
||||
TIconFamilyElement = record
|
||||
elementType: FourCharCode; { 'ICN#', 'icl8', etc... }
|
||||
elementSize: LongInt; { Size of this element }
|
||||
end;
|
||||
|
||||
TIconFamilyResource = record
|
||||
resourceType: FourCharCode; { Always 'icns' }
|
||||
resourceSize: LongInt; { Total size of this resource }
|
||||
end;
|
||||
|
||||
const
|
||||
kIconFamilyType = 'icns';
|
||||
|
||||
kIconServices512PixelDataARGB: FourCharCode = 'ic09';
|
||||
kIconServices256PixelDataARGB: FourCharCode = 'ic08';
|
||||
kThumbnail32BitData : FourCharCode = 'it32';
|
||||
kThumbnail8BitMask : FourCharCode = 't8mk';
|
||||
kHuge1BitMask : FourCharCode = 'ich#';
|
||||
kHuge4BitData : FourCharCode = 'ich4';
|
||||
kHuge8BitData : FourCharCode= 'ich8';
|
||||
kHuge32BitData : FourCharCode= 'ih32';
|
||||
kHuge8BitMask : FourCharCode= 'h8mk';
|
||||
{ The following icon types can be used as a resource type }
|
||||
{ or as an icon element type inside a 'icns' icon family }
|
||||
kLarge1BitMask : FourCharCode= 'ICN#';
|
||||
kLarge4BitData : FourCharCode= 'icl4';
|
||||
kLarge8BitData : FourCharCode= 'icl8';
|
||||
kLarge32BitData : FourCharCode= 'il32';
|
||||
kLarge8BitMask : FourCharCode= 'l8mk';
|
||||
kSmall1BitMask : FourCharCode= 'ics#';
|
||||
kSmall4BitData : FourCharCode= 'ics4';
|
||||
kSmall8BitData : FourCharCode= 'ics8';
|
||||
kSmall32BitData : FourCharCode= 'is32';
|
||||
kSmall8BitMask : FourCharCode= 's8mk';
|
||||
kMini1BitMask : FourCharCode= 'icm#';
|
||||
kMini4BitData : FourCharCode= 'icm4';
|
||||
kMini8BitData : FourCharCode= 'icm8';
|
||||
|
||||
type
|
||||
// from lower to higher
|
||||
TicnsIconType =
|
||||
(
|
||||
iitNone,
|
||||
// data icons
|
||||
iitMini4BitData,
|
||||
iitMini8BitData,
|
||||
iitSmall4BitData,
|
||||
iitSmall8BitData,
|
||||
iitSmall32BitData,
|
||||
iitLarge4BitData,
|
||||
iitLarge8BitData,
|
||||
iitLarge32BitData,
|
||||
iitHuge4BitData,
|
||||
iitHuge8BitData,
|
||||
iitHuge32BitData,
|
||||
iitThumbnail32BitData,
|
||||
// mask icons
|
||||
iitMini1BitMask,
|
||||
iitSmall1BitMask,
|
||||
iitSmall8BitMask,
|
||||
iitLarge1BitMask,
|
||||
iitLarge8BitMask,
|
||||
iitHuge1BitMask,
|
||||
iitHuge8BitMask,
|
||||
iitThumbnail8BitMask,
|
||||
// alpha icons
|
||||
iit256PixelDataARGB,
|
||||
iit512PixelDataARGB
|
||||
);
|
||||
|
||||
TicnsIconTypes = set of TicnsIconType;
|
||||
|
||||
TicnsIconInfo = record
|
||||
Width: Integer;
|
||||
Height: Integer;
|
||||
Depth: Integer;
|
||||
end;
|
||||
|
||||
const
|
||||
icnsDataTypes =
|
||||
[
|
||||
iitMini4BitData, iitMini8BitData, iitSmall4BitData, iitSmall8BitData,
|
||||
iitSmall32BitData, iitLarge4BitData, iitLarge8BitData, iitLarge32BitData,
|
||||
iitHuge4BitData, iitHuge8BitData, iitHuge32BitData, iitThumbnail32BitData
|
||||
];
|
||||
icnsMaskTypes =
|
||||
[
|
||||
iitMini1BitMask, iitSmall1BitMask, iitSmall8BitMask, iitLarge1BitMask,
|
||||
iitLarge8BitMask, iitHuge1BitMask, iitHuge8BitMask, iitThumbnail8BitMask
|
||||
];
|
||||
icnsRGB =
|
||||
[
|
||||
iitSmall32BitData, iitLarge32BitData, iitHuge32BitData, iitThumbnail32BitData
|
||||
];
|
||||
icnsWithAlpha =
|
||||
[
|
||||
iit256PixelDataARGB, iit512PixelDataARGB
|
||||
];
|
||||
|
||||
icnsIconTypeInfo: array[TicnsIconType] of TicnsIconInfo =
|
||||
(
|
||||
{ iitNone } (Width: 000; Height: 000; Depth: 00),
|
||||
{ iitMini4BitData } (Width: 016; Height: 012; Depth: 04),
|
||||
{ iitMini8BitData } (Width: 016; Height: 012; Depth: 08),
|
||||
{ iitSmall4BitData } (Width: 016; Height: 016; Depth: 04),
|
||||
{ iitSmall8BitData } (Width: 016; Height: 016; Depth: 08),
|
||||
{ iitSmall32BitData } (Width: 016; Height: 016; Depth: 32),
|
||||
{ iitLarge4BitData } (Width: 032; Height: 032; Depth: 04),
|
||||
{ iitLarge8BitData } (Width: 032; Height: 032; Depth: 08),
|
||||
{ iitLarge32BitData } (Width: 032; Height: 032; Depth: 32),
|
||||
{ iitHuge4BitData } (Width: 048; Height: 048; Depth: 04),
|
||||
{ iitHuge8BitData } (Width: 048; Height: 048; Depth: 08),
|
||||
{ iitHuge32BitData } (Width: 048; Height: 048; Depth: 32),
|
||||
{ iitThumbnail32BitData } (Width: 128; Height: 128; Depth: 32),
|
||||
{ iitMini1BitMask } (Width: 016; Height: 012; Depth: 01),
|
||||
{ iitSmall1BitMask } (Width: 016; Height: 016; Depth: 01),
|
||||
{ iitSmall8BitMask } (Width: 016; Height: 016; Depth: 08),
|
||||
{ iitLarge1BitMask } (Width: 032; Height: 032; Depth: 01),
|
||||
{ iitLarge8BitMask } (Width: 032; Height: 032; Depth: 08),
|
||||
{ iitHuge1BitMask } (Width: 048; Height: 048; Depth: 01),
|
||||
{ iitHuge8BitMask } (Width: 048; Height: 048; Depth: 08),
|
||||
{ iitThumbnail8BitMask } (Width: 128; Height: 128; Depth: 08),
|
||||
{ iit256PixelDataARGB } (Width: 256; Height: 256; Depth: 32),
|
||||
{ iit512PixelDataARGB } (Width: 512; Height: 512; Depth: 32)
|
||||
);
|
||||
|
||||
icnsMaskToImageMap: array[iitMini1BitMask..iitThumbnail8BitMask] of TicnsIconTypes =
|
||||
(
|
||||
{ iitMini1BitMask } [iitMini4BitData, iitMini8BitData],
|
||||
{ iitSmall1BitMask } [iitSmall4BitData, iitSmall8BitData, iitSmall32BitData],
|
||||
{ iitSmall8BitMask } [iitSmall4BitData, iitSmall8BitData, iitSmall32BitData],
|
||||
{ iitLarge1BitMask } [iitLarge4BitData, iitLarge8BitData, iitLarge32BitData],
|
||||
{ iitLarge8BitMask } [iitLarge4BitData, iitLarge8BitData, iitLarge32BitData],
|
||||
{ iitHuge1BitMask } [iitHuge4BitData, iitHuge8BitData, iitHuge32BitData],
|
||||
{ iitHuge8BitMask } [iitHuge4BitData, iitHuge8BitData, iitHuge32BitData],
|
||||
{ iitThumbnail8BitMask } [iitThumbnail32BitData]
|
||||
);
|
||||
|
||||
function GetIcnsIconType(StrIconType: FourCharCode): TicnsIconType;
|
||||
|
||||
implementation
|
||||
|
||||
function GetIcnsIconType(StrIconType: FourCharCode): TicnsIconType;
|
||||
begin
|
||||
Result := iitNone;
|
||||
|
||||
if StrIconType = kMini4BitData then
|
||||
exit(iitMini4BitData);
|
||||
|
||||
if StrIconType = kMini8BitData then
|
||||
exit(iitMini8BitData);
|
||||
|
||||
if StrIconType = kSmall4BitData then
|
||||
exit(iitSmall4BitData);
|
||||
|
||||
if StrIconType = kSmall8BitData then
|
||||
exit(iitSmall8BitData);
|
||||
|
||||
if StrIconType = kSmall32BitData then
|
||||
exit(iitSmall32BitData);
|
||||
|
||||
if StrIconType = kLarge4BitData then
|
||||
exit(iitLarge4BitData);
|
||||
|
||||
if StrIconType = kLarge8BitData then
|
||||
exit(iitLarge8BitData);
|
||||
|
||||
if StrIconType = kLarge32BitData then
|
||||
exit(iitLarge32BitData);
|
||||
|
||||
if StrIconType = kHuge4BitData then
|
||||
exit(iitHuge4BitData);
|
||||
|
||||
if StrIconType = kHuge8BitData then
|
||||
exit(iitHuge8BitData);
|
||||
|
||||
if StrIconType = kHuge32BitData then
|
||||
exit(iitHuge32BitData);
|
||||
|
||||
if StrIconType = kThumbnail32BitData then
|
||||
exit(iitThumbnail32BitData);
|
||||
|
||||
if StrIconType = kMini1BitMask then
|
||||
exit(iitMini1BitMask);
|
||||
|
||||
if StrIconType = kSmall1BitMask then
|
||||
exit(iitSmall1BitMask);
|
||||
|
||||
if StrIconType = kSmall8BitMask then
|
||||
exit(iitSmall8BitMask);
|
||||
|
||||
if StrIconType = kLarge1BitMask then
|
||||
exit(iitLarge1BitMask);
|
||||
|
||||
if StrIconType = kLarge8BitMask then
|
||||
exit(iitLarge8BitMask);
|
||||
|
||||
if StrIconType = kHuge1BitMask then
|
||||
exit(iitHuge1BitMask);
|
||||
|
||||
if StrIconType = kHuge8BitMask then
|
||||
exit(iitHuge8BitMask);
|
||||
|
||||
if StrIconType = kThumbnail8BitMask then
|
||||
exit(iitThumbnail8BitMask);
|
||||
|
||||
if StrIconType = kIconServices256PixelDataARGB then
|
||||
exit(iit256PixelDataARGB);
|
||||
|
||||
if StrIconType = kIconServices512PixelDataARGB then
|
||||
exit(iit512PixelDataARGB);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
246
lcl/include/icnsicon.inc
Normal file
246
lcl/include/icnsicon.inc
Normal file
@ -0,0 +1,246 @@
|
||||
{%MainUnit ../graphics.pp}
|
||||
|
||||
{******************************************************************************
|
||||
TicnsIcon
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{ TIcnsList }
|
||||
|
||||
function TIcnsList.GetItem(Index: Integer): PIcnsRec;
|
||||
begin
|
||||
Result := inherited Get(Index);
|
||||
end;
|
||||
|
||||
procedure TIcnsList.SetItem(Index: Integer; const AValue: PIcnsRec);
|
||||
begin
|
||||
inherited Put(Index, AValue);
|
||||
end;
|
||||
|
||||
procedure TIcnsList.Notify(Ptr: Pointer; Action: TListNotification);
|
||||
begin
|
||||
if Action = lnDeleted then
|
||||
Dispose(PIcnsRec(Ptr));
|
||||
inherited Notify(Ptr, Action);
|
||||
end;
|
||||
|
||||
function TIcnsList.Add(AIconType: TicnsIconType; ARawImage: TRawImage): Integer;
|
||||
var
|
||||
Rec: PIcnsRec;
|
||||
begin
|
||||
New(Rec);
|
||||
Rec^.IconType := AIconType;
|
||||
Rec^.RawImage := ARawImage;
|
||||
Result := inherited Add(Rec);
|
||||
end;
|
||||
|
||||
{ TIcnsIcon }
|
||||
|
||||
procedure TIcnsIcon.IcnsAdd(AIconType: TicnsIconType; ARawImage: TRawImage);
|
||||
|
||||
function GetMaskList: TIcnsList;
|
||||
begin
|
||||
if FMaskList = nil then
|
||||
FMaskList := TIcnsList.Create;
|
||||
Result := FMaskList;
|
||||
end;
|
||||
|
||||
function GetImageList: TIcnsList;
|
||||
begin
|
||||
if FImageList = nil then
|
||||
FImageList := TIcnsList.Create;
|
||||
Result := FImageList;
|
||||
end;
|
||||
|
||||
begin
|
||||
if AIconType in icnsMaskTypes
|
||||
then GetMaskList.Add(AIconType, ARawImage)
|
||||
else GetImageList.Add(AIconType, ARawImage);
|
||||
end;
|
||||
|
||||
procedure TIcnsIcon.IcnsProcess;
|
||||
|
||||
procedure MergeMask(var AImage, AMask: TRawImage);
|
||||
var
|
||||
LazIntfImage, LazIntfMask: TLazIntfImage;
|
||||
Col, Row: Integer;
|
||||
Color: TFpColor;
|
||||
begin
|
||||
if AMask.Description.Depth = 1 then
|
||||
begin
|
||||
// merge mask
|
||||
AImage.Description.MaskBitOrder := AMask.Description.MaskBitOrder;
|
||||
AImage.Description.MaskLineEnd := AMask.Description.MaskLineEnd;
|
||||
AImage.Description.MaskBitsPerPixel := AMask.Description.MaskBitsPerPixel;
|
||||
AImage.Description.MaskShift := AMask.Description.MaskShift;
|
||||
AImage.MaskSize := AMask.MaskSize;
|
||||
AImage.Mask := ReallocMem(AImage.Mask, AMask.MaskSize);
|
||||
Move(AMask.Mask^, AImage.Mask^, AMask.MaskSize);
|
||||
end
|
||||
else
|
||||
begin
|
||||
LazIntfImage := TLazIntfImage.Create(AImage, False);
|
||||
LazIntfMask := TLazIntfImage.Create(AMask, False);
|
||||
for Row := 0 to LazIntfImage.Height - 1 do
|
||||
for Col := 0 to LazIntfImage.Width - 1 do
|
||||
begin
|
||||
Color := LazIntfImage.Colors[Col,Row];
|
||||
Color.alpha := LazIntfMask.Colors[Col,Row].alpha;
|
||||
LazIntfImage.Colors[Col,Row] := Color;
|
||||
end;
|
||||
LazIntfMask.Free;
|
||||
LazIntfImage.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i, AIndex: integer;
|
||||
IconType: TicnsIconType;
|
||||
ImagesForMask: TicnsIconTypes;
|
||||
IconImage: TIconImage;
|
||||
begin
|
||||
// merge separate image and masc rawdata together
|
||||
|
||||
if FMaskList <> nil then
|
||||
begin
|
||||
for i := 0 to FMaskList.Count - 1 do
|
||||
begin
|
||||
ImagesForMask := icnsMaskToImageMap[FMaskList[i]^.IconType];
|
||||
for AIndex := 0 to FImageList.Count - 1 do
|
||||
if FImageList[AIndex]^.IconType in ImagesForMask then
|
||||
MergeMask(FImageList[AIndex]^.RawImage, FMaskList[i]^.RawImage);
|
||||
// dispose RawImage since no more needed
|
||||
FMaskList[i]^.RawImage.FreeData;
|
||||
end;
|
||||
FreeAndNil(FMaskList);
|
||||
end;
|
||||
|
||||
IconType := iitNone;
|
||||
for i := 0 to FImageList.Count - 1 do
|
||||
begin
|
||||
// todo: we have no jpeg 2000 reader to decompress their data => skip for now
|
||||
if FImageList[i]^.IconType in icnsWithAlpha then
|
||||
Continue;
|
||||
|
||||
// Add image
|
||||
with TSharedIcon(FSharedImage) do
|
||||
begin
|
||||
IconImage := GetImagesClass.Create(FImageList[i]^.RawImage);
|
||||
Add(IconImage);
|
||||
end;
|
||||
if FImageList[i]^.IconType > IconType then
|
||||
begin
|
||||
IconType := FImageList[i]^.IconType;
|
||||
FCurrent := TSharedIcon(FSharedImage).Count - 1;
|
||||
end;
|
||||
end;
|
||||
FreeAndNil(FImageList);
|
||||
end;
|
||||
|
||||
constructor TIcnsIcon.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FImageList := nil;
|
||||
FMaskList := nil;
|
||||
end;
|
||||
|
||||
destructor TIcnsIcon.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FImageList.Free;
|
||||
FMaskList.Free;
|
||||
end;
|
||||
|
||||
procedure TIcnsIcon.ReadData(Stream: TStream);
|
||||
var
|
||||
Resource: TIconFamilyResource;
|
||||
Position: Int64;
|
||||
begin
|
||||
Position := Stream.Position;
|
||||
Stream.Read(Resource, SizeOf(Resource));
|
||||
if Resource.resourceType = kIconFamilyType then
|
||||
begin
|
||||
Stream.Position := Position;
|
||||
LoadFromStream(Stream, BEtoN(Resource.resourceSize))
|
||||
end else
|
||||
begin
|
||||
Stream.Position := Position;
|
||||
LoadFromStream(Stream);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIcnsIcon.ReadStream(AStream: TMemoryStream; ASize: Longint);
|
||||
var
|
||||
Resource: TIconFamilyResource;
|
||||
|
||||
IntfImage: TLazIntfImage;
|
||||
ImgReader: TLazReaderIcnsPart;
|
||||
LazReader: ILazImageReader;
|
||||
RawImage: TRawImage;
|
||||
begin
|
||||
AStream.Read(Resource, SizeOf(Resource));
|
||||
|
||||
if (Resource.resourceType <> kIconFamilyType) then
|
||||
raise EInvalidGraphic.Create('Stream is not an ICNS type');
|
||||
|
||||
IntfImage := nil;
|
||||
ImgReader := nil;
|
||||
|
||||
Resource.resourceSize := BEtoN(Resource.resourceSize);
|
||||
|
||||
if ASize > Resource.resourceSize then
|
||||
ASize := Resource.resourceSize;
|
||||
|
||||
while AStream.Position < ASize do
|
||||
begin
|
||||
if IntfImage = nil
|
||||
then IntfImage := TLazIntfImage.Create(0,0)
|
||||
else IntfImage.SetSize(0,0);
|
||||
|
||||
if ImgReader = nil
|
||||
then ImgReader := TLazReaderIcnsPart.Create;
|
||||
|
||||
if Supports(ImgReader, ILazImageReader, LazReader)
|
||||
then LazReader.UpdateDescription := True
|
||||
else IntfImage.DataDescription := QueryDescription([riqfRGB, riqfAlpha, riqfMask]); // fallback to default
|
||||
|
||||
ImgReader.ImageRead(AStream, IntfImage);
|
||||
IntfImage.GetRawImage(RawImage, True);
|
||||
|
||||
IcnsAdd(ImgReader.IconType, RawImage);
|
||||
end;
|
||||
|
||||
LazReader := nil;
|
||||
IntfImage.Free;
|
||||
ImgReader.Free;
|
||||
|
||||
IcnsProcess;
|
||||
end;
|
||||
|
||||
procedure TIcnsIcon.WriteStream(AStream: TMemoryStream);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
class function TIcnsIcon.GetFileExtensions: string;
|
||||
begin
|
||||
Result := 'icns';
|
||||
end;
|
||||
|
||||
function TIcnsIcon.LazarusResourceTypeValid(const ResourceType: string): boolean;
|
||||
begin
|
||||
Result := (UpperCase(ResourceType) = 'ICNS');
|
||||
end;
|
||||
@ -32,7 +32,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpImage, FPReadBMP, BMPComn, FPCAdds, AvgLvlTree, LCLType,
|
||||
LCLProc, GraphType, LCLIntf, FPReadPNG;
|
||||
LCLProc, GraphType, LCLIntf, FPReadPNG, IcnsTypes;
|
||||
|
||||
type
|
||||
{ TLazIntfImage }
|
||||
@ -515,6 +515,39 @@ type
|
||||
property UpdateDescription: Boolean read GetUpdateDescription write SetUpdateDescription;
|
||||
end;
|
||||
|
||||
{ TLazReaderIcnsPart }
|
||||
|
||||
TLazReaderIcnsPart = class(TFPCustomImageReader, ILazImageReader)
|
||||
private
|
||||
FUpdateDescription: Boolean;
|
||||
FPalette: TFPPalette;
|
||||
FImage: TLazIntfImage;
|
||||
FData: PByte;
|
||||
FCalcSize: Integer;
|
||||
FDataSize: Integer;
|
||||
FIconType: TicnsIconType;
|
||||
FIconInfo: TicnsIconInfo;
|
||||
protected
|
||||
function InternalCheck(Str:TStream): boolean; override;
|
||||
procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
|
||||
function QueryInterface(const iid: TGuid; out obj): LongInt; stdcall;
|
||||
function _AddRef: LongInt; stdcall;
|
||||
function _Release: LongInt; stdcall;
|
||||
function GetUpdateDescription: Boolean;
|
||||
procedure SetUpdateDescription(AValue: Boolean);
|
||||
procedure SetupRead(AWidth, AHeight, ADepth: Integer; IsMask: Boolean);
|
||||
function Create256ColorPalette: TFPPalette;
|
||||
procedure DoReadRaw;
|
||||
procedure DoReadRLE;
|
||||
procedure DoReadJpeg2000;
|
||||
procedure DoReadMask;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
property UpdateDescription: Boolean read GetUpdateDescription write SetUpdateDescription;
|
||||
property IconType: TicnsIconType read FIconType;
|
||||
property DataSize: Integer read FDataSize;
|
||||
end;
|
||||
|
||||
// extra Rawimage utility functions
|
||||
|
||||
@ -5208,6 +5241,327 @@ begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
{ TLazReaderIcnsPart }
|
||||
|
||||
function TLazReaderIcnsPart.InternalCheck(Str: TStream): boolean;
|
||||
begin
|
||||
// todo: write check code
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.InternalRead(Stream: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
Desc: TRawImageDescription;
|
||||
Element: TIconFamilyElement;
|
||||
IsMask: Boolean;
|
||||
begin
|
||||
FImage := TheImage as TLazIntfImage;
|
||||
|
||||
Stream.Read(Element, SizeOf(Element));
|
||||
Element.elementSize := BEtoN(Element.elementSize);
|
||||
FIconType := GetIcnsIconType(Element.elementType);
|
||||
FIconInfo := icnsIconTypeInfo[FIconType];
|
||||
IsMask := FIconType in icnsMaskTypes;
|
||||
|
||||
if UpdateDescription
|
||||
then begin
|
||||
if IsMask then
|
||||
begin
|
||||
if FIconInfo.Depth = 1 then
|
||||
DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, Desc)
|
||||
else
|
||||
DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, 32, Desc);
|
||||
end
|
||||
else
|
||||
DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, Desc);
|
||||
if (Desc.BitsPerPixel = 32) then
|
||||
Desc.MaskBitsPerPixel := 0;
|
||||
FImage.DataDescription := Desc;
|
||||
end
|
||||
else Desc := FImage.DataDescription;
|
||||
|
||||
SetupRead(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, IsMask);
|
||||
|
||||
FDataSize := Element.elementSize - SizeOf(Element);
|
||||
|
||||
GetMem(FData, FDataSize);
|
||||
try
|
||||
Stream.Read(FData^, FDataSize);
|
||||
if FIconType in icnsWithAlpha then
|
||||
DoReadJpeg2000
|
||||
else
|
||||
if IsMask then
|
||||
DoReadMask
|
||||
else
|
||||
if FIconType in icnsRGB then
|
||||
DoReadRLE
|
||||
else
|
||||
DoReadRaw;
|
||||
finally
|
||||
FreeMem(FData);
|
||||
FData := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazReaderIcnsPart.QueryInterface(const iid: TGuid; out obj): LongInt; stdcall;
|
||||
begin
|
||||
if GetInterface(iid, obj)
|
||||
then Result := S_OK
|
||||
else Result := E_NOINTERFACE;
|
||||
end;
|
||||
|
||||
function TLazReaderIcnsPart._AddRef: LongInt; stdcall;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TLazReaderIcnsPart._Release: LongInt; stdcall;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TLazReaderIcnsPart.GetUpdateDescription: Boolean;
|
||||
begin
|
||||
Result := FUpdateDescription;
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.SetUpdateDescription(AValue: Boolean);
|
||||
begin
|
||||
FUpdateDescription := AValue;
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.SetupRead(AWidth, AHeight, ADepth: Integer; IsMask: Boolean);
|
||||
begin
|
||||
if FData <> nil then
|
||||
FreeMem(FData);
|
||||
FreeAndNil(FPalette);
|
||||
if not IsMask then
|
||||
case ADepth of
|
||||
4: FPalette := CreateVGAPalette;
|
||||
8: FPalette := Create256ColorPalette;
|
||||
end;
|
||||
|
||||
FCalcSize := ((AWidth * AHeight * ADepth) shr 3);
|
||||
TheImage.SetSize(AWidth, AHeight);
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.DoReadRaw;
|
||||
var
|
||||
Row, Column: Integer;
|
||||
shift: byte;
|
||||
b: PByte;
|
||||
begin
|
||||
// only 4 and 8 are stored as raw image format
|
||||
case FIconInfo.Depth of
|
||||
4 :
|
||||
begin
|
||||
b := FData;
|
||||
shift := 4;
|
||||
for Row := 0 to FIconInfo.Height - 1 do
|
||||
for Column := 0 to FIconInfo.Width - 1 do
|
||||
begin
|
||||
FImage.colors[Column, Row] := FPalette[(b^ shr shift) mod 16];
|
||||
if shift = 0 then
|
||||
begin
|
||||
shift := 4;
|
||||
inc(b);
|
||||
end
|
||||
else
|
||||
shift := 0;
|
||||
end;
|
||||
end;
|
||||
8 :
|
||||
begin
|
||||
b := FData;
|
||||
for Row := 0 to FIconInfo.Height - 1 do
|
||||
for Column := 0 to FIconInfo.Width - 1 do
|
||||
begin
|
||||
FImage.colors[Column, Row] := FPalette[b^];
|
||||
inc(b);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.DoReadRLE;
|
||||
var
|
||||
ADecompData: PDWord;
|
||||
ARGBAData: PRGBAQuad;
|
||||
Component, Shift: Byte;
|
||||
PixelCount, j, l: Integer;
|
||||
RepeatValue: DWord;
|
||||
SourcePtr: PByte;
|
||||
DestPtr: PDWord;
|
||||
begin
|
||||
// only 24 bit RGB is RLE encoded the same way as TIFF or TGA RLE
|
||||
// data is encoded channel by channel:
|
||||
// high bit = 0 => length = low 0..6 bits + 1; read length times next value
|
||||
// high bit = 1 => length = value - 125 ; read one value and repeat length times
|
||||
|
||||
ADecompData := AllocMem(FCalcSize);
|
||||
DestPtr := ADecompData;
|
||||
|
||||
if FIconType = iitThumbnail32BitData
|
||||
then SourcePtr := @FData[4]
|
||||
else SourcePtr := FData;
|
||||
|
||||
PixelCount := FIconInfo.Height * FIconInfo.Width;
|
||||
|
||||
for Component := 0 to 2 do
|
||||
begin
|
||||
DestPtr := ADecompData;
|
||||
Shift := (2 - Component) * 8;
|
||||
while DestPtr - ADecompData < PixelCount do
|
||||
begin
|
||||
l := SourcePtr^;
|
||||
inc(SourcePtr);
|
||||
if (l and $80) = 0 then // high bit = 0
|
||||
begin
|
||||
for j := 0 to l do
|
||||
begin
|
||||
DestPtr^ := DestPtr^ or (DWord(SourcePtr^) shl Shift);
|
||||
inc(SourcePtr);
|
||||
inc(DestPtr);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin // high bit = 1
|
||||
l := l - 126;
|
||||
RepeatValue := DWord(SourcePtr^) shl Shift;
|
||||
inc(SourcePtr);
|
||||
for j := 0 to l do
|
||||
begin
|
||||
DestPtr^ := DestPtr^ or RepeatValue;
|
||||
inc(DestPtr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
ARGBAData := PRGBAQuad(ADecompData);
|
||||
for l := 0 to FIconInfo.Height - 1 do
|
||||
for j := 0 to FIconInfo.Width - 1 do
|
||||
begin
|
||||
FImage.Colors[j, l] :=
|
||||
FPColor(ARGBAData^.Red shl 8 or ARGBAData^.Red,
|
||||
ARGBAData^.Green shl 8 or ARGBAData^.Green,
|
||||
ARGBAData^.Blue shl 8 or ARGBAData^.Blue,
|
||||
alphaOpaque);
|
||||
inc(ARGBAData);
|
||||
end;
|
||||
FreeMem(ADecompData);
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.DoReadJpeg2000;
|
||||
begin
|
||||
// TODO: according to some research in the web we need to read jpeg 2000 data
|
||||
end;
|
||||
|
||||
procedure TLazReaderIcnsPart.DoReadMask;
|
||||
var
|
||||
Row, Column: Integer;
|
||||
shift: byte;
|
||||
b: PByte;
|
||||
begin
|
||||
case FIconInfo.Depth of
|
||||
1:
|
||||
begin
|
||||
// actually here is stored 2 1-bit images, but we will get only first
|
||||
shift := 7;
|
||||
b := FData;
|
||||
for Row := 0 to FIconInfo.Height - 1 do
|
||||
begin
|
||||
for Column := 0 to FIconInfo.Width - 1 do
|
||||
begin
|
||||
FImage.colors[Column, Row] := FPColor(0, 0, 0);
|
||||
FImage.Masked[Column, Row] := (b^ shr shift) mod 2 = 0;
|
||||
if shift = 0 then
|
||||
begin
|
||||
shift := 7;
|
||||
inc(b);
|
||||
end
|
||||
else
|
||||
dec(shift);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
8:
|
||||
begin
|
||||
b := FData;
|
||||
for Row := 0 to FIconInfo.Height - 1 do
|
||||
for Column := 0 to FIconInfo.Width - 1 do
|
||||
begin
|
||||
FImage.colors[Column, Row] := FPColor(0, 0, 0, (b^ shl 8) or b^);
|
||||
inc(b);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazReaderIcnsPart.Create256ColorPalette: TFPPalette;
|
||||
const
|
||||
CHANNELVAL: array[0..15] of Word = (
|
||||
$FFFF, $CCCC, $9999, $6666, $3333, $0000,
|
||||
$EEEE, $DDDD, $BBBB, $AAAA, $8888,
|
||||
$7777, $5555, $4444, $2222, $1111
|
||||
);
|
||||
|
||||
var
|
||||
rIdx, gIdx, bIdx: byte;
|
||||
PalIdx: Byte;
|
||||
begin
|
||||
Result := TFPPalette.Create(256);
|
||||
PalIdx := 0;
|
||||
for rIdx := 0 to 5 do
|
||||
begin
|
||||
for gIdx := 0 to 5 do
|
||||
begin
|
||||
for bIdx := 0 to 5 do
|
||||
begin
|
||||
Result[PalIdx] := FPColor(CHANNELVAL[rIdx], CHANNELVAL[gIdx], CHANNELVAL[bIdx]);
|
||||
Inc(PalIdx);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
for rIdx := 6 to 15 do
|
||||
begin
|
||||
Result[PalIdx] := FPColor(CHANNELVAL[rIdx], 0, 0);
|
||||
Inc(PalIdx);
|
||||
end;
|
||||
for gIdx := 6 to 15 do
|
||||
begin
|
||||
Result[PalIdx] := FPColor(0, CHANNELVAL[gIdx], 0);
|
||||
Inc(PalIdx);
|
||||
end;
|
||||
for bIdx := 6 to 15 do
|
||||
begin
|
||||
Result[PalIdx] := FPColor(0, 0, CHANNELVAL[bIdx]);
|
||||
Inc(PalIdx);
|
||||
end;
|
||||
for rIdx := 6 to 15 do
|
||||
begin
|
||||
Result[PalIdx] := FPColor(CHANNELVAL[rIdx], CHANNELVAL[rIdx], CHANNELVAL[rIdx]);
|
||||
Inc(PalIdx);
|
||||
end;
|
||||
Result[PalIdx] := FPColor(0, 0, 0);
|
||||
end;
|
||||
|
||||
constructor TLazReaderIcnsPart.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FData := nil;
|
||||
FPalette := nil;
|
||||
FCalcSize := 0;
|
||||
FIconType := iitNone;
|
||||
end;
|
||||
|
||||
destructor TLazReaderIcnsPart.Destroy;
|
||||
begin
|
||||
FPalette.Free;
|
||||
FreeMem(FData);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
procedure InternalInit;
|
||||
var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user