Componentes.Terceros.PNGComponents/official/1.2.0/Source/PngBitBtn.pas

unit PngBitBtn;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Buttons, pngimage, PngFunctions;

type
  TPngBitBtn = class(TBitBtn)
  private
    FPngImage: TPngImage;
    FPngOptions: TPngOptions;
    FCanvas: TCanvas;
    FLastKind: TBitBtnKind;
    FImageFromAction: Boolean;
    FMouseInControl: Boolean;
    IsFocused: Boolean;
    function PngImageStored: Boolean;
    procedure SetPngImage(const Value: TPngImage);
    procedure SetPngOptions(const Value: TPngOptions);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PngImage: TPngImage read FPngImage write SetPngImage stored PngImageStored;
    property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
    property Glyph stored False;
    property NumGlyphs stored False;
  end;

implementation

uses
  ActnList, Themes, PngButtonFunctions;

{ TPngBitBtn }

constructor TPngBitBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPngImage := TPngImage.Create;
  FPngOptions := [pngBlendOnDisabled];
  FCanvas := TCanvas.Create;
  FLastKind := bkCustom;
  FImageFromAction := False;
end;

destructor TPngBitBtn.Destroy;
begin
  FPngImage.Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TPngBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then begin
    with TCustomAction(Sender) do begin
      //Copy image from action's imagelist
      if (PngImage.Empty or FImageFromAction) and (ActionList <> nil) and
        (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex <
        ActionList.Images.Count) then begin
        CopyImageFromImageList(FPngImage, ActionList.Images, ImageIndex);
        FImageFromAction := True;
      end;
    end;
  end;
end;

procedure TPngBitBtn.SetButtonStyle(ADefault: Boolean);
begin
  inherited SetButtonStyle(ADefault);
  if ADefault <> IsFocused then begin
    IsFocused := ADefault;
    Refresh;
  end;
end;

function TPngBitBtn.PngImageStored: Boolean;
begin
  Result := not FImageFromAction;
end;

procedure TPngBitBtn.SetPngImage(const Value: TPngImage);
begin
  //This is all neccesary, because you can't assign a nil to a TPngImage
  if Value = nil then begin
    FPngImage.Free;
    FPngImage := TPngImage.Create;
  end
  else begin
    FPngImage.Assign(Value);
  end;

  //To work around the gamma-problem
  with FPngImage do
    if not Empty and (Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA, COLOR_PALETTE]) then
      Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));

  FImageFromAction := False;
  Repaint;
end;

procedure TPngBitBtn.SetPngOptions(const Value: TPngOptions);
begin
  if FPngOptions <> Value then begin
    FPngOptions := Value;
    Repaint;
  end;
end;

procedure TPngBitBtn.CNDrawItem(var Message: TWMDrawItem);
var
  R, PaintRect: TRect;
  GlyphPos, TextPos: TPoint;
  IsDown, IsDefault: Boolean;
  Flags: Cardinal;
  Button: TThemedButton;
  Details: TThemedElementDetails;
begin
  R := ClientRect;
  FCanvas.Handle := Message.DrawItemStruct^.hDC;
  FCanvas.Font := Self.Font;
  IsDown := Message.DrawItemStruct^.itemState and ODS_SELECTED <> 0;
  IsDefault := Message.DrawItemStruct^.itemState and ODS_FOCUS <> 0;

  //Draw the border
  if ThemeServices.ThemesEnabled then begin
    //Themed border
    if not Enabled then
      Button := tbPushButtonDisabled
    else if IsDown then
      Button := tbPushButtonPressed
    else if FMouseInControl then
      Button := tbPushButtonHot
    else if IsFocused or IsDefault then
      Button := tbPushButtonDefaulted
    else
      Button := tbPushButtonNormal;

    //Paint the background, border, and finally get the inner rect
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawParentBackground(Handle, Message.DrawItemStruct.hDC, @Details, True);
    ThemeServices.DrawElement(Message.DrawItemStruct.hDC, Details, Message.DrawItemStruct.rcItem);
    R := ThemeServices.ContentRect(FCanvas.Handle, Details, Message.DrawItemStruct.rcItem);
  end
  else begin
    //Draw the outer border, when focused
    if IsFocused or IsDefault then begin
      FCanvas.Pen.Color := clWindowFrame;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Style := bsClear;
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      InflateRect(R, -1, -1);
    end;
    //Draw the inner border
    if IsDown then begin
      FCanvas.Pen.Color := clBtnShadow;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Color := clBtnFace;
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      InflateRect(R, -1, -1);
    end
    else begin
      Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
      if Message.DrawItemStruct.itemState and ODS_DISABLED <> 0 then
        Flags := Flags or DFCS_INACTIVE;
      DrawFrameControl(Message.DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
    end;
    //Adjust the rect when focused and/or down
    if IsFocused then begin
      R := ClientRect;
      InflateRect(R, -1, -1);
    end;
    if IsDown then
      OffsetRect(R, 1, 1);
  end;

  //Calculate the position of the PNG glyph
  CalcButtonLayout(FCanvas, FPngImage, ClientRect, IsDown, False, Caption,
    Layout, Margin, Spacing, GlyphPos, TextPos, DrawTextBiDiModeFlags(0));

  //Draw the image
  if (FPngImage <> nil) and (Kind = bkCustom) and not FPngImage.Empty then begin
    PaintRect := Bounds(GlyphPos.X, GlyphPos.Y, FPngImage.Width, FPngImage.Height);
    if Enabled then
      DrawPNG(FPngImage, FCanvas, PaintRect, [])
    else
      DrawPNG(FPngImage, FCanvas, PaintRect, FPngOptions);
  end;

  //Draw the text
  if Length(Caption) > 0 then begin
    PaintRect := Rect(TextPos.X, TextPos.Y, Width, Height);
    FCanvas.Brush.Style := bsClear;
    DrawText(FCanvas.Handle, PChar(Caption), -1, PaintRect,
      DrawTextBiDiModeFlags(0) or DT_TOP or DT_LEFT or DT_SINGLELINE);
  end;

  //Draw the focus rectangle
  if IsFocused and IsDefault then begin
    if not ThemeServices.ThemesEnabled then begin
      R := ClientRect;
      InflateRect(R, -3, -3);
    end;
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, R);
  end;

  FLastKind := Kind;
  FCanvas.Handle := 0;
end;

procedure TPngBitBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if ThemeServices.ThemesEnabled and not FMouseInControl and not (csDesigning in ComponentState) then begin
    FMouseInControl := True;
    Repaint;
  end;
end;

procedure TPngBitBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if ThemeServices.ThemesEnabled and FMouseInControl then begin
    FMouseInControl := False;
    Repaint;
  end;
end;

end.