jvqanimatedimage.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvxAnimate.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.

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: JvQAnimatedImage.pas,v 1.21 2004/11/07 22:53:53 asnepvangers Exp $

unit JvQAnimatedImage;

{$I jvcl.inc}

interface

uses
  {$IFDEF MSWINDOWS}
  Windows, Messages,
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  QGraphics, QControls, 
  Qt, QWindows, 
  Classes,
  JvQTimer, JvQComponent;

type
  TJvImageControl = class(TJvGraphicControl)
  private
    FDrawing: Boolean;
    FPaintBuffered: Boolean;
    FLock: TRTLCriticalSection;
  protected
    FGraphic: TGraphic; 
    procedure Paint; override;
    procedure BufferedPaint; virtual;
    procedure DoPaintImage; virtual; abstract;
    procedure DoPaintControl;
    procedure PaintDesignRect;
    procedure PaintImage;
    procedure PictureChanged;
    procedure Lock;
    procedure Unlock;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Height default 105;
    property Width default 105;
  end;

  TGlyphOrientation = (goHorizontal, goVertical);

  TJvAnimatedImage = class(TJvImageControl)
  private
    FActive: Boolean;
    FGlyph: TBitmap;
    FImageWidth: Integer;
    FImageHeight: Integer;
    FInactiveGlyph: Integer;
    FOrientation: TGlyphOrientation;
    FTimer: TJvTimer;
    FNumGlyphs: Integer;
    FGlyphNum: Integer;
    FCenter: Boolean;
    FStretch: Boolean;
    FTransparentColor: TColor;
    FTimerRepaint: Boolean;
    FOnFrameChanged: TNotifyEvent;
    FOnStart: TNotifyEvent;
    FOnStop: TNotifyEvent;
    FAsyncDrawing: Boolean; 
    procedure DefineBitmapSize;
    procedure ResetImageBounds;
    function GetInterval: Cardinal;
    procedure SetInterval(Value: Cardinal);
    procedure SetActive(Value: Boolean);
    procedure SetAsyncDrawing(Value: Boolean);
    procedure SetCenter(Value: Boolean);
    procedure SetOrientation(Value: TGlyphOrientation);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGlyphNum(Value: Integer);
    procedure SetInactiveGlyph(Value: Integer);
    procedure SetNumGlyphs(Value: Integer);
    procedure SetStretch(Value: Boolean);
    procedure SetTransparentColor(Value: TColor); 
    procedure ImageChanged(Sender: TObject);
    procedure UpdateInactive;
    procedure TimerExpired(Sender: TObject);
    function TransparentStored: Boolean;
  protected 
    procedure AdjustSize; override;
    procedure Loaded; override;
    procedure BufferedPaint; override;
    procedure DoPaintImage; override;
    procedure FrameChanged; dynamic;
    procedure Start; dynamic;
    procedure Stop; dynamic; 
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property Anchors;
    property Constraints; 
    property AsyncDrawing: Boolean read FAsyncDrawing write SetAsyncDrawing default False;
    property Active: Boolean read FActive write SetActive default False;
    property Center: Boolean read FCenter write SetCenter default False;
    property Orientation: TGlyphOrientation read FOrientation write SetOrientation
      default goHorizontal;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property GlyphNum: Integer read FGlyphNum write SetGlyphNum default 0;
    property Interval: Cardinal read GetInterval write SetInterval default 100;
    property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs default 1;
    property InactiveGlyph: Integer read FInactiveGlyph write SetInactiveGlyph default -1;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor
      stored TransparentStored;
    property Color;
    property Cursor; 
    property DragMode;
    property ParentColor default True;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Stretch: Boolean read FStretch write SetStretch default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnDragOver;
    property OnDragDrop;
    property OnEndDrag;
    property OnStartDrag;
    property OnContextPopup;
    property OnFrameChanged: TNotifyEvent read FOnFrameChanged write FOnFrameChanged;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
  end;

//procedure HookBitmap;

type
  TJvLockedBitmap = class(TBitmap)
  protected
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  QForms,
  //JclSysUtils,
  JvQConsts, JvQJVCLUtils;


//=== { TJvLockedBitmap } ====================================================

// (rom) do we really need this ugly hack?
// (ahuser) lets try without the hook by using TJvLockedBitmap directly

procedure TJvLockedBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
begin
  if not Empty then
    Canvas.Lock;
  try
    inherited Draw(ACanvas, Rect);
  finally
    if not Empty then
      Canvas.Unlock;
  end;
end;

{
type
  TJvHack = class(TBitmap);

var
  Hooked: Boolean = False;

procedure HookBitmap;
var
  Index: Integer;
begin
  if Hooked then
    Exit;
  for Index := 0 to GetVirtualMethodCount(TJvHack) - 1 do
    if GetVirtualMethod(TJvHack, Index) = @TJvHack.Draw then
    begin
      SetVirtualMethod(TBitmap, Index, @TJvLockedBitmap.Draw);
      Hooked := True;
      Break;
    end;
end;
}
//=== { TJvImageControl } ====================================================

constructor TJvImageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  InitializeCriticalSection(FLock);
  ControlStyle := ControlStyle + [csClickEvents, csCaptureMouse, csOpaque,
    csReplicatable, csDoubleClicks];
  Height := 105;
  Width := 105;
  ParentColor := True;
end;

destructor TJvImageControl.Destroy;
begin
  DeleteCriticalSection(FLock);
  inherited Destroy;
end;

procedure TJvImageControl.Lock;
begin
  EnterCriticalSection(FLock);
end;

procedure TJvImageControl.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

procedure TJvImageControl.PaintImage;
var
  Save: Boolean;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(Bounds(0, 0, ClientWidth, ClientHeight));
  end;
  Save := FDrawing;
  FDrawing := True;
  try
    DoPaintImage;
  finally
    FDrawing := Save;
  end;
end;

procedure TJvImageControl.Paint;
var
  Bmp: TBitmap;
  DC: HDC;
begin
  Bmp := TJvLockedBitmap.Create;
  try
    Bmp.Width := ClientWidth;
    Bmp.Height := ClientHeight;
    DC := Canvas.Handle;
    try
      Canvas.Handle := Bmp.Canvas.Handle;
      FPaintBuffered := True;
      try
        BufferedPaint;
      finally
        FPaintBuffered := False;
      end;
    finally
      Canvas.Handle := DC;
      Canvas.Draw(0, 0, Bmp);
    end;
  finally
    Bmp.Free;
  end;
end;

procedure TJvImageControl.BufferedPaint;
begin
end;

procedure TJvImageControl.PaintDesignRect;
begin
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
end;


type
  THackedWidgetControl = class(TWidgetControl);


procedure TJvImageControl.DoPaintControl;
var
  DC: HDC; 
  OrgDC: QPainterH; 
begin
  if GetCurrentThreadID = MainThreadID then
  begin
    Repaint;
    Exit;
  end;  
  DC := QPainter_create;
  try
    QPainter_begin(DC, THackedWidgetControl(Parent).GetPaintDevice);
    try
      QPainter_setClipRect(DC, Left, Top, Width, Height);
      QPainter_translate(DC, Left, Top);

      OrgDC := Canvas.Handle;
      try
       Canvas.Handle := DC;
       PaintRequest;
      finally
        Canvas.Handle := OrgDC;
      end;
    finally
      QPainter_end(DC);
    end;
  finally
    QPainter_destroy(DC);
  end; 
end;



procedure TJvImageControl.PictureChanged;
begin
  if not (csDestroying in ComponentState) then
  begin
    AdjustSize;
    if FGraphic <> nil then
      if  FDrawing then
        Update;
    if not FDrawing then
      Invalidate;
  end;
end;

//=== { TJvAnimatedImage } ===================================================

constructor TJvAnimatedImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TJvTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 100; 
  FGlyph := TJvLockedBitmap.Create;
  FGraphic := FGlyph;
  FGlyph.OnChange := ImageChanged;
  FNumGlyphs := 1;
  FInactiveGlyph := -1;
  FTransparentColor := clNone;
  FOrientation := goHorizontal;
  FStretch := True;
end;

destructor TJvAnimatedImage.Destroy;
begin
  Destroying;
  FOnFrameChanged := nil;
  FOnStart := nil;
  FOnStop := nil;
  FGlyph.OnChange := nil;
  Active := False;
  FGlyph.Free;
  inherited Destroy;
end;

procedure TJvAnimatedImage.Loaded;