jvqtransparentbutton.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: 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: JvQTransparentButton.pas,v 1.30 2004/12/21 09:45:19 asnepvangers Exp $

unit JvQTransparentButton;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  QWindows, QMessages, QGraphics, QControls,
  QExtCtrls, QMenus, QForms, QImgList, QActnList, QButtons, 
  JvQComponent, JvQButton;

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; 
    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;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQConsts;


{ 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;

function TJvTransparentButtonActionLink.IsCheckedLinked: Boolean;
begin
  if FClient is TJvTransparentButton then
    Result := inherited IsCheckedLinked and (TJvTransparentButton(FClient).Down = (Action as TCustomAction).Checked)
  else
  if FClient is TJvTransparentButton2 then
    Result := inherited IsCheckedLinked and (TJvTransparentButton2(FClient).Down = (Action as TCustomAction).Checked)
  else
    Result := False;
end;



procedure TJvTransparentButtonActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then
  begin
    if FClient is TJvTransparentButton then
      TJvTransparentButton(FClient).Down := Value
    else
    if FClient is TJvTransparentButton2 then
      TJvTransparentButton2(FClient).Down := Value;
  end;
end;

//=== { TJvTransparentButton } ===============================================

constructor TJvTransparentButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AllowAllUp := True;
  FNumGlyphs := 1;
  FAutoGray := True;
  FShowPressed := True;
  FOffset := 1;
  FBorderSize := 1;
  FTransparent := True;
  Flat := True;

  FImList := TImageList.Create(Self);
  FGlyph := TBitmap.Create;
  FGrayGlyph := TBitmap.Create;
  FDisabledGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChanged;

  FNumGlyphs := 1;
  FSpacing := 2;
  FTextAlign := ttaCenter;
  FWordWrap := False;
  FOutline := fsExplorer;
end;

destructor TJvTransparentButton.Destroy;
begin
  FGlyph.Free;
  FGrayGlyph.Free;
  FDisabledGlyph.Free;
//  FImList.Free;
  inherited Destroy;
end;

procedure TJvTransparentButton.CalcGlyphCount;
var
  GlyphNum: Integer;
begin
  if (Glyph <> nil) and (Glyph.Height > 0) then
  begin
    if Glyph.Width mod Glyph.Height = 0 then
    begin
      GlyphNum := Glyph.Width div Glyph.Height;
      if GlyphNum > 4 then
        GlyphNum := 1;
      SetNumGlyphs(GlyphNum);
    end;
  end;
end;

procedure TJvTransparentButton.AddGlyphs(aGlyph: TBitmap; AColor: TColor; Value: Integer);
var
  Bmp: TBitmap;
  I, TmpWidth: Integer;
  Dest, Source: TRect;
begin
  FImList.Clear;
  Bmp := TBitmap.Create;
  try
    if not aGlyph.Empty then
    begin
      { destroy old list }
      TmpWidth := aGlyph.Width div FNumGlyphs;
      FImList.Width := TmpWidth;
      FImList.Height := aGlyph.Height;
      Bmp.Width := FImList.Width;
      Bmp.Height := FImList.Height;
      Dest := Rect(0, 0, Bmp.Width, Bmp.Height);
      { create the imagelist }
      for I := 0 to FNumGlyphs - 1 do
      begin
        Source := Rect(I * Bmp.Width, 0, I * Bmp.Width + Bmp.Width, Bmp.Height);
        Bmp.Canvas.CopyRect(Dest, aGlyph.Canvas, Source);
        if I = 0 then { first picture }
        begin
          { create the disabled and grayed bitmaps too }
          FGrayGlyph.Assign(Bmp);
          MonoBitmap(FGrayGlyph, 11, 59, 30);
          FDisabledGlyph.Assign(Bmp);
          BWBitmap(FDisabledGlyph);
        end;
        FImList.AddMasked(Bmp, Bmp.TransparentColor);
      end;
      { add last }
      FImList.AddMasked(FGrayGlyph, FGrayGlyph.TransparentColor);
      FImList.AddMasked(FDisabledGlyph, FDisabledGlyph.TransparentColor);
    end;
  finally
    Bmp.Free;
  end;
  Invalidate;