jvqspeedbutton.pas

East make Tray Icon in delphi

    procedure Invalidate;
    function DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
      State: TJvButtonState): TPoint;
    function DrawButtonImage(Canvas: TCanvas; X, Y: Integer; Images: TCustomImageList;
      ImageIndex: Integer; State: TJvButtonState): TPoint;
    function DrawEx(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
      PopupMark: Boolean; Images: TCustomImageList; ImageIndex: Integer;
      State: TJvButtonState; Flags: Word): TRect;
    procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
      TextBounds: TRect; State: TJvButtonState; Flags: Word);
    procedure DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
      State: TJvButtonState);
    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
      PopupMark: Boolean; State: TJvButtonState; Flags: Word): TRect;
    property Alignment: TAlignment read FAlignment write FAlignment;
    property Glyph: TBitmap read FOriginal write SetGlyph;
    property GrayNewStyle: Boolean read FGrayNewStyle write SetGrayNewStyle;
    property NumGlyphs: TJvNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property WordWrap: Boolean read FWordWrap write FWordWrap;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

{ DrawButtonFrame - returns the remaining usable area inside the Client rect }

function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
  IsDown, IsFlat: Boolean; Style: TButtonStyle; AColor: TColor): TRect;

implementation

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

type
  TJvGlyphList = class;

  TJvGlyphCache = class(TObject)
  private
    FGlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TJvGlyphList;
    procedure ReturnList(List: TJvGlyphList);
    function Empty: Boolean;
  end;

  TJvGlyphList = class(TImageList)
  private
    FUsed: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize(AWidth, AHeight: Integer);
    destructor Destroy; override;
    function Add(Image, Mask: TBitmap): Integer;  override; 
    function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;  override; 
    procedure Delete(Index: Integer);
    property Count: Integer read FCount;
  end;

  //TFontAccessProtected = class(TFont);

const
  Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);

var
  // (rom) changed to var
  // (rb) used for?
  ButtonCount: Integer;
  GlyphCache: TJvGlyphCache;

//=== Local procedures =======================================================

{ DrawButtonFrame - returns the remaining usable area inside the Client rect }

function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
  IsDown, IsFlat: Boolean; Style: TButtonStyle; AColor: TColor): TRect;

const
  clWindowFrame = cl3DDkShadow; // clWindowFrame is a blue tone

var
  NewStyle: Boolean;
  ShadowColor, HighlightColor: TColor;

  // Honeymic
  function GetHighlightColor(BaseColor: TColor): TColor;
  begin
   Result := RGB(
      Min(GetRValue(ColorToRGB(BaseColor)) + 64, 255),
      Min(GetGValue(ColorToRGB(BaseColor)) + 64, 255),
      Min(GetBValue(ColorToRGB(BaseColor)) + 64, 255));
  end;

  // Honeymic
  function GetShadowColor(BaseColor: TColor): TColor;
  begin
   Result := RGB(
      Max(GetRValue(ColorToRGB(BaseColor)) - 64, 0),
      Max(GetGValue(ColorToRGB(BaseColor)) - 64, 0),
      Max(GetBValue(ColorToRGB(BaseColor)) - 64, 0));
  end;
  
begin
  Result := Client;
  NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
  ShadowColor := GetShadowColor(AColor);     // Honeymic
  HighlightColor := GetHighlightColor(AColor);  // Honeymic

  if IsDown then
  begin
    if NewStyle then
    begin
      //Polaris
      //Frame3D(Canvas, Result,clBtnShadow{ clWindowFrame}, clBtnHighlight, 1);
      //if not IsFlat then
      //  Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
      if not IsFlat then
      begin
        // Honeymic
        Frame3D(Canvas, Result, clWindowFrame, HighlightColor, 1);
        Frame3D(Canvas, Result, ShadowColor, AColor, 1);
      end
      else
        // Honeymic
        Frame3D(Canvas, Result, ShadowColor, HighlightColor, 1);
    end
    else
    begin
      if IsFlat then
      begin
        // Honeymic
        Frame3D(Canvas, Result, clWindowFrame, HighlightColor, 1);
      end
      else
      begin
        Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
        // Honeymic
        Canvas.Pen.Color := clBtnShadow;
        Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
          Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
      end;
    end;
  end
  else
  begin
    if NewStyle then
    begin
      if IsFlat then
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, ShadowColor, 1)
      else
      begin
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, clWindowFrame, 1);
        Frame3D(Canvas, Result, AColor, ShadowColor, 1);
      end;
    end
    else
    begin
      if IsFlat then
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, clWindowFrame, 1)
      else
      begin
        Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
        // Honeymic
        Frame3D(Canvas, Result, HighlightColor, ShadowColor, 1);
      end;
    end;
  end;
  InflateRect(Result, -1, -1);
end;

//=== { TJvSpeedButtonHotTrackOptions } ======================================

constructor TJvSpeedButtonHotTrackOptions.Create;
begin
  inherited Create;
  FEnabled := False;
  FColor := $00D2BDB6;
  FFrameColor := $006A240A;
end;

procedure TJvSpeedButtonHotTrackOptions.Assign(Source: TPersistent);
begin
  if Source is TJvSpeedButtonHotTrackOptions then
  begin
    Enabled := TJvSpeedButtonHotTrackOptions(Source).Enabled;
    Color := TJvSpeedButtonHotTrackOptions(Source).Color;
    FrameColor := TJvSpeedButtonHotTrackOptions(Source).FrameColor;
  end
  else
    inherited Assign(Source);
end;

//=== { TJvButtonImage } =====================================================

constructor TJvButtonImage.Create;
begin
  FGlyph := TJvxButtonGlyph.Create;
  NumGlyphs := 1;
  FButtonSize := Point(24, 23);
end;

destructor TJvButtonImage.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TJvButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  Layout: TButtonLayout; AFont: TFont; Flags: Word);
begin
  DrawEx(Canvas, X, Y, Margin, Spacing, Layout, AFont, nil, -1, Flags);
end;

procedure TJvButtonImage.DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  Layout: TButtonLayout; AFont: TFont; Images: TImageList; ImageIndex: Integer;
  Flags: Word);
var
  Target: TRect;
  SaveColor: Integer;
  SaveFont: TFont;
  Offset: TPoint;
begin
  SaveColor := Canvas.Brush.Color;
  SaveFont := TFont.Create;
  SaveFont.Assign(Canvas.Font);
  try
    Target := Bounds(X, Y, FButtonSize.X, FButtonSize.Y);
    Offset := Point(0, 0);
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(Target);
    Frame3D(Canvas, Target, clBtnShadow, clWindowFrame, 1);
    Frame3D(Canvas, Target, clBtnHighlight, clBtnShadow, 1);
    if AFont <> nil then
      Canvas.Font := AFont;
    TJvxButtonGlyph(FGlyph).DrawEx(Canvas, Target, Offset, Caption, Layout, Margin,
      Spacing, False, Images, ImageIndex, rbsUp, Flags);
  finally
    Canvas.Font.Assign(SaveFont);
    SaveFont.Free;
    Canvas.Brush.Color := SaveColor;
  end;
end;

function TJvButtonImage.GetAlignment: TAlignment;
begin
  Result := TJvxButtonGlyph(FGlyph).Alignment;
end;

function TJvButtonImage.GetGlyph: TBitmap;
begin
  Result := TJvxButtonGlyph(FGlyph).Glyph;
end;

function TJvButtonImage.GetNumGlyphs: TJvNumGlyphs;
begin
  Result := TJvxButtonGlyph(FGlyph).NumGlyphs;
end;

function TJvButtonImage.GetWordWrap: Boolean;
begin
  Result := TJvxButtonGlyph(FGlyph).WordWrap;
end;

procedure TJvButtonImage.Invalidate;
begin
  TJvxButtonGlyph(FGlyph).Invalidate;
end;

procedure TJvButtonImage.SetAlignment(Value: TAlignment);
begin
  TJvxButtonGlyph(FGlyph).Alignment := Value;
end;

procedure TJvButtonImage.SetGlyph(Value: TBitmap);
begin
  TJvxButtonGlyph(FGlyph).Glyph := Value;
end;

procedure TJvButtonImage.SetNumGlyphs(Value: TJvNumGlyphs);
begin
  TJvxButtonGlyph(FGlyph).NumGlyphs := Value;
end;

procedure TJvButtonImage.SetWordWrap(Value: Boolean);
begin
  TJvxButtonGlyph(FGlyph).WordWrap := Value;
end;

//=== { TJvCustomSpeedButton } ===============================================

procedure TJvCustomSpeedButton.ButtonClick;
begin
  if FMenuTracking or (not Enabled) or (Assigned(FDropDownMenu) and
    DropDownMenu.AutoPopup) then
    Exit;
  if not FDown then
  begin
    FState := rbsDown;
    Repaint;
  end;
  try
    Sleep(20); // (ahuser) why? 
    if FGroupIndex = 0 then
      Click;
  finally
    FState := rbsUp;
    if FGroupIndex = 0 then
      Repaint
    else
    begin
      SetDown(not FDown);
      Click;
    end;
  end;
end;

function TJvCustomSpeedButton.CheckBtnMenuDropDown: Boolean;
begin
  Result := CheckMenuDropDown(PointToSmallPoint(GetDropDownMenuPos), True);
end;

function TJvCustomSpeedButton.CheckMenuDropDown(const Pos: TSmallPoint;
  Manual: Boolean): Boolean;
  
begin
  Result := False;
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FDropDownMenu) and (DropDownMenu.AutoPopup or Manual) then
  begin 
    DropDownMenu.PopupComponent := Self;
    with ClientToScreen(SmallPointToPoint(Pos)) do
      DropDownMenu.Popup(X, Y);
    Result := True;
  end;
end;

procedure TJvCustomSpeedButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;
  inherited Click;
end;

procedure TJvCustomSpeedButton.CMButtonPressed(var Msg: TCMButtonPressed);
var
  Sender: TControl;
begin
  if (Msg.Index = FGroupIndex) and Parent.HandleAllocated then
  begin
    Sender := Msg.Control;
    if (Sender <> nil) and (Sender is TJvCustomSpeedButton) then
      if Sender <> Self then
      begin
        if TJvCustomSpeedButton(Sender).Down and FDown then
        begin
          FDown := False;
          FState := rbsUp;
          Repaint;
        end;
        FAllowAllUp := TJvCustomSpeedButton(Sender).AllowAllUp;
      end;
  end;
end;

function TJvCustomSpeedButton.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
begin
  Result := IsAccel(Key, Caption) and Enabled and (ssAlt in Shift);
  if Result then
    Click
  else
    inherited WantKey(Key, Shift, KeyText);
end;

procedure TJvCustomSpeedButton.EnabledChanged;
var
  State: TJvButtonState;
begin
  inherited EnabledChanged;
  if Enabled then
  begin
    if Flat then
      State := rbsInactive
    else
      State := rbsUp;
  end
  else
    State := rbsDisabled;
  TJvxButtonGlyph(FGlyph).CreateButtonGlyph(State);
  { Resync MouseOver }
  UpdateTracking;
  Repaint;
end;

procedure TJvCustomSpeedButton.FontChanged;
begin
  UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
  Invalidate;
end;

procedure TJvCustomSpeedButton.MouseEnter(Control: TControl);
var
  NeedRepaint: Boolean;
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver and Enabled then
  begin
    { Don't draw a border if DragMode <> dmAutomatic since this button is meant to
      be used as a dock client. }
    NeedRepaint := 
      FHotTrack or (FFlat and Enabled and (DragMode <> dmAutomatic) and (GetCapture = NullHandle));

    inherited MouseEnter(Control); // set MouseOver

    { Windows XP introduced hot states also for non-flat buttons. }
    if NeedRepaint then
      Repaint;
  end;
end;

procedure TJvCustomSpeedButton.MouseLeave(Control: TControl);
var
  NeedRepaint: Boolean;
begin
  if MouseOver and Enabled then
  begin