spanel.pas

AlphaControls是一个Delphi标准控件的集合

unit sPanel;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sStyleUtil, sConst, sGraphUtils, sUtils, sCheckedControl,
  imglist, comctrls;

type

  TsPanel = class;
{$IFNDEF ALITE}
  TsToolBar = class;
{$ENDIF}  
  TPaintEvent = procedure (Sender: TObject; Canvas: TCanvas) of object;

  TsTransparentPanel = class(TCustomPanel) // Abstract class, sStyle dont created
  private
  protected
    FOnPaint : TPaintEvent;
    procedure WMEraseBkGND(var Message: TWMPaint); message WM_ERASEBKGND;
    procedure PaintRoundedBorder(DC : longint; aRect : TRect; Radius: integer; InvertColors : boolean; sStyle : TsPassiveBGStyle);
    procedure WriteText(R : TRect; sStyle: TsPaintStyle); dynamic;
    function Margin: integer; dynamic;
  public
    constructor Create (AOwner: TComponent); override;
    property BorderStyle;
    property Align;
    property Caption;
    property Alignment;
  published
    property Anchors;
    property BevelWidth default 2;
    property BorderWidth;
    property Constraints;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DockManager;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    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 OnPaint : TPaintEvent read FOnPaint write FOnPaint;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TsCustomPanel = class(TsTransparentPanel)
  private
  protected
    FBevelOuter: TsControlBevel;
    FBevelInner: TsControlBevel;
    FsStyle : TsPassiveBGStyle;
    procedure DrawPanelBorders(Canvas: TCanvas);
    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
    procedure SetBevelOuter(const Value: TsControlBevel);
    procedure SetBevelInner(const Value: TsControlBevel);
  public
    function Margin: integer; override;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure PaintSkinBorder(index : integer);
    procedure Invalidate; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
  published
    property BorderStyle;
    property Ctl3D;
    property sStyle : TsPassiveBGStyle read FsStyle write FsStyle;
    property BevelInner : TsControlBevel read FBevelInner write SetBevelInner default cbNone;
    property BevelOuter : TsControlBevel read FBevelOuter write SetBevelOuter default cbRaisedSoft;
  end;

  TsPanel = class(TsCustomPanel)
  private
  protected
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Alignment;
    property Align;
    property Caption;
  end;

{$IFNDEF ALITE}
  TsContainer = class(TsCustomPanel)
  private
  protected
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Alignment;
    property Align;
    property BevelOuter default cbNone;
    property BorderStyle default bsSingle;
    property Caption;
  end;

  TsToolButtons = class(TPersistent)
  private
    FGrayed : boolean;
    FOwner : TsToolBar;
    FButtonWidth: integer;
    FButtonHeight: integer;
    FImagesDisabled: TCustomImageList;
    FImagesGrayed: TCustomImageList;
    FImages: TCustomImageList;
    FShowCaptions: boolean;
    procedure SetImages(const Index: Integer; const Value: TCustomImageList);
    procedure SetShowCaptions(const Value: boolean);
    procedure SetGrayed(const Value: boolean);
  protected
  public
    constructor Create(AOwner: TsToolBar);
  published
    property Grayed : boolean read FGrayed write SetGrayed default False;
    property ButtonWidth : integer read FButtonWidth write FButtonWidth default 32;
    property ButtonHeight : integer read FButtonHeight write FButtonHeight default 32;
    property Images : TCustomImageList index 0 read FImages write SetImages;
    property ImagesGrayed : TCustomImageList index 1 read FImagesGrayed write SetImages;
    property ImagesDisabled : TCustomImageList index 2 read FImagesDisabled write SetImages;
    property ShowCaptions : boolean read FShowCaptions write SetShowCaptions;
  end;

  TsToolBar = class(TsCustomPanel)
  private
    FButtons: TsToolButtons;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    DontAutoSize : boolean;
    procedure AdjustSize; override;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Alignment;
    property Align;
    property Buttons : TsToolButtons read FButtons write FButtons;
    property Caption;
    property BorderWidth default 2;
  end;

  TsDragBar = class(TsCustomPanel)
  private
    FDraggedControl : TControl;
    procedure WMActivateApp(var Message: TWMActivateApp); message WM_ACTIVATEAPP;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    procedure ReadState(Reader: TReader); override;
    constructor Create (AOwner: TComponent); override;
  published
    property Alignment;
    property Align default alTop;
    property DraggedControl : TControl read FDraggedControl write FDraggedControl;
    property Caption;
  end;

  TsGlassPanel = class(TsCustomPanel)
  private
    FMask : TPicture;
    procedure SetMask(const Value: TPicture);
    procedure DrawGlassBorders;
  protected
  public
    constructor Create (AOwner: TComponent); override;
    procedure Paint; override;
  published
    property Alignment;
    property Align;
    property Mask: TPicture read FMask write SetMask;
    property Caption;
  end;
{$ENDIF}

  TsGrip = class(TsCustomPanel)
  public
    LinkedControl : TWinControl;
    constructor Create (AOwner: TComponent); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

implementation

uses sVclUtils, sCustomButton, sDefaults, sBorders, sMessages, sStyleSimply,
  sMaskData, sAlphaGraph;

{ TsTransparentPanel }

constructor TsTransparentPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  BevelWidth := 2;
//  DoubleBuffered := True;
end;

function TsTransparentPanel.Margin: integer;
begin
  Result := BorderWidth;
end;

procedure TsTransparentPanel.PaintRoundedBorder(DC : longint; aRect : TRect; Radius: integer; InvertColors: boolean; sStyle: TsPassiveBGStyle);
var
  GetColor : array [0..1] of TColor;
  R: TRect;
//  i : integer;
//  Color1, Color2 : TColor;
begin
  GetColor[1] := ColorToRGB(clWhite);
  GetColor[0] := ColorToRGB(clBlack);
  R := aRect;

//  Color1 := GetColor[integer(not InvertColors)];
//  Color2 := GetColor[integer(InvertColors)];
{
  if InvertColors then begin
    BeveledRoundRect(DC, Color2,
                    Color1,
                    ColorToRGB(sStyle.Painting.Color), R,
                    BevelWidth, Radius,
                    sConst.bsLowered);
  end
  else begin
    BeveledRoundRect(DC, Color1,
                    Color2,
                    ColorToRGB(sStyle.Painting.Color), R,
                    BevelWidth, Radius,
                    sConst.bsRaised);
  end;
}  
end;

procedure TsTransparentPanel.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsTransparentPanel.WriteText(R: TRect; sStyle: TsPaintStyle);
begin
  sStyle.FCacheBmp.Canvas.Brush.Style := bsClear;
  sStyle.FCacheBmp.Canvas.Font := Font;

  R.Top := ((R.Bottom + R.Top) - sStyle.FCacheBmp.Canvas.TextHeight('W')) div 2;
  R.Bottom := R.Top + sStyle.FCacheBmp.Canvas.TextHeight('W');

  sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(Caption), Enabled,
                            R, GetStringFlags(Self, alignment));
end;

{ TsCustomPanel }

constructor TsCustomPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FsStyle := TsPassiveBGStyle.Create(Self);
  FsStyle.COC := COC_TsCustomPanel;
  FBevelInner := cbNone;
  FBevelOuter := cbRaisedSoft;
end;

destructor TsCustomPanel.Destroy;
begin
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  inherited Destroy;
end;

procedure TsCustomPanel.Paint;
var
  aRect : TRect;
  b : boolean;
begin
  if ControlIsReady(Self) and (sStyle.FCacheBmp <> nil) then begin
    if sStyle.BGChanged {or (Width <> sStyle.FCacheBmp.Width) or (Height <> sStyle.FCacheBmp.Height) }then begin
      aRect := ClientRect;
      sStyle.InitCacheBmp;

      inc(aRect.Left, Margin);
      dec(aRect.Right, Margin);

      if Assigned(FOnPaint) then FOnPaint(Self, sStyle.FCacheBmp.Canvas);
      if IsValidSkinIndex(sStyle.SkinIndex) then begin
        if sStyle.RegionChanged then begin
          sStyle.FRegion := 0;
          sStyle.FRegion := CreateRectRgn(0, 0, Width, Height);
        end;
        PaintItemBG(sStyle.SkinIndex, sStyle.SkinSection, sStyle.GetParentCache, 0, Rect(0, 0, width, Height), Point(Left, Top), sStyle.FCacheBMP);
        RepaintShadows(Self, sStyle.FCacheBmp);
        if IsValidImgIndex(sStyle.BorderIndex) then begin
          PaintRasterBorder(sStyle.FCacheBmp, ma[sStyle.BorderIndex].Bmp, 0, sStyle.FRegion, ma[sStyle.BorderIndex].TransparentColor, False);
        end;
        if sStyle.RegionChanged then begin
          SetWindowRgn(Handle, sStyle.FRegion, True);
          sStyle.RegionChanged := False;
        end;
      end
      else begin
        sStyle.PaintBG(sStyle.FCacheBMP);

        if sStyle.RegionChanged then begin
          sStyle.CreateRgn;
        end;
        DrawPanelBorders(sStyle.FCacheBmp.Canvas);
      end;
      WriteText(aRect, sStyle);
    end;
    b := sStyle.BGChanged;
    sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);
    RepaintsControls(Self, b);
  end else inherited;
end;

procedure TsCustomPanel.DrawPanelBorders(Canvas: TCanvas);
var
  R: TRect;
  SavedDC: hWnd;
  BevelOut : TsControlBevel;
  BevWidth : integer;
begin
  GetWindowRect(Handle, R);
  OffsetRect(R, -R.Left, -R.Top);
  SavedDC := SaveDC(FsStyle.FCacheBmp.Canvas.Handle);
  try

    if IsValidSkinIndex(sStyle.SkinIndex) then begin
      BevelOut := gd[sStyle.SkinIndex].PaintingBevel;
      BevWidth := gd[sStyle.SkinIndex].PaintingBevelWidth;
    end
    else begin
      BevelOut := BevelOuter;
      BevWidth := BevelWidth;
    end;
    sStyle.PaintBevel(FsStyle.FCacheBmp, R, BevWidth, BevelOut, sStyle.SoftControl);
    InflateRect(R, - BorderWidth - BevelWidth, - BorderWidth - BevelWidth);
    sStyle.PaintBevel(FsStyle.FCacheBmp, R, BevWidth, BevelInner, sStyle.SoftControl);
  finally
    RestoreDC(FsStyle.FCacheBmp.Canvas.Handle , SavedDC);
  end
end;

procedure TsCustomPanel.WndProc(var Message: TMessage);
begin