jvtransparentbutton.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: JvTransparentButton.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

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: JvTransparentButton.pas,v 1.42 2005/02/17 10:20:57 marquardt Exp $

unit JvTransparentButton;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  Windows, Messages, Graphics, Controls,
  ExtCtrls, Menus, Forms, ImgList, ActnList, Buttons,
  {$IFDEF VCL}
  CommCtrl, JvJCLUtils,
  {$ENDIF VCL}
  JvComponent, JvButton;

type
  TJvFrameStyle =
    (fsRegular, fsIndent, fsExplorer, fsNone, fsLight, fsDark, fsMono);
  TJvTextAlign = (ttaTopLeft, ttaTop, ttaTopRight, ttaRight, ttaBottomRight,
    ttaBottom, ttaBottomLeft, ttaLeft, ttaCenter);

type
  TJvTransparentButtonActionLink = class(TControlActionLink)
  protected
    FClient: TJvCustomGraphicButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    {$IFDEF VCL}
    {$IFDEF COMPILER6_UP}
    function IsGroupIndexLinked: Boolean; override;
    procedure SetGroupIndex(Value: Integer); override;
    {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    procedure SetChecked(Value: Boolean); override;
  end;

  TJvTransparentButton = class(TJvCustomGraphicButton)
  private
    FTextAlign: TJvTextAlign;
    FAutoGray: Boolean;
    FTransparent: Boolean;
    FShowPressed: Boolean;
    FOffset: Integer;
    FSpacing: Integer;
    FGlyph: TBitmap;
    FGrayGlyph: TBitmap;
    FDisabledGlyph: TBitmap;
    FBorderSize: Cardinal;
    FNumGlyphs: TNumGlyphs;
    FImList: TImageList;
    FOutline: TJvFrameStyle;
    FWordWrap: Boolean;
    procedure SetWordWrap(Value: Boolean);
    procedure SetSpacing(Value: Integer);
    procedure SetAutoGray(Value: Boolean);
    procedure SetTextAlign(Value: TJvTextAlign);
    procedure SetGlyph(Bmp: TBitmap);
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure SetFrameStyle(Value: TJvFrameStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetBorderWidth(Value: Cardinal);
    procedure GlyphChanged(Sender: TObject);
    procedure CalcGlyphCount;
  protected
    procedure AddGlyphs(aGlyph: TBitmap; AColor: TColor; Value: Integer);
    procedure PaintButton(Canvas: TCanvas); override;
    procedure PaintFrame(Canvas: TCanvas); override;
    procedure DrawTheText(ARect: TRect; Canvas: TCanvas); virtual;
    procedure DrawTheBitmap(ARect: TRect; Canvas: TCanvas); virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean);override;
    function GetActionLinkClass: TControlActionLinkClass; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas;
  published
    property Action;
    property AllowAllUp;
    property Align;
    property Anchors;
    property Constraints;

    property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
    property BorderWidth: Cardinal read FBorderSize write SetBorderWidth default 1;
    property Caption;
    property Color;
    property DropDownMenu;
    property DropArrow;
    property Down;
    property Enabled;
    property Font;
    property GroupIndex;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;

    property FrameStyle: TJvFrameStyle read FOutline write SetFrameStyle default fsExplorer;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    property Offset: Integer read FOffset write FOffset default 1;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowPressed: Boolean read FShowPressed write FShowPressed default True;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property TextAlign: TJvTextAlign read FTextAlign write SetTextAlign default ttaCenter;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
    property OnClick;
    property OnDragDrop;
    property OnDropDownMenu;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnStartDrag;
  end;

  TJvTransparentButton2 = class(TJvCustomGraphicButton)
  private
    FTextAlign: TJvTextAlign;
    FAutoGray: Boolean;
    FTransparent: Boolean;
    FShowPressed: Boolean;
    FSpacing: Integer;
    FBorderSize: Cardinal;
    FGrayList: TImageList;
    FActiveList: TImageList;
    FDisabledList: TImageList;
    FDownList: TImageList;
    FGrayLink: TChangeLink;
    FActiveLink: TChangeLink;
    FDisabledLink: TChangeLink;
    FDownLink: TChangeLink;
    FGrayIndex: Integer;
    FActiveIndex: Integer;
    FDisabledIndex: Integer;
    FDownIndex: Integer;
    FImList: TImageList;
    FOutline: TJvFrameStyle;
    FWordWrap: Boolean;
    procedure SetAutoGray(Value: Boolean);
    procedure SetGrayList(Value: TImageList);
    procedure SetActiveList(Value: TImageList);
    procedure SetDisabledList(Value: TImageList);
    procedure SetDownList(Value: TImageList);
    procedure SetGrayIndex(Value: Integer);
    procedure SetActiveIndex(Value: Integer);
    procedure SetDisabledIndex(Value: Integer);
    procedure SetDownIndex(Value: Integer);
    procedure SetWordWrap(Value: Boolean);
    procedure SetSpacing(Value: Integer);
    procedure SetTextAlign(Value: TJvTextAlign);
    procedure SetFrameStyle(Value: TJvFrameStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetBorderWidth(Value: Cardinal);
    procedure GlyphChanged(Sender: TObject);
  protected
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure AddGlyphs;
    procedure PaintButton(Canvas: TCanvas); override;
    procedure PaintFrame(Canvas: TCanvas); override;
    procedure DrawTheText(ARect: TRect; Canvas: TCanvas); virtual;
    procedure DrawTheBitmap(ARect: TRect; Canvas: TCanvas); virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean);override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas;
    property InternalList: TImageList read FImList;
  published
    property Action;
    property Align;
    property AllowAllUp;
    property Anchors;
    property Constraints;
    property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
    property BorderWidth: Cardinal read FBorderSize write SetBorderWidth default 1;
    property Caption;
    property Color;
    property DropDownMenu;
    property DropArrow;

    property Down;
    property Enabled;
    property Font;
    property GroupIndex;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;

    property FrameStyle: TJvFrameStyle read FOutline write SetFrameStyle default fsExplorer;
    property ActiveImage: TImageList read FActiveList write SetActiveList;
    property ActiveIndex: Integer read FActiveIndex write SetActiveIndex default -1;
    property GrayImage: TImageList read FGrayList write SetGrayList;
    property GrayIndex: Integer read FGrayIndex write SetGrayIndex default -1;
    property DisabledImage: TImageList read FDisabledList write SetDisabledList;
    property DisabledIndex: Integer read FDisabledIndex write SetDisabledIndex default -1;
    property DownImage: TImageList read FDownList write SetDownList;
    property DownIndex: Integer read FDownIndex write SetDownIndex default -1;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowPressed: Boolean read FShowPressed write FShowPressed default True;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property TextAlign: TJvTextAlign read FTextAlign write SetTextAlign default ttaCenter;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
    property OnClick;
    property OnDragOver;
    property OnDragDrop;
    property OnDropDownMenu;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnStartDrag;
  end;

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

implementation

uses
  JvConsts;


{ create a grayed version of a color bitmap }
{ SLOW! don't use in realtime! }

procedure GrayBitmap(Bmp: TBitmap; R, G, B: Integer);
var
  I, J: Integer;
  Col: Longint;
begin
  if Bmp.Empty then
    Exit;
  for I := 0 to Bmp.Width do
    for J := 0 to Bmp.Height do
    begin
      Col := Bmp.Canvas.Pixels[I, J];
      Col := (GetRValue(Col) * R + GetGValue(Col) * G + GetBValue(Col) * B) div (R + G + B);
      Bmp.Canvas.Pixels[I, J] := RGB(Col, Col, Col);
    end;
end;

{ create a grayed version of a color bitmap }
{ SLOW! don't use in realtime! }

procedure MonoBitmap(Bmp: TBitmap; R, G, B: Integer);
var
  I, J: Integer;
  Col: Longint;
begin
  if Bmp.Empty then
    Exit;
  for I := 0 to Bmp.Width do
    for J := 0 to Bmp.Height do
    begin
      Col := Bmp.Canvas.Pixels[I, J];
      Col := (GetRValue(Col) * R + GetGValue(Col) * G + GetBValue(Col) * B) div (R + G + B);
      Bmp.Canvas.Pixels[I, J] := RGB(Col, Col, Col);
    end;
end;

{ create a disabled bitmap from a regular one, works best when bitmap has been
reduced to a few colors. Used by BWBitmap }

procedure DisabledBitmap(Bmp: TBitmap);
var
  MonoBmp, TmpImage: TBitmap;
  W, H: Integer;
begin
  if Bmp.Empty then
    Exit;
  MonoBmp := TBitmap.Create;
  TmpImage := TBitmap.Create;
  W := Bmp.Width;
  H := Bmp.Height;

  with TmpImage do
  begin
    Width := W;
    Height := H;
    Canvas.Brush.Color := clBtnFace;
  end;

  try
    with MonoBmp do
    begin
      Assign(Bmp);
      Canvas.Font.Color := clWhite;
      Canvas.Brush.Color := clBlack;
      Monochrome := True;
    end;

    with TmpImage.Canvas do
    begin
      Brush.Color := clBtnFace;
      FillRect(Rect(0, 0, W, H));
      Brush.Color := clBtnHighlight;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, 1, 1, W + 1, H + 1, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
      Brush.Color := clBtnShadow;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, 0, 0, W, H, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
    end;
    Bmp.Assign(TmpImage);
  finally
    MonoBmp.Free;
    TmpImage.Free;
  end;
end;

{ create a disabled bitmap by changing all colors to either black or TopLeftCol and then
  running it through DisabledBitmap }
{ SLOW! don't use in realtime! }

procedure BWBitmap(Bmp: TBitmap);
var
  I, J, W, H: Integer;
  TopLeftCol: TColor;
  Col: Longint;
begin
  if Bmp.Empty then
    Exit;

  W := Bmp.Width;
  H := Bmp.Height;
  TopLeftCol := Bmp.Canvas.Pixels[0, 0];

  for I := 0 to W do
    for J := 0 to H do
    begin
      Col := Bmp.Canvas.Pixels[I, J];
      if (Col <> clWhite) and (Col <> TopLeftCol) then
        Col := clBlack
      else
        Col := TopLeftCol;
      Bmp.Canvas.Pixels[I, J] := Col;
    end;
  DisabledBitmap(Bmp);
end;

//=== { TJvTransparentButtonActionLink } =====================================

procedure TJvTransparentButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TJvCustomGraphicButton;
end;