jvgbutton.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: JvgButton.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: JvgButton.pas,v 1.28 2005/02/17 10:21:19 marquardt Exp $

unit JvgButton;

{$I jvcl.inc}

interface

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

type
  TDrawMode = (dmUseImageList, dmAutoCtrl3D, dmAutoFlat, dmAutoShadow);

  TglButtonOption = (boBlinkWhenActive, boBlinkWhenInactive,
    boBlinkWhenPushed, boChangeColorWhenActive,
    boChangeColorWhenPushed, boDelicateInactive,
    boDrawPushedAsFlat, boRaisedInactive,
    boRefreshOnActivate, boRefreshOnPush,
    boShadowSurround, boShiftMouseOnPush);

  TglButtonOptions = set of TglButtonOption;

  TglBtnState = (fbsOriginal, fbsInactive, fbsActive, fbsPushed, fbsDisabled);

  TJvgGlyphsIndexes = class(TPersistent)
  private
    FInactive: Integer;
    FPushed: Integer;
    FActive: Integer;
    FDisabled: Integer;
    FMask: Integer;
    FOnChanged: TNotifyEvent;
    procedure SetInactive(Value: Integer);
    procedure SetPushed(Value: Integer);
    procedure SetActive(Value: Integer);
    procedure SetDisabled(Value: Integer);
    procedure SetMask(Value: Integer);
  protected
    procedure DoChanged; virtual;
  public
    constructor Create;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged stored False;
  published
    property Inactive: Integer read FInactive write SetInactive default 0;
    property Pushed: Integer read FPushed write SetPushed default 1;
    property Active: Integer read FActive write SetActive default 2;
    property Disabled: Integer read FDisabled write SetDisabled default -1;
    property Mask: Integer read FMask write SetMask default 3;
  end;

  TJvgBtnGlyphs = class(TPersistent)
  private
    FGlyphInactive: TBitmap;
    FGlyphMask: TBitmap;
    FGlyphPushed: TBitmap;
    FGlyphActive: TBitmap;
    FGlyphDisabled: TBitmap;
    procedure SetGlyphInactive(Value: TBitmap);
    procedure SetGlyphMask(Value: TBitmap);
    procedure SetGlyphPushed(Value: TBitmap);
    procedure SetGlyphActive(Value: TBitmap);
    procedure SetGlyphDisabled(Value: TBitmap);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property GlyphInactive: TBitmap read FGlyphInactive write SetGlyphInactive;
    property GlyphMask: TBitmap read FGlyphMask write SetGlyphMask;
    property GlyphPushed: TBitmap read FGlyphPushed write SetGlyphPushed;
    property GlyphActive: TBitmap read FGlyphActive write SetGlyphActive;
    property GlyphDisabled: TBitmap read FGlyphDisabled write SetGlyphDisabled;
  end;

  {$IFDEF USEJVCL}
  TJvgButton = class(TJvGraphicControl)
  {$ELSE}
  TJvgButton = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FGlyph: TBitmap;
    FGlyphs: TJvgBtnGlyphs;
    FDrawMode: TDrawMode;
    FGlyphsList: TImageList;
    FTransparentColor: TColor;
    FNumGlyphs: Integer;
    FShiftMaskWhenPushed: TJvgPointClass;
    FEnabled: Boolean;
    FOptions: TglButtonOptions;
    FShadowDepth: Word;
    FGlyphsIndexes: TJvgGlyphsIndexes;
    FColorHighlight: TColor;
    FColorShadow: TColor;
    FColorDarkShadow: TColor;
    FDisabledMaskColor: TColor;
    FChangeColorOnActivate: TJvgTwainColors;
    FChangeColorOnPush: TJvgTwainColors;
    FAutoTrColor: TglAutoTransparentColor;
    FBlinkTimer: TTimer;
    FOnClick: TNotifyEvent;

    TmpBMP: TBitmap;
    Img: TBitmap;
    DefaultGlyphsList: TImageList;
    FBitmapsCreated: Boolean;
    FMouseInControl: Boolean;
    FPushed: Boolean;
    FShowingAsPushedNow: Boolean;
    FActiveNow: Boolean;
    FLoaded: Boolean;
    FBlinked: Boolean;
    FNeedBlink: Boolean;
    MShift: TPoint;
    FTestMode: Boolean;

    procedure SetGlyph(Value: TBitmap);
    procedure SetDrawMode(Value: TDrawMode);
    procedure SetGlyphsList(Value: TImageList);
    procedure SetNumGlyphs(Value: Integer);
    procedure SetTransparentColor(Value: TColor);
    procedure SetShadowDepth(Value: Word);
    procedure SetColorHighlight(Value: TColor);
    procedure SetColorShadow(Value: TColor);
    procedure SetColorDarkShadow(Value: TColor);
    procedure SetDisabledMaskColor(Value: TColor);
    procedure SetOptions(Value: TglButtonOptions);
    procedure SetAutoTrColor(Value: TglAutoTransparentColor);
    procedure SetBlinkTimer(Value: TTimer);
    function GetBlinkTimer: TTimer;
    procedure SetTestMode(Value: Boolean);

    function IsMouseInControl: Boolean;
    procedure GetBitmaps;
    procedure CreateBitmaps; //...based on Inactive Glyph
    procedure GetBitmap_(Index: Integer; var Bmp: TBitmap);
    procedure SmthChanged(Sender: TObject);
    procedure ApplicateGlyph(var TargetBMP: TBitmap; State: TglBtnState;
      DrawState: TglDrawState; S: Integer);
  protected
    procedure SetEnabled(Value: Boolean); override;
    procedure Paint; override;
    procedure Paint_;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    {$IFDEF USEJVCL}
    procedure MouseLeave(Control: TControl); override;
    {$ENDIF USEJVCL}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnBlinkTimer(Sender: TObject);
  published
    property ShowHint default True;
    property Glyphs: TJvgBtnGlyphs read FGlyphs write FGlyphs;
    property DrawMode: TDrawMode read FDrawMode write SetDrawMode;
    property GlyphsList: TImageList read FGlyphsList write SetGlyphsList;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs;
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor default clOlive;
    property ShiftMaskWhenPushed: TJvgPointClass read FShiftMaskWhenPushed write FShiftMaskWhenPushed;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property GlyphsIndexes: TJvgGlyphsIndexes read FGlyphsIndexes write FGlyphsIndexes;
    property ShadowDepth: Word read FShadowDepth write SetShadowDepth default 5;
    property ColorHighlight: TColor read FColorHighlight write SetColorHighlight default clBtnHighlight;
    property ColorShadow: TColor read FColorShadow write SetColorShadow default clBtnShadow;
    property ColorDarkShadow: TColor read FColorDarkShadow write SetColorDarkShadow default clBlack;
    property DisabledMaskColor: TColor read FDisabledMaskColor write SetDisabledMaskColor default clBlack;
    property Options: TglButtonOptions read FOptions write SetOptions;
    property ChangeColorOnActivate: TJvgTwainColors read FChangeColorOnActivate write FChangeColorOnActivate;
    property ChangeColorOnPush: TJvgTwainColors read FChangeColorOnPush write FChangeColorOnPush;
    property AutoTransparentColor: TglAutoTransparentColor read FAutoTrColor write SetAutoTrColor default ftcUser;
    property BlinkTimer: TTimer read GetBlinkTimer write SetBlinkTimer;
    property TestMode: Boolean read FTestMode write SetTestMode default False;
    {$IFDEF USEJVCL}
    property HintColor;
    property OnParentColorChange;
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF USEJVCL}
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

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

implementation

{$IFDEF USEJVCL}
uses
  JvConsts, JvJCLUtils, JvResources, JvThemes;
{$ENDIF USEJVCL}

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvgButton.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvgButton.res}
{$ENDIF UNIX}

{$IFNDEF USEJVCL}
resourcestring
  RsEErrorDuringAccessGlyphsListOrGlyphP = 'Error during access GlyphsList or Glyph property';
{$ENDIF !USEJVCL}

//=== { TJvgBtnGlyphs } ======================================================

constructor TJvgBtnGlyphs.Create;
begin
  inherited Create;
  FGlyphInactive := TBitmap.Create;
  FGlyphMask := TBitmap.Create;
  FGlyphPushed := TBitmap.Create;
  FGlyphActive := TBitmap.Create;
  FGlyphDisabled := TBitmap.Create;
end;

destructor TJvgBtnGlyphs.Destroy;
begin
  FGlyphInactive.Free;
  FGlyphMask.Free;
  FGlyphPushed.Free;
  FGlyphActive.Free;
  FGlyphDisabled.Free;
  inherited Destroy;
end;

procedure TJvgBtnGlyphs.SetGlyphInactive(Value: TBitmap);
begin
  GlyphInactive.Assign(Value);
end;

procedure TJvgBtnGlyphs.SetGlyphMask(Value: TBitmap);
begin
  GlyphMask.Assign(Value);
end;

procedure TJvgBtnGlyphs.SetGlyphPushed(Value: TBitmap);
begin
  GlyphPushed.Assign(Value);
end;

procedure TJvgBtnGlyphs.SetGlyphActive(Value: TBitmap);
begin
  GlyphActive.Assign(Value);
end;

procedure TJvgBtnGlyphs.SetGlyphDisabled(Value: TBitmap);
begin
  GlyphDisabled.Assign(Value);
end;

//=== { TJvgButton } =========================================================

constructor TJvgButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  {$IFDEF USEJVCL}
  IncludeThemeStyle(Self, [csParentBackground]);
  {$ENDIF USEJVCL}
  FGlyph := TBitmap.Create;
  FGlyphs := TJvgBtnGlyphs.Create;
  DefaultGlyphsList := TImageList.CreateSize(30, 30);
  Img := TBitmap.Create;
  TmpBMP := TBitmap.Create;
  FShiftMaskWhenPushed := TJvgPointClass.Create;
  FGlyphsIndexes := TJvgGlyphsIndexes.Create;
  FChangeColorOnActivate := TJvgTwainColors.Create;
  FChangeColorOnPush := TJvgTwainColors.Create;
  FGlyphsIndexes.OnChanged := SmthChanged;
  //...set defaults
  FShiftMaskWhenPushed.X := 0;
  FShiftMaskWhenPushed.Y := 0;
  FEnabled := True;
  FGlyphsList := nil;
  FNumGlyphs := 3;
  FDrawMode := dmUseImageList;
  FShadowDepth := 5;
  FColorHighlight := clBtnHighlight;
  FColorShadow := clBtnShadow;
  FColorDarkShadow := clBlack;
  FDisabledMaskColor := clBlack;
  FTestMode := False;
  ShowHint := True;
  FOptions := [boRaisedInactive, boShadowSurround, boShiftMouseOnPush,
    boChangeColorWhenActive, boChangeColorWhenPushed,
    boBlinkWhenActive];
  if DefaultGlyphsList.ResourceLoad(rtBitmap, 'JvgButtonDEFAULT', clNone) then
  begin
    FGlyphsList := DefaultGlyphsList;
    GetBitmaps;
  end;
  FPushed := False;
  FChangeColorOnActivate.FromColor := clBlack;
  FChangeColorOnActivate.ToColor := clBlack;
  FChangeColorOnPush.FromColor := clBlack;
  FChangeColorOnPush.ToColor := clBlack;
  FTransparentColor := clOlive;
  FAutoTrColor := {ftcLeftBottomPixel;} ftcUser;
  Width := 20;
  Height := 20;
  FLoaded := False;
end;

destructor TJvgButton.Destroy;
begin
  FGlyphsList := nil;
  FGlyphs.Free;
  FGlyph.Free;
  DefaultGlyphsList.Free;
  Img.Free;
  TmpBMP.Free;
  FShiftMaskWhenPushed.Free;
  FGlyphsIndexes.Free;
  FChangeColorOnActivate.Free;
  FChangeColorOnPush.Free;
  if not (csDestroying in Owner.ComponentState) then
    SetBlinkTimer(nil);
  inherited Destroy;
end;

procedure TJvgButton.Loaded;
begin
  inherited Loaded;
  FLoaded := True;
end;

procedure TJvgButton.Paint;
var
  DrawState: TglDrawState;
  I: Word;
begin
  with Glyphs do
  begin
    if not FLoaded then
    begin
      FLoaded := True;
      GetBitmaps;