现在的位置: 首页 > 综合 > 正文

一个带背景图片的ImagePanel

2013年09月11日 ⁄ 综合 ⁄ 共 3341字 ⁄ 字号 评论关闭

unit ImagePanel;

interface

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

type
  TImagePanel = class(TCustomPanel)
  private
    { Private declarations }
    FPicture:TPicture;
    FTransparent:Boolean;
    FAutoSize:Boolean;
    FFont:TFont;
    FCaption:TCaption;
    FAlignment:TAlignment;

    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;   //覆盖TCustomPanel的自绘方法

  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy();override;
  published
   { Published declarations }
    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:TFont read FFont write setFont;
    property Caption:TCaption read FCaption write setCaption;
    property Alignment:TAlignment read FAlignment write setAlignment;

  end;

procedure Register;

implementation

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

{ TImagePanel }

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

  FPicture:=TPicture.Create();
  FFont:=TFont.Create;
  if FFont=nil then
  begin
    FFont.Assign(TFont(clWindowText));
  end;
  //FPFPicture更改时调用pictureChanged重绘组建窗体
  FPicture.OnChange:=pictureChanged;
  Repaint;
end;

destructor TImagePanel.Destroy;
begin
   FFont.Free;
   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)对象进行绘画
    Canvas.StretchDraw(ClientRect,FPicture.Graphic);
  end
  else  //如果图片属性为空,则以color属性的颜色填充组件窗口
  begin
    Canvas.Brush.Color:=Color;
    Canvas.FillRect(ClientRect);
  end;
  //如果组件被指定了caption属性,则在组件上写标题
  if Caption<>'' then
  begin
    Rect:=GetClientRect;
    FontHeight:=Canvas.TextHeight('W');
    //caption 纵向居中
    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; 
  //inherited;

end;

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

procedure TImagePanel.setAlignment(const value: TAlignment);
begin
  FAlignment:=value;
  Repaint;
end;

procedure TImagePanel.setAutoSize(const value: Boolean);
begin
  FAutoSize:=value;
  Repaint;
end;

procedure TImagePanel.setCaption(const value: TCaption);
begin
  FCaption:=value;
  Repaint;
end;

procedure TImagePanel.setFont(const value: TFont);
begin

    FFont.Assign(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.

抱歉!评论已关闭.