flatpanel.pas

相信大家已经找很长时间了

unit FlatPanel;

interface

{$I FlatStyle.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, FlatUtilitys, StdCtrls;

type
  TBELabel = class(TCustomLabel)
  private
    function GetTop: Integer;
    function GetLeft: Integer;
    function GetWidth: Integer;
    function GetHeight: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  protected
    procedure AdjustBounds; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BiDiMode;
    property Caption;
    property Color;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property Height: Integer read GetHeight write SetHeight;
    property Left: Integer read GetLeft;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property Top: Integer read GetTop;
    property Transparent;
    property Layout;
    property WordWrap;
    property Width: Integer read GetWidth write SetWidth;
  end;

  TFlatPanel = class(TCustomPanel)
  private
    FTransparent: Boolean;
    FColorHighlight: TColor;
    FColorShadow: TColor;
    procedure SetColors (Index: Integer; Value: TColor);
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged (var Message: TWmNoParams); message CM_TEXTCHANGED;
    procedure SetTransparent (const Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property Caption;
    property Font;
    property Color;
    property ParentColor;
    property Enabled;
    property Visible;
    property ColorHighLight: TColor index 0 read FColorHighlight write SetColors default $004080FF;
    property ColorShadow: TColor index 1 read FColorShadow write SetColors default $004080FF;
    property Align;
    property Alignment;
    property Cursor;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property TabOrder;
    property TabStop;
   {$IFDEF DFS_DELPHI_4_UP}
    property AutoSize;
    property UseDockManager;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property DragMode;
    property DragCursor;
    property ParentBiDiMode;
    property DockSite;
    property OnEndDock;
    property OnStartDock;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnGetSiteInfo;
    property OnUnDock;
   {$ENDIF}
   {$IFDEF DFS_DELPHI_5_UP}
    property OnContextPopup;
   {$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;

  TFlatLBPanel = class(TFlatPanel)
  private
    FLabelSpacing: Integer;
    FEditLabel: TBELabel;
    FLabelPosition: TLabelPosition;
  protected
    procedure SeTBEPosition(const Value: TLabelPosition);
    procedure SetLabelSpacing(const Value: Integer);
    procedure SetName(const Value: TComponentName); override;
    procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetupInternalLabel;
  public
    constructor Create (AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);override;
  published
    property EditLabel: TBELabel read FEditLabel;
    property LabelPosition: TLabelPosition read FLabelPosition write SeTBEPosition default lpLeft;
    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;
    property Transparent;
    property Caption;
    property Font;
    property Color;
    property ParentColor;
    property Enabled;
    property Visible;
    property ColorHighLight;
    property ColorShadow;
    property Align;
    property Alignment;
    property Cursor;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property TabOrder;
    property TabStop;
   {$IFDEF DFS_DELPHI_4_UP}
    property AutoSize;
    property UseDockManager;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property DragMode;
    property DragCursor;
    property ParentBiDiMode;
    property DockSite;
    property OnEndDock;
    property OnStartDock;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnGetSiteInfo;
    property OnUnDock;
   {$ENDIF}
   {$IFDEF DFS_DELPHI_5_UP}
    property OnContextPopup;
   {$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;

implementation

constructor TFlatPanel.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParentFont := True;
  FColorHighLight := $004080FF;
  FColorShadow := $004080FF;
  ParentColor := True;
  ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
  SetBounds(0, 0, 185, 41);
end;

procedure TFlatPanel.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FColorHighLight := Value;
    1: FColorShadow := Value;
  end;
  Invalidate;
end;

procedure TFlatPanel.Paint;
var
  memoryBitmap: TBitmap;
  textBounds: TRect;
  Format: UINT;
begin
  TextBounds := ClientRect;
  TextBounds.Left  := TextBounds.Left + 3;
  TextBounds.Right := TextBounds.Right - 3;
  Format := DT_SINGLELINE or DT_VCENTER;
  case Alignment of
    taLeftJustify: Format := Format or DT_LEFT;
    taCenter:      Format := Format or DT_CENTER;
    taRightJustify:Format := Format or DT_RIGHT;
  end;

  memoryBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
  try
    memoryBitmap.Height := ClientRect.Bottom;
    memoryBitmap.Width  := ClientRect.Right;

    // Draw Background
    if FTransparent then
      DrawParentImage(Self, memoryBitmap.Canvas)
    else
    begin
      memoryBitmap.Canvas.Brush.Color := Self.Color;
      memoryBitmap.Canvas.FillRect(ClientRect);
    end;

    // Draw Border
    Frame3DBorder(memoryBitmap.Canvas, ClientRect, FColorHighlight, FColorShadow, 1);

    // Draw Text
    memoryBitmap.Canvas.Font := Self.Font;
    memoryBitmap.Canvas.Brush.Style := bsClear;
    if not Enabled then begin
      OffsetRect(textBounds, 1, 1);
      memoryBitmap.Canvas.Font.Color := clBtnHighlight;
      DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
      OffsetRect(textBounds, -1, -1);
      memoryBitmap.Canvas.Font.Color := clBtnShadow;
      DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
    end else
      DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);

    // Copy memoryBitmap to screen
    canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
  finally
    memoryBitmap.free; // delete the bitmap
  end;
end;

procedure TFlatPanel.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFlatPanel.CMTextChanged(var Message: TWmNoParams);
begin
  inherited;
  Invalidate;
end;

procedure TFlatPanel.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

{ TBELabel }

constructor TBELabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name := 'SUB';  { do not localize }
  SetSubComponent(True);
  if Assigned(AOwner) then
     Caption := AOwner.Name;
end;

procedure TBELabel.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TFlatLBPanel then
    with Owner as TFlatLBPanel do
      SetBEPosition(LabelPosition);
end;

function TBELabel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TBELabel.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TBELabel.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TBELabel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TBELabel.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TBELabel.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;
{ TFlatLBPanel }
procedure TFlatLBPanel.CMEnabledChanged (var Message: TMessage);
begin
  inherited;
  fEditLabel.Enabled := Enabled;
end;

procedure TFlatLBPanel.SeTBEPosition(const Value: TLabelPosition);
var
  P: TPoint;
begin
  if FEditLabel = nil then exit;
  FLabelPosition := Value;
  case Value of
    lpAbove: P := Point(Left, Top - FEditLabel.Height - FLabelSpacing);
    lpBelow: P := Point(Left, Top + Height + FLabelSpacing);
    lpLeft : P := Point(Left - FEditLabel.Width - FLabelSpacing,
                    Top + ((Height - FEditLabel.Height) div 2));
    lpRight: P := Point(Left + Width + FLabelSpacing,
                    Top + ((Height - FEditLabel.Height) div 2));
  end;
  FEditLabel.SetBounds(P.x, P.y, FEditLabel.Width, FEditLabel.Height);
end;

procedure TFlatLBPanel.SetLabelSpacing(const Value: Integer);
begin
  FLabelSpacing := Value;
  SeTBEPosition(FLabelPosition);
end;

procedure TFlatLBPanel.SetupInternalLabel;
begin
  if Assigned(FEditLabel) then exit;
  FEditLabel := TBELabel.Create(Self);
  FEditLabel.FreeNotification(Self);
  FEditLabel.Transparent  := True;
  FEditLabel.FocusControl := Self;
end;

procedure TFlatLBPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SeTBEPosition(FLabelPosition);
end;

procedure TFlatLBPanel.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FEditLabel = nil then exit;
  FEditLabel.Parent := AParent;
  FEditLabel.Visible := True;
end;

procedure TFlatLBPanel.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.BiDiMode := BiDiMode;
end;

procedure TFlatLBPanel.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.Visible := Visible;
end;

procedure TFlatLBPanel.SetName(const Value: TComponentName);
begin
  if (csDesigning in ComponentState) and ((FEditlabel.GetTextLen = 0) or
     (CompareText(FEditLabel.Caption, Name) = 0)) then
    FEditLabel.Caption := Value;
  inherited SetName(Value);
  if csDesigning in ComponentState then
     Caption := '';
end;

procedure TFlatLBPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FEditLabel) and (Operation = opRemove) then
     FEditLabel := nil;
end;

constructor TFlatLBPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLabelPosition   := lpLeft;
  FLabelSpacing    := 3;
  SetupInternalLabel;
end;

end.