sgroupbox.pas

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

unit sGroupBox;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sPanel, sStyleUtil, sConst, sGraphUtils, sUtils, sVclUtils;

type
  TsCaptionLayout = (clTopLeft, clTopCenter, clTopRight);

  TsGroupBox = class(TsCustomPanel)
  private
    FCaptionLayout: TsCaptionLayout;
    FCaptionYOffset: integer;
    procedure SetCaptionLayout(const Value: TsCaptionLayout);
    procedure SetCaptionYOffset(const Value: integer);
  protected
    procedure DrawBorders(CaptionExists : boolean);
    function TextHeight : integer;
    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
  public
    function CaptionRect: TRect;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    function GetClientRect: TRect; override;
    procedure Paint; override;
    procedure WriteText(R : TRect; sStyle: TsPaintStyle); override;
  published
    property Align;
    property BevelInner default cbLoweredHard;
    property Caption;
    property CaptionLayout : TsCaptionLayout read FCaptionLayout write SetCaptionLayout default clTopLeft;
    property CaptionYOffset : integer read FCaptionYOffset write SetCaptionYOffset default 0;
    property Height default 100;

  end;

implementation

uses sStyleSimply, sDefaults, sMaskData, sSkinProps;

{ TsGroupBox }

function TsGroupBox.CaptionRect: TRect;
var
  aRect : TRect;
begin
  aRect.Top := 0;
  aRect.Bottom := aRect.Top + TextHeight;
  case FCaptionLayout of
    clTopLeft : begin
      aRect.Left := 6;
    end;
    clTopRight : begin
      aRect.Left := Width - sStyle.FCacheBmp.Canvas.TextWidth(Caption) - 18;
    end;
    clTopCenter : begin
      aRect.Left := (Width - sStyle.FCacheBmp.Canvas.TextWidth(Caption) - 12) div 2;
    end;
  end;
  if aRect.Left < 0 then aRect.Left := 0;
  aRect.Right := aRect.Left + sStyle.FCacheBmp.Canvas.TextWidth(Caption) + 12;
  if aRect.Right > Width then aRect.Right := Width;
  if WidthOf(aRect) < 2 * BevelWidth then begin
    aRect.Left := aRect.Left - BevelWidth;
    aRect.Right := aRect.Right + BevelWidth;
  end;                                             
  Result := aRect;
end;

constructor TsGroupBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle.COC := COC_TsGroupBox;
  FCaptionLayout := clTopLeft;
  FCaptionYOffset := 0;
  FBevelInner := cbLoweredHard;
  Height := 100;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsGroupBox;
  end;
end;

procedure TsGroupBox.CreateWnd;
begin
  inherited;
end;

destructor TsGroupBox.Destroy;
begin
  inherited Destroy;
end;

procedure TsGroupBox.DrawBorders(CaptionExists : boolean);
var
  R, cRect : TRect;
  hd : integer;
  i, w, h : integer;
begin
  R := Rect(0, 0, Width, Height);
  cRect := CaptionRect;
  hd := HeightOf(cRect);
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, BordersMask);
  if IsValidImgIndex(i) then begin
    if not CaptionExists then begin
      sStyle.RegionChanged := True;
      DrawMaskRect(FsStyle.FCacheBmp, ma[i].Bmp, 0, R, ma[i].TransparentColor, True, EmptyCI);
    end
    else begin
      w := ma[i].Bmp.Width;
      h := ma[i].Bmp.Height;
      DrawMaskedRectangle(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            point(0, hd div 2), classes.Rect(0, 0, w div 9, h div 6),
            ma[i].TransparentColor);      
      DrawMaskedRectangle(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            point(0, FsStyle.FCacheBmp.Height - h div 6), classes.Rect(0, h div 3, w div 9, h div 2),
            ma[i].TransparentColor);
      DrawMaskedRectangle(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            point(FsStyle.FCacheBmp.Width - w div 9, hd div 2), classes.Rect(w div 9 * 2, 0, w div 9 * 3, h div 6),
            ma[i].TransparentColor);
      DrawMaskedRectangle(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            point(FsStyle.FCacheBmp.Width - w div 9, FsStyle.FCacheBmp.Height - h div 6), classes.Rect(w div 9 * 2, h div 3, w div 9 * 3, h div 2),
            ma[i].TransparentColor);

      FillMaskedBorderV(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(0, hd div 2 + h div 6, w div 9, FsStyle.FCacheBmp.Height - h div 6),
            classes.Rect(0, h div 6, w div 9, h div 3),
            ma[i].TransparentColor);
      FillMaskedBorderV(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(FsStyle.FCacheBmp.Width - w div 9, hd div 2 + h div 6, FsStyle.FCacheBmp.Width, FsStyle.FCacheBmp.Height - h div 6),
            classes.Rect(w div 9 * 2, h div 6, w div 3, h div 3),
            ma[i].TransparentColor);
      FillMaskedBorderH(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(w div 9, FsStyle.FCacheBmp.Height - h div 6, FsStyle.FCacheBmp.Width - w div 9, FsStyle.FCacheBmp.Height),
            classes.Rect(w div 9, h div 3, w div 9 * 2, h div 2),
            ma[i].TransparentColor);

      case CaptionLayout of
        clTopLeft : begin
          FillMaskedBorderH(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(cRect.Right, hd div 2, FsStyle.FCacheBmp.Width - w div 9, hd div 2 + h div 6),
            classes.Rect(w div 9, 0, w div 9 * 2, h div 6),
            ma[i].TransparentColor);
        end;
        clTopCenter : begin
          FillMaskedBorderH(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(w div 9, hd div 2, cRect.Left, hd div 2 + h div 6),
            classes.Rect(w div 9, 0, w div 9 * 2, h div 6),
            ma[i].TransparentColor);
          FillMaskedBorderH(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(cRect.Right, hd div 2, FsStyle.FCacheBmp.Width - w div 9, hd div 2 + h div 6),
            classes.Rect(w div 9, 0, w div 9 * 2, h div 6),
            ma[i].TransparentColor);
        end;
        clTopRight : begin
          FillMaskedBorderH(FsStyle.FCacheBmp, ma[i].Bmp, 0,
            classes.rect(w div 9, hd div 2, cRect.Left, hd div 2 + h div 6),
            classes.Rect(w div 9, 0, w div 9 * 2, h div 6),
            ma[i].TransparentColor);
        end;
      end;
    end;
  end
  else begin
    if not CaptionExists then begin
      sStyle.PaintBevel(FsStyle.FCacheBmp, R, BevelWidth, sStyle.Painting.Bevel, sStyle.SoftControl);
      InflateRect(R, - BorderWidth - BevelWidth, - BorderWidth - BevelWidth);
      sStyle.PaintBevel(FsStyle.FCacheBmp, R, BevelWidth, BevelInner, sStyle.SoftControl);
    end
    else begin
      if sStyle.ActualBevel <> cbNone then begin
        // Outer borders
        BlendLineLR(FsStyle.FCacheBmp,
                    Rect(0, hd, BevelWidth, Height), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineTB(FsStyle.FCacheBmp,
                    Rect(0, hd, cRect.Left, hd + BevelWidth), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineLR(FsStyle.FCacheBmp,
                    Rect(cRect.Left, 0, cRect.Left + BevelWidth, hd), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineTB(FsStyle.FCacheBmp,
                    Rect(cRect.Left, 0, cRect.Right, BevelWidth), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineTB(FsStyle.FCacheBmp,
                    Rect(cRect.Right, hd, Width, hd + BevelWidth), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineRL(FsStyle.FCacheBmp,
                    Rect(cRect.Right - BevelWidth - 1, 0, cRect.Right, hd), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineBT(FsStyle.FCacheBmp,
                    Rect(0, Height - BevelWidth - 1, Width, Height), sStyle.SoftControl, sStyle.ActualBevel);
        BlendLineRL(FsStyle.FCacheBmp,
                    Rect(Width - BevelWidth - 1, hd, Width, Height), sStyle.SoftControl, sStyle.ActualBevel);
      end;

      if BevelInner <> cbNone then begin
        InflateRect(R, - BorderWidth - BevelWidth, - BorderWidth - BevelWidth);
        // Inner borders
        BlendLineLR(FsStyle.FCacheBmp,
                    Rect(R.Left, hd + R.Top, R.Left + BevelWidth, R.Bottom), sStyle.SoftControl, BevelInner);

        BlendLineTB(FsStyle.FCacheBmp,
                    Rect(R.Left, hd + R.Top, R.Right, hd + R.Top + BevelWidth), sStyle.SoftControl, BevelInner);
        BlendLineRL(FsStyle.FCacheBmp,
                    Rect(R.Right - BevelWidth, hd + R.Top, R.Right, R.Bottom), sStyle.SoftControl, BevelInner);
        BlendLineBT(FsStyle.FCacheBmp,
                    Rect(R.Left, R.Bottom - BevelWidth, R.Right, R.Bottom), sStyle.SoftControl, BevelInner);
      end;
    end;
  end;
end;

function TsGroupBox.GetClientRect: TRect;
begin
  Result.Left := 0;
  Result.Top := HeightOf(CaptionRect);
  Result.Right := Width;
  Result.Bottom := Height;
end;

procedure TsGroupBox.Paint;
var
  aRect: TRect;
  i: Integer;
  sc : TsGenStyle;
  SavedDC: longint;
  b : boolean;
begin 
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  aRect := Rect(0, 0, Width, Height);
    SavedDC := SaveDC(FsStyle.FCacheBmp.Canvas.Handle);
    if SavedDC = 0 then Exit;
    try
    if sStyle.BGChanged then begin
      sStyle.InitCacheBmp;

      sStyle.PaintBG(sStyle.FCacheBMP);

      DrawBorders(Caption <> '');
      if Caption <> '' then begin
        WriteText(CaptionRect, sStyle);
      end;
(*
      // Caption painting
      if False {Caption <> ''} then begin
        aRect.Top := 0;
        aRect.Bottom := aRect.Top + TextHeight;
        case Alignment of
          taLeftJustify : begin
            aRect.Left := 6;
          end;
          taRightJustify : begin
            aRect.Left := Width - sStyle.FCacheBmp.Canvas.TextWidth(Caption) - 18;
          end;
          taCenter : begin
            aRect.Left := (Width - sStyle.FCacheBmp.Canvas.TextWidth(Caption) - 12) div 2;
          end;
        end;
        aRect.Right := aRect.Left + sStyle.FCacheBmp.Canvas.TextWidth(Caption) + 12;

        if False{sStyle.Painting.Transparency < 100} then begin
          sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
          sStyle.FCacheBmp.Canvas.Pen.Width := BevelWidth;
          if BevelOuter in [cbRaisedSoft] then begin
            sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          end
          else if BevelOuter in [cbLoweredSoft] then begin
            sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          end;
          sStyle.FCacheBmp.Canvas.PolyLine([
                   Point(aRect.Left, aRect.Top + (TextHeight + BevelWidth) div 2),
                   Point(aRect.Left, aRect.Top + BevelWidth div 2),
                   Point(aRect.Right, aRect.Top + BevelWidth div 2),
                   Point(aRect.Right, aRect.Top + (TextHeight + BevelWidth) div 2)
                      ]);

          if BevelInner in [cbRaisedSoft] then begin
            sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          end
          else if BevelInner in [cbLoweredSoft] then begin
            sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          end;
          sStyle.FCacheBmp.Canvas.PolyLine([
                   Point(aRect.Left, aRect.Top + BorderWidth + (TextHeight + BevelWidth) div 2),
                   Point(aRect.Left, Maxi(aRect.Bottom, Margin)),
                   Point(aRect.Right, Maxi(aRect.Bottom, Margin)),
                   Point(aRect.Right, aRect.Top + BorderWidth + (TextHeight + BevelWidth) div 2)
                      ]);
        end;

        aRect.Top := 0;
        aRect.Bottom := TextHeight;

        sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(Caption), Enabled,
                                aRect,
                                DT_EXPANDTABS or DT_VCENTER or DT_CENTER);
      end;
*)

      for i := 0 to ControlCount - 1 do begin
        sc := GetsStyle(Controls[i]);
        if Assigned(sc) and (sc.COC > 0) and sc.Effects.Shadow.Enabled and Controls[i].Visible and not(csDestroying in Controls[i].ComponentState) then begin
          sc.PaintShadow(sStyle.FCacheBmp.Canvas, 0, 0);
        end;
      end;
    end;
    b := sStyle.BGChanged;
    sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);
    finally
      RestoreDC(FsStyle.FCacheBmp.Canvas.Handle, SavedDC);
    end;

    RepaintsControls(Self, b);
    sStyle.BGChanged := False;
end;

procedure TsGroupBox.SetCaptionLayout(const Value: TsCaptionLayout);
begin
  if FCaptionLayout <> Value then begin
    FCaptionLayout := Value;
    sStyle.RegionChanged := True;
    sStyle.CreateRgn;
//    Invalidate;
  end;
end;

procedure TsGroupBox.SetCaptionYOffset(const Value: integer);
begin
  if FCaptionYOffset <> Value then begin
    FCaptionYOffset := Value;
    sStyle.Invalidate;
  end;
end;

function TsGroupBox.TextHeight: integer;
begin
  Result := Maxi(Margin, sStyle.FCacheBmp.Canvas.TextHeight('W')) + 6;
end;

procedure TsGroupBox.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  if Message.Result <> 1 then
    inherited;
end;

procedure TsGroupBox.WriteText(R: TRect; sStyle: TsPaintStyle);
begin
  OffsetRect(R, 0, CaptionYOffset);
  inherited WriteText(R, sStyle);
end;

end.