jvshapedbutton.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: JvShapedButton.PAS, released on 2002-11-12.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

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: JvShapedButton.pas,v 1.25 2005/02/18 14:17:29 ahuser Exp $

unit JvShapedButton;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls,
  JvThemes, JvExControls, JvExStdCtrls;

type
  TJvButtonShapes = (jvSLeftArrow, jvSRightArrow, jvSRound, jvSHex, jvSOctagon,
    jvSPar, jvSDiamond, jvSTriangleUp, jvSTriangleDown, jvSTriangleLeft,
    jvSTriangleRight, jvSPentagon, jvSRevPentagon, jvSRing);

  TJvShapedButton = class(TJvExButton, IJvDenySubClassing)
  private
    FBmp: TBitmap;
    FIsFocused: Boolean;
    FIsHot: Boolean;
    FCanvas: TCanvas;
    FHotColor: TColor;
    FFlat: Boolean;
    FFlatBorderColor: TColor;
    FButtonShape: TJvButtonShapes;
    FXP: Integer;
    FYP: Integer;
    FFlatArrow: Boolean;
    FAntiAlias: Boolean;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure SetHotColor(const Value: TColor);
    procedure SetFlat(const Value: Boolean);
    procedure SetFlatBorderColor(const Value: TColor);
    procedure SetButtonShape(const Value: TJvButtonShapes);
    procedure CNDrawItemOctagon(var Msg: TWMDrawItem);
    procedure CNDrawItemTriangleDown(var Msg: TWMDrawItem);
    procedure CNDrawItemTriangleLeft(var Msg: TWMDrawItem);
    procedure CNDrawItemTriangleRight(var Msg: TWMDrawItem);
    procedure CNDrawItemTriangleUp(var Msg: TWMDrawItem);
    procedure CNDrawItemPar(var Msg: TWMDrawItem);
    procedure CalcPentagon(AWidth, AHeight: Integer);
    procedure SetFlatArrow(const Value: Boolean);
    procedure CNDrawItemLeftArrow(var Msg: TWMDrawItem);
    procedure CNDrawItemRightArrow(var Msg: TWMDrawItem);
    procedure CNDrawItemRing(var Msg: TWMDrawItem);
    procedure CNDrawItemRound(var Msg: TWMDrawItem);
    procedure CNDrawItemPentagon(var Msg: TWMDrawItem);
    procedure CNDrawItemRevPentagon(var Msg: TWMDrawItem);
    procedure CNDrawItemHex(var Msg: TWMDrawItem);
    procedure CNDrawItemDiamond(var Msg: TWMDrawItem);
    procedure SetButton(ALeft, ATop, AWidth, AHeight: Integer);
    procedure DoAntiAlias(Bmp: TBitmap);
    procedure SetAntiAlias(const Value: Boolean);
  protected
    procedure SetRegionOctagon(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionTriangleDown(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionTriangleUp(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionTriangleLeft(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionTriangleRight(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionPar(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionLeftArrow(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionRightArrow(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionRound(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionHex(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionDiamond(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionPentagon(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionRevPentagon(ALeft, ATop, AWidth, AHeight: Integer);
    procedure SetRegionRing(ALeft, ATop, AWidth, AHeight: Integer);
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
    procedure MouseLeave(Control: TControl); override;
    procedure MouseEnter(Control: TControl); override;
    procedure FontChanged; override;
    procedure EnabledChanged; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure SetButtonStyle(ADefault: Boolean); override;
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ButtonShape: TJvButtonShapes read FButtonShape write SetButtonShape;
    property Color;
    property AntiAlias: Boolean read FAntiAlias write SetAntiAlias default False;
    property HotColor: TColor read FHotColor write SetHotColor;
    property Flat: Boolean read FFlat write SetFlat;
    property FlatBorderColor: TColor read FFlatBorderColor write SetFlatBorderColor;
    property FlatArrow: Boolean read FFlatArrow write SetFlatArrow;
    property Width default 65;
    property Height default 65;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnEnter;
    property OnExit;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvShapedButton.pas,v $';
    Revision: '$Revision: 1.25 $';
    Date: '$Date: 2005/02/18 14:17:29 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Math,
  JvJCLUtils;

constructor TJvShapedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAntiAlias := False;
  FBmp := TBitmap.Create;
  SetBounds(Left, Top, 65, 65);
  FCanvas := TCanvas.Create;
  FHotColor := clBlue;
  FFlatBorderColor := clWhite;
  FButtonShape := jvSTriangleUp; //TODO: Change to Left Arrow
end;

destructor TJvShapedButton.Destroy;
begin
  inherited Destroy;
  FBmp.Free;
  // (rom) destroy Canvas AFTER inherited Destroy
  FCanvas.Free;
end;

procedure TJvShapedButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style or BS_OWNERDRAW;
end;

procedure TJvShapedButton.CreateWnd;
begin
  inherited CreateWnd;
  SetButton(Left, Top, Width, Height);
end;

procedure TJvShapedButton.SetButton(ALeft, ATop,AWidth, AHeight: Integer);
begin
  if HandleAllocated then
  begin
    case FButtonShape of
      jvSLeftArrow:
        SetRegionLeftArrow(ALeft, ATop, AWidth, AHeight);
      jvSRightArrow:
        SetRegionRightArrow(ALeft, ATop, AWidth, AHeight);
      jvSRound:
        SetRegionRound(ALeft, ATop, AWidth, AHeight);
      jvSHex:
        SetRegionHex(ALeft, ATop, AWidth, AHeight);
      jvSOctagon:
        SetRegionOctagon(ALeft, ATop, AWidth, AHeight);
      jvSPar:
        SetRegionPar(ALeft, ATop, AWidth, AHeight);
      jvSDiamond:
        SetRegionDiamond(ALeft, ATop, AWidth, AHeight);
      jvSTriangleUp:
        SetRegionTriangleUp(ALeft, ATop, AWidth, AHeight);
      jvSTriangleDown:
        SetRegionTriangleDown(ALeft, ATop, AWidth, AHeight);
      jvSTriangleLeft:
        SetRegionTriangleLeft(ALeft, ATop, AWidth, AHeight);
      jvSTriangleRight:
        SetRegionTriangleRight(ALeft, ATop, AWidth, AHeight);
      jvSPentagon:
        SetRegionPentagon(ALeft, ATop, AWidth, AHeight);
      jvSRevPentagon:
        SetRegionRevPentagon(ALeft, ATop, AWidth, AHeight);
      jvSRing:
        SetRegionRing(ALeft, ATop, AWidth, AHeight);
    end;
  end;
end;

procedure TJvShapedButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SetButton(ALeft, ATop, AWidth, AHeight);
end;

procedure TJvShapedButton.CNDrawItem(var Msg: TWMDrawItem);
begin
  case FButtonShape of
    jvSLeftArrow:
      CNDrawItemLeftArrow(Msg);
    jvSRightArrow:
      CNDrawItemRightArrow(Msg);
    jvSRound:
      CNDrawItemRound(Msg);
    jvSHex:
      CNDrawItemHex(Msg);
    jvSOctagon:
      CNDrawItemOctagon(Msg);
    jvSPar:
      CNDrawItemPar(Msg);
    jvSDiamond:
      CNDrawItemDiamond(Msg);
    jvSTriangleUp:
      CNDrawItemTriangleUp(Msg);
    jvSTriangleDown:
      CNDrawItemTriangleDown(Msg);
    jvSTriangleLeft:
      CNDrawItemTriangleLeft(Msg);
    jvSTriangleRight:
      CNDrawItemTriangleRight(Msg);
    jvSPentagon:
      CNDrawItemPentagon(Msg);
    jvSRevPentagon:
      CNDrawItemRevPentagon(Msg);
    jvSRing:
      CNDrawItemRing(Msg);
  end;
end;

procedure TJvShapedButton.FontChanged;
begin
  inherited FontChanged;
  Invalidate;
end;

procedure TJvShapedButton.EnabledChanged;
begin
  inherited EnabledChanged;
  Invalidate;
end;

procedure TJvShapedButton.WMLButtonDblClk(var Msg: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Msg.Keys, Longint(Msg.Pos));
end;

procedure TJvShapedButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> FIsFocused then
  begin
    FIsFocused := ADefault;
    Invalidate;
  end;
end;

procedure TJvShapedButton.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not FIsHot then
  begin
    FIsHot := True;
    Invalidate;
    inherited MouseEnter(Control);
  end;
end;

procedure TJvShapedButton.MouseLeave(Control: TControl);
begin
  if FIsHot then
  begin
    FIsHot := False;
    Invalidate;
    inherited MouseLeave(Control);
  end;
end;

procedure TJvShapedButton.SetHotColor(const Value: TColor);
begin
  FHotColor := Value;
end;

procedure TJvShapedButton.SetFlat(const Value: Boolean);
begin
  FFlat := Value;
  Invalidate;
end;

procedure TJvShapedButton.SetFlatBorderColor(const Value: TColor);
begin
  FFlatBorderColor := Value;
end;

procedure TJvShapedButton.SetButtonShape(const Value: TJvButtonShapes);
begin
  if Value <> FButtonShape then
  begin
    FButtonShape := Value;
    if HandleAllocated then
    begin
      RecreateWnd;
      Invalidate;
    end;
  end;
end;

procedure TJvShapedButton.SetRegionOctagon(ALeft, ATop, AWidth, AHeight: Integer);
var
  x4, y4: Integer;
  hRegion: HRGN;
  Poly: array [0..7] of TPoint;
begin
  x4 := Width div 4;
  y4 := AHeight div 4;
  Poly[0] := Point(x4, 0);
  Poly[1] := Point(AWidth - x4, 0);
  Poly[2] := Point(AWidth, y4);
  Poly[3] := Point(AWidth, AHeight - y4);
  Poly[4] := Point(AWidth - x4, AHeight);
  Poly[5] := Point(x4, AHeight);
  Poly[6] := Point(0, AHeight - y4);
  Poly[7] := Point(0, y4);
  hRegion := CreatePolygonRgn(Poly, 8, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.CNDrawItemOctagon(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..8] of TPoint;
  PolyBR: array [0..4] of TPoint;
  PolyTL: array [0..4] of TPoint;
  x4, y4, w, h: Integer;

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    x4 := w div 4;
    y4 := h div 4;
    Poly[0] := Point(Rect.Left + x4, Rect.Top);
    Poly[1] := Point(Rect.Right - x4, Rect.Top);
    Poly[2] := Point(Rect.Right, Rect.Top + y4);
    Poly[3] := Point(Rect.Right, Rect.Bottom - y4);
    Poly[4] := Point(Rect.Right - x4, Rect.Bottom);
    Poly[5] := Point(Rect.Left + x4, Rect.Bottom);
    Poly[6] := Point(Rect.Left, Rect.Bottom - y4);
    Poly[7] := Point(Rect.Left, y4);
    Poly[8] := Poly[0];
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  // initialize
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  Rect := ClientRect;
  Dec(Rect.Right);
  Dec(Rect.Bottom);
  SetPoly;
  with Msg.DrawItemStruct^ do
  begin
    OdsDown := itemState and ODS_SELECTED <> 0;
    OdsFocus := itemState and ODS_FOCUS <> 0;
    ActionFocus := ItemAction = ODA_FOCUS
  end;
  FBmp.Width := Width;
  FBmp.Height := Height;
  with FBmp.Canvas do
  begin
    Pen.Width := 2;
    Brush.Color := Color;
    if not ActionFocus then
    begin
      // fill with current Color
      Brush.Style := bsSolid;
      FillRect(Rect);
    end;
    // do not fill any more
    Brush.Style := bsClear;
    // draw border if default

{    if Default or OdsFocus then
    begin
      Pen.Color := clWindowFrame;
      if not ActionFocus then
        Polyline(Poly);
      // reduce the area for further operations
      InflateRect (Rect, -1, -1);
    end;}
    // test code:
    //InflateRect (Rect, -1, -1);

    if FFlat and (not OdsDown) and (not FIsHot) and (not (csDesigning in ComponentState)) then
    begin
      Pen.Color := FFlatBorderColor;
      Polyline(Poly);
    end
    else
    if OdsDown then
    begin
      // draw gray border all around
      Pen.Color := clBtnShadow;
      if not ActionFocus then
        Polyline(Poly);
      // gray border (Bottom-Right)
      Pen.Color := clBtnHighlight;
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      PolyBR[4] := Poly[5];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[5];
      PolyTL[1] := Poly[6];
      PolyTL[2] := Poly[7];
      PolyTL[3] := Poly[0];
      PolyTL[4] := Poly[1];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      PolyBR[4] := Poly[5];
      Polyline(PolyBR);
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;