delphi – 创建一个接受.PNG图像为Glyph的按钮
发布时间:2020-12-15 09:35:24 所属栏目:大数据 来源:网络整理
导读:我试图了解SpeedButton Glyph属性如何工作,我发现该字段声明为: FGlyph:TObject; 虽然财产如下: 属性字形:TBitmap读取GetGlyph写入SetGlyph存储的HasCustomGlyph; 这让我陷入了一种无法理解代码的方式,即使我一行一行地阅读它,当我试图创建我自己的Speed
我试图了解SpeedButton Glyph属性如何工作,我发现该字段声明为:
FGlyph:TObject; 虽然财产如下: 属性字形:TBitmap读取GetGlyph写入SetGlyph存储的HasCustomGlyph; 这让我陷入了一种无法理解代码的方式,即使我一行一行地阅读它,当我试图创建我自己的SpeedButton时,它也接受.PNG图像而不是.bmp图像. 我第一次想将该属性声明为TPicture而不是TBitmap. 有没有办法用Glyph创建MySpeedButton:TPicture? 我尝试的是以下内容: 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; 解决方法
我创建了一个类似的组件,它是一个SpeedButton,它接受一个TPicture作为它的Glyph.
这是单位.我希望你从中受益匪浅. 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,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,Area); OBitmap.Canvas.Brush.Color := aColor; OBitmap.Canvas.Pen.Style := psClear; OBitmap.Canvas.Rectangle(Area); aCanvas.Draw(0,EBitmap); aCanvas.Draw(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,Parent.ClientWidth,Parent.ClientHeight); Parent.Perform(WM_ERASEBKGND,DC,0); Parent.Perform(WM_PAINT,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,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,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. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |