2017-10-15 1 views
4

문양 등 .PNG 이미지를 받아들이는 버튼을 만들기로 :나는 <code>SpeedButton</code><code>Glyph</code> 속성 작업, I 필드가 선언 된 것을 발견하는 방법을 이해하기 위해 노력하고있어

FGlyph: TObject;

동안 property로 :

난 내 자신을 만들려고 할 때 내가, 내가 줄 단위로 읽을 경우에도 그 코드를 이해할 수있는 방법으로 나를 넣어

property Glyph: TBitmap read GetGlyph write SetGlyph stored HasCustomGlyph;

,897,은 .bmp 이미지 대신 .PNG 개의 이미지도 허용합니다.

처음으로 나는 TBitmap 대신 TPicture으로 속성을 선언 할 생각이었습니다.

Glyph : TPicture으로 MySpeedButton을 만드는 방법이 있습니까?

는 내가하려고하는 것은 다음과 같습니다 :

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

그리고 절차 :

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

답변

2

: 안드레아스 Rejbrand에서 해당하는 부분적인 해결책이있다.

이것은 단위입니다. 나는 당신이 그것으로부터 좋은 이익을 얻길 바랍니다.

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. 
4

귀하의 SetGlyph() 요구 대신 FGlyph := ValueFGlyph.Assign(Value)를 호출합니다. 생성자에 FGlyph을 만들고 소멸자에서 파괴해야합니다. 그런 다음 Graphic이 비어 있지 않은 경우 재정의 된 Paint()에서 그래픽을 그릴 수 있습니다.

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

레미,이 코드는 오류없이 작동하지만 양식이나로드 된 이미지의 단추를 볼 수 없습니다. – Sami

+0

@ Sami 당신은'Paint'에서 나머지 버튼을 그리는거야? '페인트 '를 오버라이드하면 배경, 테두리, 텍스트 등 모든 것을 그려야합니다. –

+0

아니요, 내가하는 모든 작업은'Canvas.Draw (0,0, FGlyph.Graphic);'이고, 위쪽과 왼쪽에서 0으로 단추가 폼에 표시되지만 이미지처럼 보입니다 (언론 효과 없음). – Sami

2

첫 번째 부분은 TSpeedButton 작품의 Glyph 속성은이 문제의 일부로 것을 요구하는 것 같은 방법에 관한 것입니다.

TSpeedButtonFGlyph 필드는 TObject으로 선언되지만 코드에는 실제로 TButtonGlyph의 인스턴스가 포함되어 있습니다. ,

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

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

그래서 TSpeedButtonGlyph 속성이 실제로 TButtonGlyph 클래스의 Glyph 속성을 액세스 : TSpeedButton 생성자에서이 같은 Glyph 재산 TSpeedButton의 모습에 대한 행 FGlyph := TButtonGlyph.Create; 와 세터와 게터를 찾을 수 Vcl.Buttons에 정의 된 내부 클래스는 다음 중 하나의 속성을 포함하는 실제 TBitMap을 캡슐화합니다.

property Glyph: TBitmap read FOriginal write SetGlyph; 

는 그래서 TButtonGlyphTBitMap 필드 FOriginal을 가지고 있으며, 세터는 다음과 같이 구현됩니다

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 이미지 내가 레미 Lebeau의 대답은 최선의 충고라고 생각 후자의 경우

을 지원합니다. 내부 클래스 TButtonGylph은 가능한 한 png 가능 클래스로 상속과 같은 OOP 접근을 불가능하게합니다. 또는 Remy가 의견 : 제 3 자 구성 요소에서 제안하는대로 추가 작업을 수행하십시오.

절충 그러나 허용되는 경우 :

참고 이미 PNG 파일을 사용하여 도움이 될 수 FOriginal.Assign(Value);, TPNGImageAssignTo 절차는 TBitMap 자체를 할당하는 방법을 알고있다. 때문에 비트 맵과 PNG이 그러나 PNG의 알파 채널을 무시할 수의 차이에

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

을하지만, answer에 따라 다음 Glyph 부동산에 관한 알려진 이상으로 , 우리는 단순히 다음 코드와 PNG를 할당 할 수 있습니다 I는 문양으로서 TPicture을 받아들이 SpeedButton되는 유사한 구성 요소를 작성한

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; 
관련 문제