suiimagepanel.pas

来自「新颖按钮控件」· PAS 代码 · 共 321 行

PAS
321
字号
////////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIImagePanel.pas
//  Creater     :   Shen Min
//  Date        :   2001-10-15
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////////


unit SUIImagePanel;

interface

uses Windows, Extctrls, Graphics, Classes, Messages, Controls, SysUtils,
     SUIPublic, SUIThemes;

type
    TsuiDrawStyle = (suiNormal, suiStretch, suiTile);

    TsuiCustomPanel = class(TCustomPanel)
    private
        m_Picture : TPicture;
        m_Transparent : Boolean;
        m_AutoSize : Boolean;
        m_CaptionPosX: Integer;
        m_CaptionPosY: Integer;
        m_DrawStyle : TsuiDrawStyle;

        m_LastDrawCaptionRect : TRect;

        procedure ApplyAutoSize();
        procedure ApplyTransparent();
        procedure SetPicture(const Value: TPicture);
        procedure SetAutoSize(const Value: Boolean); reintroduce;
        procedure SetCaptionPosX(const Value: Integer);
        procedure SetCaptionPosY(const Value: Integer);
        procedure SetDrawStyle(const Value: TsuiDrawStyle);
        procedure CMTEXTCHANGED(var Msg : TMessage); message CM_TEXTCHANGED;
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

    protected
        procedure Paint(); override;
        procedure ClearPanel(); virtual;
        procedure RepaintText(Rect : TRect); virtual;
        procedure PictureChanged(Sender: TObject); virtual;
        procedure SetTransparent(const Value: Boolean); virtual;
        procedure Resize(); override;

        property Picture : TPicture read m_Picture write SetPicture;
        property Transparent : Boolean Read m_Transparent Write SetTransparent default false;
        property AutoSize : Boolean Read m_AutoSize Write SetAutoSize;
        property CaptionPosX : Integer read m_CaptionPosX write SetCaptionPosX;
        property CaptionPosY : Integer read m_CaptionPosY write SetCaptionPosY;
        property DrawStyle : TsuiDrawStyle read m_DrawStyle write SetDrawStyle;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy(); override;

        procedure UpdateUIStyle(UIStyle : TsuiUIStyle);

    end;

    TsuiImagePanel = class(TsuiCustomPanel)
    published
        property BiDiMode;
        property Anchors;
        property Picture;
        property Transparent;
        property AutoSize;
        property Alignment;
        property Align;
        property Font;
        property Caption;
        property Color;
        property DrawStyle;
        property Visible;
        
        property OnCanResize;
        property OnClick;
        property OnConstrainedResize;
        property OnDockDrop;
        property OnDockOver;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnGetSiteInfo;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        property OnStartDock;
        property OnStartDrag;
        property OnUnDock;
    end;

implementation


{ TsuiCustomPanel }

procedure TsuiCustomPanel.ApplyAutoSize;
begin
    if m_AutoSize then
    begin
        if (
            (Align <> alTop) and
            (Align <> alBottom) and
            (Align <> alClient)
        ) then
            Width := m_Picture.Width;

        if (
            (Align <> alLeft) and
            (Align <> alRight) and
            (Align <> alClient)
        ) then
            Height := m_Picture.Height;
    end;
end;

procedure TsuiCustomPanel.ApplyTransparent;
begin
    if m_Picture.Graphic.Transparent <> m_Transparent then
        m_Picture.Graphic.Transparent := m_Transparent;
end;

procedure TsuiCustomPanel.ClearPanel;
begin
    Canvas.Brush.Color := Color;

    if ParentWindow <> 0 then
        Canvas.FillRect(ClientRect);
end;

procedure TsuiCustomPanel.CMTEXTCHANGED(var Msg: TMessage);
begin
    RepaintText(m_LastDrawCaptionRect);
    Repaint();
end;

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

    m_Picture := TPicture.Create();
    ASSERT(m_Picture <> nil);

    m_Picture.OnChange := PictureChanged;
    m_CaptionPosX := -1;
    m_CaptionPosY := -1;

    Repaint();
end;

destructor TsuiCustomPanel.Destroy;
begin
    if m_Picture <> nil then
    begin
        m_Picture.Free();
        m_Picture := nil;
    end;

    inherited;
end;

procedure TsuiCustomPanel.Paint;
var
    uDrawTextFlag : Cardinal;
    Rect : TRect;
    Buf : TBitmap;
begin
    Buf := TBitmap.Create();
    Buf.Height := Height;
    Buf.Width := Width;

    if m_Transparent then
        DoTrans(Buf.Canvas, self);

    if Assigned(m_Picture.Graphic) then
    begin
        if m_DrawStyle = suiStretch then
            Buf.Canvas.StretchDraw(ClientRect, m_Picture.Graphic)
        else if m_DrawStyle = suiTile then
            TileDraw(Buf.Canvas, m_Picture, ClientRect)
        else
            Buf.Canvas.Draw(0, 0, m_Picture.Graphic);
    end
    else if not m_Transparent then
    begin
        Buf.Canvas.Brush.Color := Color;
        Buf.Canvas.FillRect(ClientRect);
    end;

    Buf.Canvas.Brush.Style := bsClear;

    if Trim(Caption) <> '' then
    begin
        Buf.Canvas.Font := Font;

        if (m_CaptionPosX <> -1) and (m_CaptionPosY <> -1) then
        begin
            Buf.Canvas.TextOut(m_CaptionPosX, m_CaptionPosY, Caption);
            m_LastDrawCaptionRect := Classes.Rect(
                m_CaptionPosX,
                m_CaptionPosY,
                m_CaptionPosX + Buf.Canvas.TextWidth(Caption),
                m_CaptionPosY + Buf.Canvas.TextWidth(Caption)
            );
        end
        else
        begin
            Rect := ClientRect;
            uDrawTextFlag := DT_CENTER;
            if Alignment = taRightJustify then
                uDrawTextFlag := DT_RIGHT
            else if Alignment = taLeftJustify then
                uDrawTextFlag := DT_LEFT;
            DrawText(Buf.Canvas.Handle, PChar(Caption), -1, Rect, uDrawTextFlag or DT_SINGLELINE or DT_VCENTER);
            m_LastDrawCaptionRect := Rect;
        end;
    end;

    BitBlt(Canvas.Handle, 0, 0, Width, Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);    
    Buf.Free();
end;

procedure TsuiCustomPanel.PictureChanged(Sender: TObject);
begin
    if m_Picture.Graphic <> nil then
    begin
        if m_AutoSize then
            ApplyAutoSize();
        ApplyTransparent();
    end;

    ClearPanel();
    RePaint();
end;

procedure TsuiCustomPanel.RepaintText(Rect: TRect);
begin
    // not implete
end;

procedure TsuiCustomPanel.Resize;
begin
    inherited;

    Repaint();
end;

procedure TsuiCustomPanel.SetAutoSize(const Value: Boolean);
begin
    m_AutoSize := Value;

    if m_Picture.Graphic <> nil then
        ApplyAutoSize();
end;

procedure TsuiCustomPanel.SetCaptionPosX(const Value: Integer);
begin
    m_CaptionPosX := Value;

    RePaint();
end;

procedure TsuiCustomPanel.SetCaptionPosY(const Value: Integer);
begin
    m_CaptionPosY := Value;

    RePaint();
end;

procedure TsuiCustomPanel.SetDrawStyle(const Value: TsuiDrawStyle);
begin
    m_DrawStyle := Value;

    ClearPanel();
    Repaint();
end;

procedure TsuiCustomPanel.SetPicture(const Value: TPicture);
begin
    m_Picture.Assign(Value);

    ClearPanel();
    Repaint();
end;

procedure TsuiCustomPanel.SetTransparent(const Value: Boolean);
begin
    m_Transparent := Value;

    if m_Picture.Graphic <> nil then
        ApplyTransparent();
    Repaint();
end;

procedure TsuiCustomPanel.UpdateUIStyle(UIStyle: TsuiUIStyle);
begin
    ContainerApplyUIStyle(self, UIStyle);
end;

procedure TsuiCustomPanel.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?