jvani.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvAni.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

The Original Code is: JvAniFile.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvAni.pas,v 1.42 2005/02/17 10:19:58 marquardt Exp $

unit JvAni;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes,
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  Windows, Graphics, Controls, ExtCtrls, Dialogs,
  JvTypes;

type
  TJvIconFrame = class(TPersistent)
  private
    FIcon: TIcon;
    FIsIcon: Boolean;
    FHotSpot: TPoint;
    FRate: Longint;
  public
    constructor Create(JifRate: Longint);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Icon: TIcon read FIcon;
    property HotSpot: TPoint read FHotSpot;
    property Rate: Longint read FRate;
  end;

  TJvAni = class(TGraphic)
  private
    FHeader: TJvAniHeader;
    FTitle: string;
    FAuthor: string;
    FIcons: TList;
    FOriginalColors: Word;
    FIndex: Integer;
    FRates: array of Longint;
    FSequence: array of Longint;
    FFrameCount: Integer;
    FFrameResult: TJvIconFrame;
    FTimer: TTimer;
    procedure RiffReadError;
    function ReadCreateIcon(Stream: TStream; ASize: Longint;
      var HotSpot: TPoint; var IsIcon: Boolean): TIcon;
    procedure ReadAniStream(Stream: TStream);
    procedure WriteAniStream(Stream: TStream);
    procedure Clear;
    procedure NewImage;
    function GetAnimated: Boolean;
    function GetAuthor: string;
    function GetTitle: string;
    function GetIconCount: Integer;
    function GetFrameCount: Integer;
    function GetIcons(Index: Integer): TIcon;
    function GetFrames(Index: Integer): TJvIconFrame;
    procedure SetIndex(const Value: Integer);
    procedure SetAnimated(const Value: Boolean);
    procedure CalcDelay;
  protected
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
    procedure Animate(Sender: TObject);
    procedure SetTransparent(Value: Boolean); override;
    function GetTransparent: Boolean; override;
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure SaveToFile(const FileName: string); override;
    {$IFDEF VCL}
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var Format: Word; var Data: THandle; var APalette: HPALETTE); override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure LoadFromMimeSource(MimeSource: TMimeSource); override;
    procedure SaveToMimeSource(MimeSource: TClxMimeSource); override;
    {$ENDIF VisualCLX}
    procedure AssignToBitmap(Bitmap: TBitmap; BackColor: TColor;
      DecreaseColors, Vertical: Boolean);
    procedure AssignIconsToBitmap(Bitmap: TBitmap; BackColor: TColor;
      DecreaseColors, Vertical: Boolean);
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
    property Animated: Boolean read GetAnimated write SetAnimated;
    property Author: string read GetAuthor;
    property IconCount: Integer read GetIconCount;
    property FrameCount: Integer read GetFrameCount;
    property Frames[Index: Integer]: TJvIconFrame read GetFrames;
    property Header: TJvAniHeader read FHeader;
    property Icons[Index: Integer]: TIcon read GetIcons;
    property Index: Integer read FIndex write SetIndex;
    property OriginalColors: Word read FOriginalColors;
    property Title: string read GetTitle;
  end;

function LoadJvAniDialog: TJvAni;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvAni.pas,v $';
    Revision: '$Revision: 1.42 $';
    Date: '$Date: 2005/02/17 10:19:58 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils,
  Consts, Math,
  JvJVCLUtils, JvJCLUtils, JvIconList, JvConsts, JvResources;

//=== { TJvAnimatedCursorImage helper } ======================================

// (rom) created because JvAnimatedEditor.pas and JvIconListForm.pas contained the same code

function LoadJvAniDialog: TJvAni;
var
  CurDir: string;
begin
  Result := nil;
  CurDir := GetCurrentDir;
  with TOpenDialog.Create(nil) do
  try
    Options := [{$IFDEF VCL} ofHideReadOnly, {$ENDIF} ofFileMustExist];
    DefaultExt := RsAniExtension;
    Filter := RsAniCurFilter;
    if Execute then
    begin
      Result := TJvAni.Create;
      try
        Result.LoadFromFile(FileName);
      except
        FreeAndNil(Result);
        raise;
      end;
    end;
  finally
    Free;
    SetCurrentDir(CurDir);
  end;
end;

function PadUp(Value: Longint): Longint;
begin
  Result := Value + (Value mod 2); // Up Value to nearest word boundary
end;

procedure DecreaseBMPColors(Bmp: TBitmap; Colors: Integer);
{$IFDEF VCL}
var
  Stream: TStream;
begin
  if (Bmp <> nil) and (Colors > 0) then
  begin
    Stream := BitmapToMemory(Bmp, Colors);
    try
      Bmp.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
begin
  // TODO
end;
{$ENDIF VisualCLX}

function GetDInColors(BitCount: Word): Integer;
begin
  case BitCount of
    1, 4, 8:
      Result := 1 shl BitCount;
  else
    Result := 0;
  end;
end;

{ ReadTag, ReadChunk, SkipChunk. Some handy functions for reading RIFF files. }

function ReadTag(S: TStream; var Tag: TJvAniTag): Boolean;
begin
  Tag.ckID := #0#0#0#0;
  Tag.ckSize := 0;
  Result := S.Read(Tag, SizeOf(TJvAniTag)) = SizeOf(TJvAniTag);
end;

function ReadChunk(S: TStream; const Tag: TJvAniTag; var Data): Boolean;
begin
  Result := S.Read(Data, Tag.ckSize) = Tag.ckSize;
  if Result then
    Result := S.Seek(Tag.ckSize mod 2, soFromCurrent) <> -1;
end;

function ReadChunkN(S: TStream; const Tag: TJvAniTag; var Data;
  cbMax: Longint): Boolean;
var
  cbRead: Longint;
begin
  FillChar(Data, cbMax, #0);
  cbRead := Tag.ckSize;
  if cbMax < cbRead then
    cbRead := cbMax;
  Result := S.Read(Data, cbRead) = cbRead;
  if Result then
  begin
    cbRead := PadUp(Tag.ckSize) - cbRead;
    Result := S.Seek(cbRead, soFromCurrent) <> -1;
  end;
end;

function SkipChunk(S: TStream; const Tag: TJvAniTag): Boolean;
begin
  // Round pTag^.ckSize up to nearest word boundary to maintain alignment
  Result := S.Seek(PadUp(Tag.ckSize), soFromCurrent) <> -1;
end;

{ Icon and cursor types }

const
  RC3_STOCKICON = 0;
  RC3_ICON = 1;
  RC3_CURSOR = 2;

type
  PCursorOrIcon = ^TCursorOrIcon;
  TCursorOrIcon = packed record
    Reserved: Word;
    wType: Word;
    Count: Word;
  end;

  PIconRec = ^TIconRec;
  TIconRec = packed record
    Width: Byte;
    Height: Byte;
    Colors: Word;
    xHotspot: Word;
    yHotspot: Word;
    DIBSize: Longint;
    DIBOffset: Longint;
  end;

//=== { TJvIconFrame } =======================================================

constructor TJvIconFrame.Create(JifRate: Longint);
begin
  inherited Create;
  FIcon := nil;
  FRate := JifRate;
end;

destructor TJvIconFrame.Destroy;
begin
  FIcon.Free;
  inherited Destroy;
end;

procedure TJvIconFrame.Assign(Source: TPersistent);
begin
  if Source is TJvIconFrame then
    with Source as TJvIconFrame do
    begin
      if Self.FIcon = nil then
        Self.FIcon := TIcon.Create;
      Self.FIcon.Assign(Icon);
      Self.FIsIcon := FIsIcon;
      Self.FHotSpot := HotSpot;
      Self.FRate := Rate;
    end
  else
    inherited Assign(Source);
end;

//=== { TJvAni } =============================================================

constructor TJvAni.Create;
begin
  inherited Create;
  FIcons := TList.Create;
  FIndex := -1;
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 100;
  FTimer.OnTimer := Animate;
  FTimer.Enabled := False;
  FFrameResult := TJvIconFrame.Create(0);
end;

destructor TJvAni.Destroy;
begin
  NewImage;
  FreeAndNil(FIcons);
  FreeAndNil(FTimer);
  FFrameResult.FIcon := nil;
  FreeAndNil(FFrameResult);
  inherited Destroy;
end;

procedure TJvAni.Clear;
begin
  if FIcons.Count > 0 then
  begin
    NewImage;
    Changed(Self);
  end;
end;

procedure TJvAni.NewImage;
var
  I: Integer;
begin
  if Assigned(FIcons) then
    for I := 0 to FIcons.Count - 1 do
      TJvIconFrame(FIcons[I]).Free;
  FreeAndNil(FIcons);
  SetLength(FRates, 0);
  SetLength(FSequence, 0);
  FFrameCount := 0;
  FTitle := '';
  FAuthor := '';
  FillChar(FHeader, SizeOf(FHeader), 0);
  FOriginalColors := 0;
  FIndex := -1;
end;

procedure TJvAni.Assign(Source: TPersistent);
var
  I: Integer;
  Frame: TJvIconFrame;
begin
  if Source = nil then
    Clear
  else
  if Source is TJvAni then
  begin
    Clear;
    try
      with TJvAni(Source) do
      begin
        Move(FHeader, Self.FHeader, SizeOf(FHeader));
        Self.FTitle := Title;
        Self.FAuthor := Author;
        Self.FOriginalColors := FOriginalColors;
        Self.FFrameCount := FrameCount;
        SetLength(Self.FRates, Length(FRates));
        if Length(FRates) <> 0 then
          Move(FRates[0], Self.FRates[0], Length(FRates) * SizeOf(Longint));
        SetLength(Self.FSequence, Length(FSequence));
        if Length(FSequence) <> 0 then
          Move(FSequence[0], Self.FSequence[0], Length(FSequence) * SizeOf(Longint));
        for I := 0 to FIcons.Count - 1 do
        begin
          Frame := TJvIconFrame.Create(FHeader.dwJIFRate);
          try
            Frame.Assign(TJvIconFrame(FIcons[I]));
            Self.FIcons.Add(Frame);
          except
            Frame.Free;
            raise;
          end;
        end;
        Self.FIndex := Index;
        Self.Animated := Animated;
      end;
    except
      NewImage;
      raise;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TJvAni.AssignTo(Dest: TPersistent);
var
  I: Integer;
begin
  if Dest is TIcon then
  begin
    if FrameCount > 0 then
      Dest.Assign(Frames[Index].Icon)
    else
      Dest.Assign(nil);
  end
  else
  if Dest is TBitmap then
  begin
    if FrameCount > 0 then
      AssignToBitmap(TBitmap(Dest), TBitmap(Dest).Canvas.Brush.Color, True, False)
    else
      Dest.Assign(nil);
  end
  else
  if Dest is TJvIconList then
  begin
    TJvIconList(Dest).BeginUpdate;
    try
      TJvIconList(Dest).Clear;
      for I := 0 to FrameCount - 1 do
        TJvIconList(Dest).Add(Frames[I].Icon);
    finally
      TJvIconList(Dest).EndUpdate;
    end;
  end
  else
    inherited AssignTo(Dest);
end;

function TJvAni.GetEmpty: Boolean;
begin
  Result := (FrameCount = 0);
end;

procedure TJvAni.SetHeight(Value: Integer);
begin
  raise EInvalidGraphicOperation.CreateRes(@SChangeIconSize);
end;

procedure TJvAni.SetWidth(Value: Integer);
begin
  raise EInvalidGraphicOperation.CreateRes(@SChangeIconSize);
end;

function TJvAni.GetWidth: Integer;
begin
  Result := Frames[Index].Icon.Width;
end;

function TJvAni.GetHeight: Integer;
begin
  Result := Frames[Index].Icon.Height;
end;

{$IFDEF VCL}

procedure TJvAni.LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE);
begin
  raise EInvalidGraphicOperation.CreateRes(@SIconToClipboard);
end;

procedure TJvAni.SaveToClipboardFormat(var Format: Word; var Data: THandle; var APalette: HPALETTE);
begin
  raise EInvalidGraphicOperation.CreateRes(@SIconToClipboard);
end;

{$ENDIF VCL}

procedure TJvAni.SetIndex(const Value: Integer);
begin
  if (Value >= 0) and (Value < FrameCount) and (FIndex <> Value) then
  begin
    FIndex := Value;
    Changed(Self);
  end;
end;

function TJvAni.GetAuthor: string;
begin
  Result := FAuthor;
end;

function TJvAni.GetTitle: string;
begin
  Result := FTitle;
end;

function TJvAni.GetIconCount: Integer;
begin
  Result := FIcons.Count;
end;

function TJvAni.GetFrameCount: Integer;
begin
  Result := FFrameCount;
end;

function TJvAni.GetAnimated: Boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TJvAni.SetAnimated(const Value: Boolean);
begin
  if Value <> FTimer.Enabled then
    FTimer.Enabled := Value;
end;

procedure TJvAni.Animate(Sender: TObject);
begin
  FTimer.Enabled := False;
  if FrameCount > 0 then
    Index := (Index + 1) mod Integer(FrameCount);
  CalcDelay;
  FTimer.Enabled := True;
end;

procedure TJvAni.CalcDelay;
begin
  if Index = -1 then
    Animated := False
  else
  begin
    FTimer.Interval := (Cardinal(Frames[Index].Rate) * 100) div 6;
    if FTimer.Interval = 0 then
      FTimer.Interval := 100;
  end;
end;

procedure TJvAni.SetTransparent(Value: Boolean);
begin
  // Icons are always transparent so animations also
end;

function TJvAni.GetTransparent: Boolean;
begin