sgroupbox.pas

Alpha Controls 界面控件包

unit sGroupBox;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF TNTUNICODE}TntGraphics, TntControls, TntActnList, TntClasses,
  TntSysUtils, TntWindows, TntForms, TntStdCtrls, {$IFDEF DELPHI7UP}Themes, {$ENDIF}{$ENDIF}
  StdCtrls, sCommonData, sRadioButton, sConst;

type
  TsCaptionLayout = (clTopLeft, clTopCenter, clTopRight);

{$IFDEF TNTUNICODE}
  TsGroupBox = class(TTntGroupBox)
{$ELSE}
  TsGroupBox = class(TGroupBox)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    FCaptionLayout: TsCaptionLayout;
    FCaptionYOffset: integer;
    FCommonData: TsCommonData;
    FCaptionSkin: TsSkinSection;
    procedure SetCaptionLayout(const Value: TsCaptionLayout);
    procedure SetCaptionYOffset(const Value: integer);
    procedure WMFontChanged(var Message : TMessage); message CM_FONTCHANGED;
    procedure SetCaptionSkin(const Value: TsSkinSection);
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    function TextHeight : integer;
    procedure WndProc (var Message: TMessage); override;
  public
    procedure AfterConstruction; override;
    procedure Loaded; override;
    function CaptionRect: TRect;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure PaintToDC(DC : hdc);
    procedure PrepareCache;
    procedure WriteText(R : TRect; CI : TCacheInfo);
  published
{$ENDIF} // NOTFORHELP
    property CaptionLayout : TsCaptionLayout read FCaptionLayout write SetCaptionLayout default clTopLeft;
    property CaptionYOffset : integer read FCaptionYOffset write SetCaptionYOffset default 0;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property CaptionSkin : TsSkinSection read FCaptionSkin write SetCaptionSkin;
{.$IFDEF TNTUNICODE
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
$ENDIF}
  end;

  TsRadioGroup = class(TsGroupBox)
{$IFNDEF NOTFORHELP}
  private
    FButtons: TList;
{$IFDEF TNTUNICODE}
    FItems: TTntStrings;
{$ELSE}
    FItems: TStrings;
{$ENDIF}
    FAnimatEvents : TacAnimatEvents;
    FItemIndex: Integer;
    FColumns: Integer;
    FReading: Boolean;
    FUpdating: Boolean;
    procedure ArrangeButtons;
    procedure ButtonClick(Sender: TObject);
    procedure ItemsChange(Sender: TObject);
    procedure SetButtonCount(Value: Integer);
    procedure SetColumns(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure UpdateButtons;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function GetButtons(Index: Integer): TsRadioButton;
{$IFDEF TNTUNICODE}
    procedure SetItems(Value: TTntStrings);
{$ELSE}
    procedure SetItems(Value: TStrings);
{$ENDIF}
  protected
    procedure ReadState(Reader: TReader); override;
    function CanModify: Boolean; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure WndProc (var Message: TMessage); override;
  public
    procedure Loaded; override;
    procedure AfterConstruction; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure FlipChildren(AllLevels: Boolean); override;
    property Buttons[Index: Integer]: TsRadioButton read GetButtons;
  published
    property AnimatEvents : TacAnimatEvents read FAnimatEvents write FAnimatEvents default [aeGlobalDef];
{$ENDIF} // NOTFORHELP
    property Columns: Integer read FColumns write SetColumns default 1;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
{$IFDEF TNTUNICODE}
    property Items: TTntStrings read FItems write SetItems;
{$ELSE}
    property Items: TStrings read FItems write SetItems;
{$ENDIF}
  end;

implementation

uses acUtils, sMessages, sVCLUtils, sMaskData, sGraphUtils, salphaGraph,
  ComCtrls, sSkinProps, sStyleSimply, sSKinManager
  {$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

{ TsGroupBox }

{.$IFDEF TNTUNICODE
procedure TsGroupBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;
{$ENDIF}

procedure TsGroupBox.AdjustClientRect(var Rect: TRect);
begin
  if not (csDestroying in ComponentState) then begin
    inherited AdjustClientRect(Rect);
    Inc(Rect.Top, CaptionYOffset);
  end;
end;

procedure TsGroupBox.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
end;

function TsGroupBox.CaptionRect: TRect;
const
  Margin = 4;
var
  aRect : TRect;
begin
  aRect.Top := 0;
  if FCommonData.Skinned then begin
    aRect.Bottom := aRect.Top + TextHeight + FCaptionYOffset;
    if FCaptionYOffset < 0 then inc(aRect.Top, FCaptionYOffset);
  end
  else aRect.Bottom := aRect.Top + TextHeight;
  case FCaptionLayout of
    clTopLeft   : aRect.Left := 6;
//    clTopRight  : aRect.Left := Width - FCommonData.FCacheBmp.Canvas.TextWidth(Caption) - 2 * Margin - 6;
//    clTopCenter : aRect.Left := (Width - FCommonData.FCacheBmp.Canvas.TextWidth(Caption) - Margin - 6) div 2;
    clTopRight  : aRect.Left := Width - acTextWidth(FCommonData.FCacheBmp.Canvas, Caption) - 2 * Margin - 6;
    clTopCenter : aRect.Left := (Width - acTextWidth(FCommonData.FCacheBmp.Canvas, Caption) - Margin - 6) div 2;
  end;
  if aRect.Left < 0 then aRect.Left := 0;
//  aRect.Right := aRect.Left + FCommonData.FCacheBmp.Canvas.TextWidth(Caption) + 2 * Margin;
  aRect.Right := aRect.Left + acTextWidth( FCommonData.FCacheBmp.Canvas, Caption) + 2 * Margin;
  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);
  ControlStyle := ControlStyle - [csOpaque];
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsGroupBox;
  FCaptionLayout := clTopLeft;
  FCaptionYOffset := 0;
end;

destructor TsGroupBox.Destroy;
begin
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsGroupBox.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsGroupBox.Paint;
begin
  if FCommonData.Skinned(True) then PaintToDC(Canvas.Handle) else inherited;
end;

procedure TsGroupBox.PaintToDC(DC : hdc);
var
  b : boolean;
{$IFDEF TNTUNICODE}
  {$IFDEF DELPHI7UP}
  procedure PaintThemedGroupBox;
  var
    CaptionRect: TRect;
    OuterRect: TRect;
    Size: TSize;
    Box: TThemedButton;
    Details: TThemedElementDetails;
  begin
    with Canvas do begin
      if Caption <> '' then
      begin
        GetTextExtentPoint32W(Handle, PWideChar(Caption), Length(Caption), Size);
        CaptionRect := Rect(0, 0, Size.cx, Size.cy);
        if not UseRightToLeftAlignment then
          OffsetRect(CaptionRect, 8, 0)
        else
          OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
      end
      else
        CaptionRect := Rect(0, 0, 0, 0);

      OuterRect := ClientRect;
      OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
      with CaptionRect do
        ExcludeClipRect(Handle, Left, Top, Right, Bottom);
      if Enabled then
        Box := tbGroupBoxNormal
      else
        Box := tbGroupBoxDisabled;
      Details := ThemeServices.GetElementDetails(Box);
      ThemeServices.DrawElement(Handle, Details, OuterRect);

      SelectClipRgn(Handle, 0);
      if Text <> '' then
        ThemeServices.DrawText{TNT-ALLOW DrawText}(Handle, Details, Caption, CaptionRect, DT_LEFT, 0);
    end;
  end;
  {$ENDIF}

  procedure PaintGroupBox;
  var
    H: Integer;
    R: TRect;
    Flags: Longint;
  begin
    with Canvas do begin
      H := WideCanvasTextHeight(Canvas, '0');
      R := Rect(0, H div 2 - 1, Width, Height);
      if Ctl3D then begin
        Inc(R.Left);
        Inc(R.Top);
        Brush.Color := clBtnHighlight;
        FrameRect(R);
        OffsetRect(R, -1, -1);
        Brush.Color := clBtnShadow;
      end
      else Brush.Color := clWindowFrame;
      FrameRect(R);
      if Caption <> '' then begin
        if not UseRightToLeftAlignment then R := Rect(8, 0, 0, H) else R := Rect(R.Right - WideCanvasTextWidth(Canvas, Caption) - 8, 0, 0, H);
        Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
        Brush.Color := Color;
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
      end;
    end;
  end;
{$ENDIF}
begin
  if FCommonData.Skinned(True) then begin
    if (csDestroying in ComponentState) or not (Visible or (csDesigning in componentState)) then Exit;
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating then begin
      // If transparent and form resizing processed
      b := FCommonData.HalfVisible or FCommonData.BGChanged;
      if SkinData.RepaintIfMoved then begin
        FCommonData.HalfVisible := not (PtInRect(Parent.ClientRect, Point(Left + 1, Top + 1)));
        FCommonData.HalfVisible := FCommonData.HalfVisible or not PtInRect(Parent.ClientRect, Point(Left + Width - 1, Top + Height - 1));
      end
      else FCommonData.HalfVisible := False;

      if b and not FCommonData.UrgentPainting then PrepareCache;
      CopyWinControlCache(Self, FCommonData, Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), DC, False);
      sVCLUtils.PaintControls(DC, Self, b, Point(0, 0)); // Painting of the skinned TGraphControls
      if DC = Canvas.Handle then SetParentUpdated(Self);
    end;
  end
  else begin
{$IFDEF TNTUNICODE}
    if (not Win32PlatformIsUnicode) then inherited else begin
      Canvas.Font := Self.Font;
      {$IFDEF DELPHI7UP}
      if ThemeServices.ThemesEnabled then PaintThemedGroupBox else
      {$ENDIF}
      PaintGroupBox;
    end;
{$ELSE}
    inherited;
{$ENDIF}
  end
end;

procedure TsGroupBox.PrepareCache;
var
  cRect, aRect: TRect;
  CI : TCacheInfo;
begin
  FCommonData.InitCacheBmp;

  aRect := Rect(0, 0, Width, Height);
  CI := GetParentCache(FCommonData);
  cRect := CaptionRect;

  if CI.Ready
    then BitBlt(FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, Width, HeightOf(cRect), CI.Bmp.Canvas.Handle, Left + CI.X, Top + CI.Y, SRCCOPY)
    else if Parent <> nil
           then FillDC(FCommonData.FCacheBmp.Canvas.Handle, Rect(0, 0, Width, cRect.Bottom), ColorToRGB(TsHackedControl(Parent).Color));

  if FCaptionYOffset < 0 then aRect.Top := 0 else aRect.Top := HeightOf(cRect) div 2;
  PaintItem(FCommonData, CI, False, 0, Rect(0, aRect.Top, Width, Height), Point(Left, Top + aRect.Top), FCommonData.FCacheBMP, False);

  if Caption <> '' then WriteText(cRect, CI);
  UpdateCorners(FCommonData, 0, [scLeftBottom, scRightBottom]);
  FCommonData.BGChanged := False;
end;

procedure TsGroupBox.SetCaptionLayout(const Value: TsCaptionLayout);
begin
  if FCaptionLayout <> Value then begin
    FCaptionLayout := Value;
    if Caption <> '' then SkinData.Invalidate;
  end;
end;

procedure TsGroupBox.SetCaptionSkin(const Value: TsSkinSection);
begin
  if FCaptionSkin <> Value then begin
    FCaptionSkin := Value;
    FCommonData.Invalidate
  end;
end;

procedure TsGroupBox.SetCaptionYOffset(const Value: integer);
begin
  if FCaptionYOffset <> Value then begin
    FCaptionYOffset := Value;
    SkinData.Invalidate;
//    Perform(WM_SIZE, 0, 0);
  end;
end;

function TsGroupBox.TextHeight: integer;
begin
  Result := Maxi(4, FCommonData.FCacheBmp.Canvas.TextHeight('W')) + 2;
end;

procedure TsGroupBox.WMFontChanged(var Message: TMessage);
begin
  inherited;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  if Caption <> '' then FCommonData.Invalidate;
end;

procedure TsGroupBox.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message, Name);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_SETNEWSKIN : begin
      AlphaBroadCast(Self, Message);
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_REFRESH, AC_REMOVESKIN : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);