一個帶背景圖片的ImagePanel

來源:互聯網
上載者:User

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.

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.