All geek questions in one place

Create a button that accepts .PNG images as a character

I am trying to understand how a property works SpeedButton Glyph, I found that the field is declared as:

FGlyph: TObject;

Bye propertyas:

property Glyph: TBitmap read GetGlyph write SetGlyph stored HasCustomGlyph;

This put me in such a way that I cannot understand this code, even if I read it line by line, when I tried to create my own SpeedButton, which accepts .PNGimages instead of images .bmponly.

The first time I thought of declaring a property as TPictureinstead of TBitmap.

Is there a way to create MySpeedButton with Glyph : TPicture?

What am I trying to do below:

TMyButton = class(TSpeedButton)
    private
     //
    FGlyph: TPicture;
    procedure SetGlyph(const Value: TPicture);
    protected
    //
    public
    //
    published
    //
      Property Glyph : TPicture read FGlyph write SetGlyph;
  end;

And the procedure:

procedure TMyButton.SetGlyph(const Value: TPicture);
begin
  FGlyph := Value;
end;
+4
source share
3 answers

, SpeedButton, TPicture .

. , .

    unit ncrSpeedButtonunit;

interface

uses
  Winapi.Windows, Vcl.Controls, Winapi.Messages, Vcl.Graphics, System.Classes;

type
  TButtonState = (bs_Down, bs_Normal, bs_Active);

  TGlyphCoordinates = class(TPersistent)
  private
    FX: integer;
    FY: integer;
    FOnChange: TNotifyEvent;
    procedure SetX(aX: integer);
    procedure SetY(aY: integer);
    function GetX: integer;
    function GetY: integer;
  public
    procedure Assign(aValue: TPersistent); override;
  published
    property X: integer read GetX write SetX;
    property Y: integer read GetY write SetY;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TNCRSpeedButton = class(TGraphicControl)
  private
    FGlyph: TPicture;
    FGlyphCoordinates: TGlyphCoordinates;
    FColor: TColor;
    FActiveColor: TColor;
    FDownColor: TColor;
    FBorderColor: TColor;
    Fstate: TButtonState;
    FFlat: boolean;
    FTransparent: boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure CMMouseUp(var Message: TMessage); message WM_LBUTTONUP;
    procedure SetGlyph(aGlyph: TPicture);
    procedure SetGlyphCoordinates(aCoordinates: TGlyphCoordinates);
    procedure SetColor(aColor: TColor);
    procedure SetActiveColor(aActiveColor: TColor);
    procedure SetDownColor(aDownColor: TColor);
    procedure SetBorderColor(aBorderColor: TColor);
    procedure SetFlat(aValue: boolean);
    procedure GlyphChanged(Sender: TObject);
    procedure CoordinatesChanged(Sender: TObject);
    procedure SetTransparency(aValue: boolean);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    Constructor Create(Owner: TComponent); override;
    Destructor Destroy; override;
  published
    property Glyph: Tpicture read FGlyph write SetGlyph;
    property GlyphCoordinates: TGlyphCoordinates read FGlyphCoordinates write SetGlyphCoordinates;
    property Color: TColor read FColor write SetColor;
    property ActiveColor: TColor read FActiveColor write SetActiveColor;
    property DownColor: TColor read FDownColor write SetDownColor;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property Flat: boolean read FFlat write SetFlat;
    property IsTransparent: boolean read FTransparent write SetTransparency;
    property ParentShowHint;
    property ParentBiDiMode;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
  end;


implementation

{ TNCRSpeedButton }

Constructor TNCRSpeedButton.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FGlyph := TPicture.Create;
  FGlyph.OnChange := GlyphChanged;
  FGlyphCoordinates := TGlyphCoordinates.Create;
  FGlyphCoordinates.OnChange := CoordinatesChanged;
  FState := bs_Normal;
  FColor := clBtnFace;
  FActiveColor := clGradientActiveCaption;
  FDownColor := clHighlight;
  FBorderColor := clBlue;
  FFlat := False;
  FTransparent := False;
  SetBounds(0, 0, 200, 50);
end;

Destructor TNCRSpeedButton.Destroy;
begin
  FGlyph.Free;
  FGlyphCoordinates.Free;
  inherited;
end;

procedure CreateMask(aCanvas: TCanvas; Area: TRect; aColor: Tcolor);
  var
  EBitmap, OBitmap: TBitmap;
begin

  EBitmap := TBitmap.Create;
  OBitmap := TBitmap.Create;
  try
    EBitmap.Width := Area.Width ;
    EBitmap.Height := Area.Height;
    EBitmap.Canvas.CopyRect(Area, aCanvas, Area);

    OBitmap.Width := Area.Width;
    OBitmap.Height := Area.Height;
    OBitmap.Canvas.CopyRect(Area, aCanvas, Area);
    OBitmap.Canvas.Brush.Color := aColor;
    OBitmap.Canvas.Pen.Style := psClear;

    OBitmap.Canvas.Rectangle(Area);

    aCanvas.Draw(0, 0, EBitmap);
    aCanvas.Draw(0, 0, OBitmap, 127);
  finally
    EBitmap.free;
    OBitmap.free;
  end;
end;

procedure DrawParentImage(Control: TControl; Dest: TCanvas);
var
  SaveIndex: Integer;
  DC: HDC;
  Position: TPoint;
begin
  with Control do
  begin
    if Parent = nil then
      Exit;
    DC := Dest.Handle;
    SaveIndex := SaveDC(DC);
    GetViewportOrgEx(DC, Position);
    SetViewportOrgEx(DC, Position.x - Left, Position.y - Top, nil);
    IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
    Parent.Perform(WM_ERASEBKGND, DC, 0);
    Parent.Perform(WM_PAINT, DC, 0);
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TNCRSpeedButton.Paint;

var
  BackgroundColor: TColor;
begin

  case FState of
    bs_Down: BackgroundColor := FDownColor;
    bs_Normal: BackgroundColor := FColor;
    bs_Active: BackgroundColor := FActiveColor;
  else
    BackgroundColor := FColor;
  end;

  // Drawing Background
  if not FTransparent then
    begin
      Canvas.Brush.Color := BackgroundColor;
      Canvas.FillRect(ClientRect);
    end
  else
    begin
      case FState of
        bs_Down:
          begin
            DrawParentImage(parent, Canvas);
            CreateMask(Canvas, ClientRect, FDownColor);
          end;
        bs_Normal:
          begin
            DrawParentImage(parent, Canvas);
          end;
        bs_Active:
          begin
            DrawParentImage(parent, Canvas);
            CreateMask(Canvas, ClientRect, FActiveColor);
          end;
      end;
    end;

  // Drawing Borders

  Canvas.Pen.Color := FBorderColor;
  Canvas.MoveTo(0, 0);
  if not FFlat then
    begin
      Canvas.LineTo(Width-1, 0);
      Canvas.LineTo(Width-1, Height-1);
      Canvas.LineTo(0, Height-1);
      Canvas.LineTo(0, 0);
    end;

  // Drawing the Glyph

  if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
    begin
      Canvas.Draw(FGlyphCoordinates.X, FGlyphCoordinates.Y, FGlyph.Graphic);
    end;

end;

procedure TNCRSpeedButton.GlyphChanged(Sender: TObject);
begin
  if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
  begin
    FGlyphCoordinates.OnChange := nil; // Prevent multiple invalidates
    FGlyphCoordinates.X := (Width - FGlyph.Graphic.Width) div 2;
    FGlyphCoordinates.Y := (Height - FGlyph.Graphic.Height) div 2;
    FGlyphCoordinates.OnChange := CoordinatesChanged;
  end;
  Invalidate;
end;

procedure TNCRSpeedButton.CoordinatesChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TNCRSpeedButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FState := bs_Active;
  Invalidate;
end;

procedure TNCRSpeedButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FState := bs_Normal;
  Invalidate;
end;

procedure TNCRSpeedButton.CMMouseDown(var Message: TMessage);
begin
  inherited;
  FState := bs_Down;
  Invalidate;
end;

procedure TNCRSpeedButton.CMMouseUp(var Message: TMessage);
begin
  inherited;
  FState := bs_Active;
  Invalidate;
end;

procedure TNCRSpeedButton.SetGlyph(aGlyph: TPicture);
begin
  FGlyph.Assign(aGlyph);
end;

procedure TNCRSpeedButton.Resize;
begin
  if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
  begin
    FGlyphCoordinates.OnChange := nil; // Prevent multiple invalidates
    FGlyphCoordinates.X := (Width - FGlyph.Graphic.Width) div 2;
    FGlyphCoordinates.Y := (Height - FGlyph.Graphic.Height) div 2;
    FGlyphCoordinates.OnChange := CoordinatesChanged;
  end;
  inherited;
end;

procedure TNCRSpeedButton.SetGlyphCoordinates(aCoordinates: TGlyphCoordinates);
begin
  FGlyphCoordinates.assign(aCoordinates);
end;

procedure TNCRSpeedButton.SetColor(aColor: TColor);
begin
  FColor := aColor;
  Invalidate;
end;

procedure TNCRSpeedButton.SetActiveColor(aActiveColor: TColor);
begin
  FActiveColor := aActiveColor;
  Invalidate;
end;

procedure TNCRSpeedButton.SetDownColor(aDownColor: TColor);
begin
  FDownColor := aDownColor;
  Invalidate;
end;

procedure TNCRSpeedButton.SetBorderColor(aBorderColor: TColor);
begin
  FBorderColor := aBorderColor;
  Invalidate;
end;

procedure TNCRSpeedButton.SetFlat(aValue: boolean);
begin
  FFlat := aValue;
  Invalidate;
end;

procedure TNCRSpeedButton.SetTransparency(aValue: boolean);
begin
  FTransparent := aValue;
  Invalidate;
end;

{TGlyphCoordinates}

procedure TGlyphCoordinates.SetX(aX: integer);
begin
  FX := aX;
  if Assigned(FOnChange) then
       FOnChange(self);
end;

procedure TGlyphCoordinates.SetY(aY: integer);
begin
  FY := aY;
  if Assigned(FOnChange) then
       FOnChange(self);
end;

function TGlyphCoordinates.GetX: integer;
begin
  result := FX;
end;

function TGlyphCoordinates.GetY: integer;
begin
  result := FY;
end;

procedure TGlyphCoordinates.assign(aValue: TPersistent);
begin
  if aValue is TGlyphCoordinates then begin
    FX := TGlyphCoordinates(aValue).FX;
    FY := TGlyphCoordinates(aValue).FY;
  end else
    inherited;
end;



end.
+2

SetGlyph() FGlyph.Assign(Value) FGlyph := Value. FGlyph . override Paint(), Graphic .

type
  TMyButton = class(TGraphicControl)
  private
    FGlyph: TPicture;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(const Value: TPicture);
    protected
      procedure Paint; override;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      property Glyph : TPicture read FGlyph write SetGlyph;
  end;

constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited;
  FGlyph := TPicture.Create;
  FGlyph.OnChange := GlyphChanged;
end;

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

procedure TMyButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TMyButton.SetGlyph(const Value: TPicture);
begin
  FGlyph.Assign(Value):
end;

procedure TMyButton.Paint;
begin
 ...
  if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
    Canvas.Draw(..., FGlyph.Graphic);
 ... 
end;
+4

, Glyph TSpeedButton, , , .

TSpeedButton FGlyph TObject, , TButtonGlyph. TSpeedButton FGlyph := TButtonGlyph.Create; Glyph TSpeedButton :

function TSpeedButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TSpeedButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;
end;

, TSpeedButton Glyph Glyph TButtonGlyph, , Vcl.Buttons, , , TBitMap

property Glyph: TBitmap read FOriginal write SetGlyph;

, TButtonGlyph TBitMap "", :

procedure TButtonGlyph.SetGlyph(Value: TBitmap);
var
  Glyphs: Integer;
begin
  Invalidate;
  FOriginal.Assign(Value);
  if (Value <> nil) and (Value.Height > 0) then
  begin
    FTransparentColor := Value.TransparentColor;
    if Value.Width mod Value.Height = 0 then
    begin
      Glyphs := Value.Width div Value.Height;
      if Glyphs > 4 then Glyphs := 1;
      SetNumGlyphs(Glyphs);
    end;
  end;
end;

, .PNG:

  • PNG .
  • PNG

, - . TButtonGylph OOP, png, , . , Remy : .

, :

FOriginal.Assign(Value);, PNG, TPNGImage AssignTo , TBitMap. Glyph PNG :

var
  APNG: TPngImage;
begin
  APNG := TPngImage.Create;
  try
    APNG.LoadFromFile('C:\Binoculars.png');
    SpeedButton1.Glyph.Assign(APNG);
  finally
    APNG.Free;
  end;

- PNG , , - PNG, Andreas Rejbrand :

var
  APNG: TPngImage;
  ABMP: TBitmap;
begin
  APNG := TPngImage.Create;
  ABMP := TBitmap.Create;
  try
    APNG.LoadFromFile('C:\Binoculars.png');

    ABMP.SetSize(APNG.Width, APNG.Height);
    ABMP.Canvas.Brush.Color := Self.Color;
    ABMP.Canvas.FillRect(Rect(0, 0, ABMP.Width, ABMP.Height));
    ABMP.Canvas.Draw(0, 0, APNG);

    SpeedButton1.Glyph.Assign(APNG);
  finally
    APNG.Free;
    ABMP.Free;
  end;
end;
+2
source

Source: https://habr.com/ru/post/1687517/

More articles:


All Articles