jvgimage.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: JvgImage.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
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: JvgImage.pas,v 1.20 2005/02/17 10:21:20 marquardt Exp $

unit JvgImage;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgUtils, JvgCommClasses;

type
  {$IFDEF USEJVCL}
  TJvgBitmapImage = class(TJvGraphicControl)
  {$ELSE}
  TJvgBitmapImage = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FAutoSize: Boolean;
    FImageAlign: TJvg2DAlign;
    FBitmapOption: TglWallpaperOption;
    FDrawState: TglDrawState;
    FTransparent: Boolean;
    FTransparentColor: TColor;
    FMasked: Boolean;
    FMaskedColor: TColor;
    FMaskedToColor: TColor;
    FDisabledMaskColor: TColor;
    FBitmap: TBitmap;
    FImage: TImage;
    FAutoTransparentColor: TglAutoTransparentColor;
    FFastDraw: Boolean;
    FBmp: TBitmap;
    FChanged: Boolean;
    FOnChangeParams: TNotifyEvent;
    // FOldClientRect: TRect;
    FOldWidth: Integer;
    FOldHeight: Integer;
    procedure CreateResBitmap;
    procedure Changed;
    procedure SmthChanged(Sender: TObject);
    function CalcAlignOffset: TPoint;
    function GetBitmap: TBitmap;
    procedure SetBitmap(Value: TBitmap);
    procedure SetImage(Value: TImage);
    procedure SetBitmapOption(Value: TglWallpaperOption);
    procedure SetDrawState(Value: TglDrawState);
    procedure SetTransparent(Value: Boolean);
    procedure SetTransparentColor(Value: TColor);
    procedure SetMasked(Value: Boolean);
    procedure SetMaskedColor(Value: TColor);
    procedure SetMaskedToColor(Value: TColor);
    procedure SetDisabledMaskColor(Value: TColor);
    procedure SetAutoTransparentColor(Value: TglAutoTransparentColor);
    procedure SetFastDraw(Value: Boolean);
  protected
    procedure SetAutoSize(Value: Boolean); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    FResBitmap: TBitmap; //...you can use it!
    //    procedure PaintTo(Canvas: TCanvas);
    procedure Paint; override;
    property Canvas;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure RemakeBackground; //...for users
    //    procedure RepaintBackground; //...for users
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property Bitmap: TBitmap read GetBitmap write SetBitmap;
    property Image: TImage read FImage write SetImage;
    property ImageAlign: TJvg2DAlign read FImageAlign write FImageAlign;
    property BitmapOption: TglWallpaperOption read FBitmapOption  write SetBitmapOption default fwoNone;
    property DrawState: TglDrawState read FDrawState write SetDrawState default fdsDefault;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor default clOlive;
    property Masked: Boolean read FMasked write SetMasked default False;
    property MaskedColor: TColor read FMaskedColor write SetMaskedColor default clOlive;
    property MaskedToColor: TColor read FMaskedToColor write SetMaskedToColor default clBtnFace;
    property DisabledMaskColor: TColor read FDisabledMaskColor write SetDisabledMaskColor default clBlack;
    property AutoTransparentColor: TglAutoTransparentColor read FAutoTransparentColor
      write SetAutoTransparentColor default ftcLeftBottomPixel;
    property FastDraw: Boolean read FFastDraw write SetFastDraw default False;
    property Anchors;
    property Align;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnChangeParams: TNotifyEvent read FOnChangeParams write FOnChangeParams;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgImage.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math;

constructor TJvgBitmapImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 105;
  Height := 105;

  FResBitmap := TBitmap.Create;
  FImageAlign := TJvg2DAlign.Create;
  FImageAlign.OnChanged := SmthChanged;
  FChanged := True;
  // FOldClientRect := Rect(left, top, left + Width, top + Height);
  //...defaults
  FAutoSize := False;
  FBitmapOption := fwoNone;
  FDrawState := fdsDefault;
  FTransparent := False;
  FTransparentColor := clOlive;
  FMasked := False;
  FMaskedColor := clOlive;
  FMaskedToColor := clBtnFace;
  FDisabledMaskColor := clBlack;
  FAutoTransparentColor := ftcLeftBottomPixel;
  FFastDraw := False;
  OnChangeParams := nil;
end;

destructor TJvgBitmapImage.Destroy;
begin
  FResBitmap.Free;
  FBitmap.Free;
  FImageAlign.Free;
  inherited Destroy;
end;

procedure TJvgBitmapImage.Loaded;
begin
  inherited Loaded;
  if Assigned(FBitmap) and not FBitmap.Empty then
    FBmp := FBitmap;
  SetAutoTransparentColor(FAutoTransparentColor);
end;

procedure TJvgBitmapImage.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = Image) and (Operation = opRemove) then
    Image := nil;
end;

procedure TJvgBitmapImage.Paint;
var
  //R, IntersectR: TRect;
  Pt: TPoint;
begin
  if Assigned(Bitmap) then
    FBmp := Bitmap;
  if Assigned(Image) then
    FBmp := Image.Picture.Bitmap;

  if Assigned(FBmp) and (FBmp.Handle <> 0) then
  begin
    if (FOldWidth <> Width) or (FOldHeight <> Height) then
    begin
      FChanged := True;
      {if (OldLeft=Left)and(OldTop=Top) then
      begin
        R:=Rect( left, top, left+Width, top+Height );
        IntersectRect( IntersectR, FOldClientRect, R );
        InvalidateRect( Parent.Handle, @R, False );
        ValidateRect( Parent.Handle, @IntersectR );
        FOldClientRect := R;
       end;}
    end;
    //OldLeft := Left; OldTop := Top;
    FOldWidth := Width;
    FOldHeight := Height;

    if FChanged or not FFastDraw then
    begin
      CreateResBitmap;
      FChanged := False;
    end;
    Pt := CalcAlignOffset;
    BitBlt(Canvas.Handle, Pt.X, Pt.Y, FResBitmap.Width, FResBitmap.Height,
      FResBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  end;
  if (csDesigning in ComponentState) and (Tag <> 9999) then
    with Canvas do
    begin
      Pen.Color := clBlack;
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
end;

procedure TJvgBitmapImage.RemakeBackground;
begin
  FChanged := True;
  Repaint;
end;

//procedure TJvgBitmapImage.WMSize(var Message: TWMSize);
//var R,IntersectR: TRect;
//begin
{  Exit;
  if FAutoSize then
  begin Width:=FResBitmap.Width; Height:=FResBitmap.Height; end;
  if not FTransparent then
  begin
    R:=Rect( left, top, left+Width, top+Height );
    IntersectRect( IntersectR, FOldClientRect, R );
    InvalidateRect( Parent.Handle, @R, False );
    ValidateRect( Parent.Handle, @IntersectR );
    FOldClientRect := R;
  end
  else
    Invalidate;
  Changed;}
//end;

procedure TJvgBitmapImage.CreateResBitmap;
var