fcpanel.pas

一套及时通讯的原码

unit fcpanel;
{
//
// Components : TwwCustomTransparentPanel
//              Supporting component for transparent navigator
//
// Copyright (c) 1999-2001 by Woll2Woll Software
//
// Revision History:
// 10/23/2001-Handle refresh of text when caption changes.
// 11/1/2001 - PYW - Invalidate when setting captionindent or FullBorder.
// 12/19/01 - PYW - Don't call invalidate unless framing or transparent in cmenter, cmexit
//
}
{$i fcIfDef.pas}

interface

uses Windows, Messages, SysUtils, Classes, Controls, Forms,
  CommCtrl, StdCtrls, Buttons, ExtCtrls, Graphics, fcframe;

type
  TfcCustomPanel = class(TCustomPanel)
  private
    FFrame: TfcEditframe;
    FFocused: boolean;
    procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMMove(var Message: TWMMove); Message WM_Move;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    // Property Storage Variables
    FTransparent: Boolean;

    procedure ClipChildren(Value: Boolean);
    procedure CreateWnd; override;

    // Property Access Methods
    procedure SetTransparent(Value: Boolean); virtual;

    // Overridden methods
    procedure Paint; override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetParent(AParent:TWinControl); override;
    function IsTransparent: boolean; virtual;
    function InvalidateNeeded:boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;

    property Frame: TfcEditFrame read FFrame write FFrame;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
  end;

  TfcCustomGroupBox = class(TCustomGroupBox)
  private
    FBorderAroundLabel: boolean;
    FFrame: TfcEditframe;
    FFocused: boolean;
    FCaptionIndent: integer;
    FFullBorder: boolean;
    procedure SetCaptionIndent(Value:Integer);
    procedure SetFullBorder(Value:Boolean);
    procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMMove(var Message: TWMMove); Message WM_Move;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    // Property Storage Variables
    FTransparent: Boolean;

    procedure ClipChildren(Value: Boolean);
    procedure CreateWnd; override;
    procedure Paint; override;
    // Property Access Methods
    procedure SetTransparent(Value: Boolean); virtual;

    // Overridden methods
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetParent(AParent:TWinControl); override;
    function IsTransparent: boolean; virtual;
    function InvalidateNeeded:boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;

    property CaptionIndent: integer read FCaptionIndent write SetCaptionIndent default 8;
    property BorderAroundLabel: boolean read FBorderAroundLabel write FBorderAroundLabel default False;
    property FullBorder: boolean read FFullBorder write SetFullBorder default False;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property Frame: TfcEditFrame read FFrame write FFrame;
  end;

  TfcPanel = class(TfcCustomPanel)
  public
    property DockManager;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Frame;
    property Locked;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    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;

  TfcGroupBox = class(TfcCustomGroupBox)
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderAroundLabel;
    property Caption;
    property CaptionIndent;
    property Color;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Frame;
    property FullBorder;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDockDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

implementation

uses fccommon;

constructor TfcCustomPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFrame:= TfcEditFrame.create(self);
  FTransparent := False;
end;

destructor TfcCustomPanel.Destroy;
begin
  FFrame.Free;
  inherited Destroy;
end;

procedure TfcCustomPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if IsTransparent then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TfcCustomPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited;
  if IsTransparent then Invalidate;
end;

procedure TfcCustomPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  if IsTransparent then Message.result:=1
  else inherited;
end;

procedure TfcCustomPanel.WMMove(var Message: TWMMove);
begin
  inherited;
  if IsTransparent then Invalidate;
end;

procedure TfcCustomPanel.ClipChildren(Value: Boolean);
//var tc: TWinControl;
begin
  if (Parent <> nil) then
  begin
      SetWindowLong(Parent.Handle, GWL_STYLE,
        GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
      if HandleAllocated then
        SetWindowLong(Handle, GWL_STYLE,
          GetWindowLong(Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
//    tc:= self;
//
    // Only disable parent clipping, don't enable it
//    while (tc.parent<>nil) do begin
//        SetWindowLong(tc.Parent.Handle, GWL_STYLE,
//          GetWindowLong(tc.Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
//      if tc.parent is TCustomForm then break;
//      tc:= tc.parent;
//      break;
//    end;
  end
end;

procedure TfcCustomPanel.SetParent(AParent:TWinControl);
begin
  inherited SetParent(AParent);

  // Without this, the panel would be transparent indeed, but you would see through the form into the background apps
//  ClipChildren(not FTransparent);
end;

procedure TfcCustomPanel.Invalidate;
var TempRect:TRect;
    r: TRect;
begin
//  inherited;
//  exit;
  if IsTransparent and (Parent <> nil) and Parent.HandleAllocated then
  begin
    GetUpdateRect(Handle, r, False);
    tempRect:= BoundsRect;
    tempRect:= Rect(TempRect.Left + r.Left, TempRect.Top + r.Top,
                    TempRect.Left + r.Right, TempRect.Top + R.Bottom);
    InvalidateRect(Parent.Handle, @TempRect, False);
   // 10/23/01 - The following code causes a transpareant panel to not be transparent in some cases
   // when the form first comes up.  In fact only 1 panel seems to exhibit this problem
   // when having multiple panels or groupboxes.

{    if not fcIsTransparentParent(self) then
       Parent.Update; // Seems necessary for transparent panel in transparent panel when
}
    if (r.left=r.right) and (r.top=r.bottom) then
      InvalidateRect(Handle, nil, False)
    else InvalidateRect(Handle, @r, False);
  end
  else inherited Invalidate;
end;

procedure TfcCustomPanel.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;

    if IsTransparent then ControlStyle := ControlStyle - [csOpaque]
    else begin
       ControlStyle := ControlStyle + [csOpaque];
    end;

    if not (csLoading in ComponentState) and HandleAllocated and
       not (csDesigning in ComponentState) then
    begin
      Invalidate;
      ClipChildren(not Value);
      RecreateWnd;
    end
  end;
end;

Function TfcCustomPanel.IsTransparent: boolean;
begin
   result:= FTransparent and not (csDesigning in ComponentState);
end;

//10/23/2001-Handle refresh of text when caption changes.
procedure TfcCustomPanel.CMTextChanged(var Message: TMessage);
begin
  if (not (csDesigning in ComponentState)) or FTransparent then
     Frame.RefreshTransparentText(True);
  inherited;
end;


procedure TfcCustomPanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
  FontHeight: Integer;
  Flags: Longint;
  TempRect: TRect;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  Rect := GetClientRect;

  if Frame.IsFrameEffective then
  begin
     if (Frame.NonFocusColor<>clNone) and (not FFocused) then
        Canvas.Brush.Color := Frame.NonFocusColor
     else Canvas.Brush.Color := Color;
     if not Transparent then Canvas.FillRect(Rect);
     fcDrawEdge(self, Frame, Canvas, FFocused);
  end
  else begin
     if BevelOuter <> bvNone then
     begin
       AdjustColors(BevelOuter);
       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
     end;
     Frame3D(Canvas, Rect, Color, Color, BorderWidth);
     if BevelInner <> bvNone then
     begin
       AdjustColors(BevelInner);
       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
     end;
  end;

  with Canvas do
  begin
    if not Transparent then
    begin
       TempRect:= Rect;
       if not Frame.IsFrameEffective then
       begin
          Brush.Color := Color;
          FillRect(TempRect);
       end;
    end;
    Brush.Style := bsClear;
    Font := Self.Font;
    FontHeight := TextHeight('W');
    with Rect do
    begin
      Top := ((Bottom + Top) - FontHeight) div 2;
      Bottom := Top + FontHeight;
    end;
    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    if Frame.IsFrameEffective then
    begin
       if (Frame.NonFocusFontColor<>clNone) and (not FFocused) then
          Font.Color := Frame.NonFocusFontColor
    end;
    DrawText(Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;

constructor TfcCustomGroupBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCaptionIndent := 8;
  FTransparent := False;
  BorderAroundLabel:= false;
  FFullBorder := False;
  FFrame:= TfcEditFrame.create(self);