imagepanel.pas

Delphi高手突破源码

////////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   ImagePanel.pas
//  Creater     :   Shen Min
//  Date        :   2001-10-15
//  Comment     :
//
//
////////////////////////////////////////////////////////////////////////////////////


unit ImagePanel;

interface

uses windows, extctrls, graphics, classes, controls;

type
    TImagePanel = class(TCustomPanel)
    private
        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
        procedure Paint(); override;

    public
        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;
    end;

procedure Register;

implementation

{ 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;

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

end.