graphlabel.pas

Delphi7编程80例(完全版)

unit GraphLabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls,
  Graphics;

type
  TGraphLabel = class(TLabel)
  private
    { Private declarations }
    FImage:TBitmap;
    procedure SetImage(Value:Tbitmap);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Image:TBitmap read FImage write SetImage;
  end;

procedure Register;

implementation

procedure TGraphLabel.SetImage(Value: Tbitmap);
var
  NewBitmap:Tbitmap;
begin
  NewBitmap:=nil;
  if Value <> nil then
  begin
    NewBitmap:=Tbitmap.Create;
    NewBitmap.Assign(Value);
  end;
  try
    FImage.Free;
    FImage:=NewBitmap;
    Refresh;
  except
    NewBitmap.Free;
    raise;
  end;
end;

procedure TGraphLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  Rect, CalcRect: TRect;
  DrawStyle: Longint;
begin
  with Canvas do
  begin
    if not Transparent then
    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      Brush.Bitmap:=FImage;
      FillRect(ClientRect);
    end;
    Brush.Style := bsClear;
    Rect := ClientRect;
    { DoDrawText takes care of BiDi alignments }
    DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
    { Calculate vertical layout }
    if Layout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
      if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
      else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
    end;
    DoDrawText(Rect, DrawStyle);
  end;
end;

constructor TGraphLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImage:=TBitmap.Create;
end;

destructor TGraphLabel.Destroy;
begin
  FImage.Free;
  inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TGraphLabel]);
end;

end.