我从网上找了一个,它是从TPaintBox继承的
unit ZLabelImage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TXAlign = (alXNone, alXLeft, alXRight, alXCenter);
TYAlign = (alYNone, alYTop, alYBottom, alYCenter);
type
TZLabelImage = class(TPaintBox)
private
FCaption: String;
FPicture: TBitmap;
FXPicture: Integer;
FYPicture: Integer;
FXCaption: Integer;
FYCaption: Integer;
FCaptionXAlignment: TXAlign;
FCaptionYAlignment: TYAlign;
FPictureXAlignment: TXAlign;
FPictureYAlignment: TYAlign;
procedure SetPicture(Value: TBitmap);
procedure SetXPicture(Value: Integer);
procedure SetYPicture(Value: Integer);
procedure SetCaption(Value: String);
procedure SetXCaption(Value: Integer);
procedure SetYCaption(Value: Integer);
procedure SetCaptionXAlignment(Value: TXAlign);
procedure SetCaptionYAlignment(Value: TYAlign);
procedure SetPictureXAlignment(Value: TXAlign);
procedure SetPictureYAlignment(Value: TYAlign);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption: String read FCaption write SetCaption;
property XCaption: Integer read FXCaption write SetXCaption;
property YCaption: Integer read FYCaption write SetYCaption;
property CaptionXAlignment: TXAlign read FCaptionXAlignment write SetCaptionXAlignment;
property CaptionYAlignment: TYAlign read FCaptionYAlignment write SetCaptionYAlignment;
property Picture: TBitmap read FPicture write SetPicture;
property XPicture: Integer read FXPicture write SetXPicture;
property YPicture: Integer read FYPicture write SetYPicture;
property PictureXAlignment: TXAlign read FPictureXAlignment write SetPictureXAlignment;
property PictureYAlignment: TYAlign read FPictureYAlignment write SetPictureYAlignment;
property OnPaint;
end;
procedure Register;
implementation
{$R ZLABELIMAGE.DCR}
procedure Register;
begin
RegisterComponents('AZ', [TZLabelImage]);
end;
constructor TZLabelImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture := TBitmap.Create;
FCaption := Self.Name;
SetXPicture(2);
SetXPicture(2);
SetXCaption(0);
SetYCaption(0);
end;
procedure TZLabelImage.Paint;
var XP, XC, YP, YC: Integer;
begin
inherited;
XP := 0;
YP := 0;
XC := 0;
YC := 0;
With Self.Canvas do
begin
Brush.Color := Self.Color;
Font := Self.Font;
FillRect(Self.ClientRect);
Case FPictureXAlignment of
alXNone: XP := FXPicture;
alXLeft: XP := 0;
alXRight: XP := Self.Width - FPicture.Width;
alXCenter: XP := (Self.Width div 2) - (FPicture.Width) div 2;
end;
Case FPictureYAlignment of
alYNone: YP := FYPicture;
alYTop: YP := 0;
alYBottom: YP := Self.Height - FPicture.height;
alYCenter: YP := (Self.Height div 2) - (FPicture.Height div 2);
end;
Draw(XP, YP, FPicture);
Case FCaptionXAlignment of
alXNone: XC := FXCaption;
alXLeft: XC := 0;
alXRight: XC := Self.Width - TextWidth(FCaption);
alXCenter: XC := (Self.Width div 2) - (TextWidth(FCaption) div 2);
end;
Case FCaptionYAlignment of
alYNone: YC := FYCaption;
alYTop: YC := 0;
alYBottom: YC := Self.Height - TextHeight(FCaption);
alYCenter: YC := (Self.Height div 2) - (TextHeight(FCaption) div 2);
end;
Brush.Style := bsClear;
TextOut(XC, YC, FCaption);
end;
end;
procedure TZLabelImage.SetPicture(Value: TBitmap);
begin
FPicture.Assign(Value);
Self.Repaint;
end;
procedure TZLabelImage.SetXPicture(Value: Integer);
begin
FXPicture := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetYPicture(Value: Integer);
begin
FYPicture := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetCaption(Value: String);
begin
FCaption := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetXCaption(Value: Integer);
begin
FXCaption := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetYCaption(Value: Integer);
begin
FYCaption := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetCaptionXAlignment(Value: TXAlign);
begin
FCaptionXAlignment := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetCaptionYAlignment(Value: TYAlign);
begin
FCaptionYAlignment := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetPictureXAlignment(Value: TXAlign);
begin
FPictureXAlignment := Value;
Self.Repaint;
end;
procedure TZLabelImage.SetPictureYAlignment(Value: TYAlign);
begin
FPictureYAlignment := Value;
Self.Repaint;
end;