盒子论坛 v2.1

unit ImagePanel;

interface

uses
  Windows, ExtCtrls, Graphics, Classes, Controls; // SysUtils

type
  TImagePanel = class(TCustomPanel)
  private
    { Private declarations }
    FPicture : TPicture;
    FTransparent : Boolean;
    FAutoSize : Boolean;

    procedure PictureChanged(Sender: TObject);
    procedure SetPicture(const Value: TPicture);
    procedure SetAutoSize(const Value: Boolean); reintroduce;
    procedure SetTransparent(const Value: Boolean);
    procedure SetFont(const Value: TFont);
    procedure SetCaption(const Value: TCaption);
    procedure SetAlignment(const Value: TAlignment);
  protected
    { Protected declarations }
    procedure Paint(); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  published
    property Picture: TPicture read FPicture write SetPicture;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property AutoSize: Boolean read FAutoSize write SetAutoSize;

    property Font write SetFont;
    property Caption write SetCaption;
    property Alignment write SetAlignment;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Sunisoft', [TImagePanel]);
end;

{ TImagePanel }

constructor TImagePanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPicture:=TPicture.Create();
  FPicture.OnChange := PictureChanged;

  Repaint();
end;

destructor TImagePanel.Destroy;
begin
  FPicture.Free();
  FPicture:=nil;

  inherited;
end;

procedure TImagePanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Flags: longint;
  Rect: TRect;
  FontHeight: Integer;
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Font := Font;

  if Assigned(FPicture.Graphic) then
  begin
    if FAutoSize then
    begin
      Width := FPicture.Width;
      Height := FPicture.Height;
    end;

    if FPicture.Graphic.Transparent<> FTransparent then
      FPicture.graphic.Transparent := FTransparent;

    Canvas.stretchDraw(ClientRect, FPicture.Graphic);
  end
  else
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ClientRect);
  end;

  if Caption<>'' then
  begin
    Rect := GetClientRect;
    FontHeight := Canvas.TextHeight('W');

    Rect.Top := ((Rect.Bottom + Rect.Top) - FontHeight) div 2;
    Rect.Bottom := Rect.Top + FontHeight;
    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Canvas.Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;

procedure TImagePanel.PictureChanged(Sender: TObject);
begin
  Repaint();
end;

procedure TImagePanel.SetAlignment(const Value: TAlignment);
begin
  inherited Alignment := Value;
  Repaint();
end;

procedure TImagePanel.SetAutoSize(const Value: Boolean);
begin
  FAutoSize := Value;
  Repaint();
end;

procedure TImagePanel.SetCaption(const Value: TCaption);
begin
  inherited Caption := Value;
  Repaint();
end;

procedure TImagePanel.SetFont(const Value: TFont);
begin
  inherited Font := Value;
  Repaint();
end;

procedure TImagePanel.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
  Repaint();
end;

procedure TImagePanel.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Repaint();
end;

end.
----------------------------------------------
只有偏执狂才能生存！

信息

登陆以后才能回复