sradiobutton.pas

Alpha Controls.v5.46b Source

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF TNTUNICODE}TntControls, TntActnList, TntForms, TntClasses, {$ENDIF}
  StdCtrls, sCommonData, sConst, sDefaults, sFade{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type
  TsRadioButton = class(TRadioButton)
{$IFNDEF NOTFORHELP}
  private
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    FGlyphUnChecked: TBitmap;
    FGlyphChecked: TBitmap;
    FTextIndent: integer;
    FPressed : boolean;
    FShowFocus: Boolean;
    FMargin: integer;
    FadeTimer : TsFadeTimer;
    FAnimatEvents: TacAnimatEvents;
{$IFNDEF DELPHI7UP}
    FWordWrap : boolean;
    procedure SetWordWrap(const Value: boolean);
{$ENDIF}
    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure SetGlyphChecked(const Value: TBitmap);
    procedure SetGlyphUnChecked(const Value: TBitmap);
    procedure SetTextIndent(const Value: integer);
    procedure SetShowFocus(const Value: Boolean);
    procedure SetMargin(const Value: integer);
    function GetReadOnly: boolean; virtual;
    procedure SetReadOnly(const Value: boolean);
{$IFDEF TNTUNICODE}
    function GetCaption: TWideCaption;
    procedure SetCaption(const Value: TWideCaption);
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsCaptionStored: Boolean;
    function IsHintStored: Boolean;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
{$ENDIF}
  protected
    FReadOnly: boolean;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure PaintHandler(M : TWMPaint);
    procedure PaintControl(DC : HDC);
    procedure DrawCheckText;
    procedure DrawCheckArea;
    procedure DrawSkinGlyph(i : integer);
    procedure PaintGlyph(Bmp : TBitmap);
    function SkinGlyphWidth(i : integer) : integer;
    function SkinGlyphHeight(i : integer) : integer;
    function SkinCheckRect(i : integer): TRect;

    function CheckRect: TRect;
    function GlyphWidth : integer;
    function GlyphHeight : integer;

    function GlyphMaskIndex(Checked : boolean) : smallint;
    procedure PrepareCache;
{$IFDEF TNTUNICODE}
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
{$ENDIF}
  public
    function GetControlsAlignment: TAlignment; override;
    procedure AfterConstruction; override;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure Loaded; override;
    procedure WndProc(var Message: TMessage); override;
  published
{$IFDEF TNTUNICODE}
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
{$ENDIF}
    property AutoSize default True;
    property Margin : integer read FMargin write SetMargin default 2;//0;
{$ENDIF} // NOTFORHELP
    property AnimatEvents : TacAnimatEvents read FAnimatEvents write FAnimatEvents default [aeGlobalDef];
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property GlyphChecked : TBitmap read FGlyphChecked write SetGlyphChecked;
    property GlyphUnChecked : TBitmap read FGlyphUnChecked write SetGlyphUnChecked;
    property ReadOnly : boolean read GetReadOnly write SetReadOnly default False;
    property ShowFocus: Boolean read FShowFocus write SetShowFocus default True;
    property TextIndent : integer read FTextIndent write SetTextIndent default 0;
{$IFNDEF DELPHI7UP}
    property WordWrap : boolean read FWordWrap write SetWordWrap default False;
{$ELSE}
    property WordWrap default False;
{$ENDIF}
  end;

implementation

uses sGraphUtils, acntUtils, sAlphaGraph, sVclUtils, sMaskData, sStylesimply, sSkinProps, ExtCtrls, sGroupBox,
  Math, sMessages, sSKinManager{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF};

{ TsRadioButton }

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

procedure TsRadioButton.AfterConstruction;
begin
  inherited;
  SkinData.Loaded;
end;

function TsRadioButton.GetControlsAlignment: TAlignment;
begin
  if not UseRightToLeftAlignment then
    Result := Alignment
  else
    if Alignment = taRightJustify then
      Result := taLeftJustify
    else
      Result := taRightJustify;
end;

function TsRadioButton.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
var
  ss : TSize;
  R : TRect;
  w, h : integer;
begin
  Result := False;
  if FCommonData.Skinned then begin
    if csLoading in ComponentState then Exit;
    if AutoSize then begin
      ss := GetStringSize(Font.Handle, Caption);
      R := CheckRect;
      NewWidth := WidthOf(R) + 2 * Margin + (ss.cx + FTextIndent + 8) * integer(Caption <> '');
      NewHeight := Max(HeightOf(R), 2 * Margin + ss.cy * integer(Caption <> '')) + 2;
      Result := True;
      w := NewWidth; h := NewHeight;
    end;
  end
  else begin
    if AutoSize then begin
      ss := GetStringSize(Font.Handle, Caption);
      NewWidth := ss.cx + 20;
      NewHeight := ss.cy + 4;
    end
    else begin
      w := NewWidth; h := NewHeight;
      Result := inherited CanAutoSize(w, h);
      NewWidth := w; NewHeight := h;
    end;
  end;
end;

function TsRadioButton.CheckRect: TRect;
var
  i : integer;
begin
  if FGlyphChecked.Width > 0 then begin
    if GetControlsAlignment = taRightJustify
      then Result := Rect(Margin, (Height - GlyphHeight) div 2, Margin + GlyphWidth, GlyphHeight + (Height - GlyphHeight) div 2)
      else Result := Rect(Width - GlyphWidth - Margin, (Height - GlyphHeight) div 2, Width - Margin, GlyphHeight + (Height - GlyphHeight) div 2)
  end
  else begin
    i := GlyphMaskIndex(Checked);
    if SkinData.SkinManager.IsValidImgIndex(i) then Result := SkinCheckRect(i) else Result := Rect(0, 0, 16, 16);
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsRadioButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsWideCharAccel(Message.CharCode, Caption)
    and CanFocus then
    begin
      SetFocus;
      Result := 1;
    end else
      Broadcast(Message);
end;
{$ENDIF}

constructor TsRadioButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, False);
  FCommonData.COC := COC_TsRadioButton;
  FCommonData.FOwnerControl := Self;
  FadeTimer := nil;
  FMargin := 2;//0;
  FShowFocus := True;
  FTextIndent := 0;
  FDisabledKind := DefDisabledKind;
  FGlyphChecked := TBitmap.Create;
  FGlyphUnChecked := TBitmap.Create;
  FPressed := False;
  AutoSize := True;
  FAnimatEvents := [aeGlobalDef];
{$IFNDEF DELPHI7UP}
  FWordWrap := False;
{$ELSE}
  WordWrap := False;
{$ENDIF}
end;

{$IFDEF TNTUNICODE}
procedure TsRadioButton.CreateWindowHandle(const Params: TCreateParams);
begin
  CreateUnicodeHandle(Self, Params, 'BUTTON');
end;

procedure TsRadioButton.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
{$ENDIF}

destructor TsRadioButton.Destroy;
begin
  StopFading(FadeTimer, FCommonData);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  if Assigned(FGlyphChecked) then FreeAndNil(FGlyphChecked);
  if Assigned(FGlyphUnchecked) then FreeAndNil(FGlyphUnChecked);
  inherited Destroy;
end;

procedure TsRadioButton.DrawCheckArea;
var
  CheckArea: TRect;
  i : integer;
begin
  if FGlyphChecked.Width > 0 then begin
    CheckArea := CheckRect;
    if Checked then begin
      PaintGlyph(FGlyphChecked);
    end
    else if not Checked then begin
      if (FGlyphUnChecked.Width > 0) then PaintGlyph(FGlyphUnChecked);
    end;
  end
  else if SkinData.SkinManager.IsValidSkinIndex(FCommonData.SkinIndex) then begin
    i := GlyphMaskIndex(Checked);
    if SkinData.SkinManager.IsValidImgIndex(i) then DrawSkinGlyph(i);
  end;
end;

procedure TsRadioButton.DrawCheckText;
var
  rText: TRect;
  Fmt: integer;
  t, b, w, h : integer;
begin
  if Caption <> '' then begin
    w := Width - (WidthOf(CheckRect) + FTextIndent + 2 * Margin + 2);

    rText := Rect(0, 0, w, 0);
    Fmt := DT_CALCRECT;
    if WordWrap
      then Fmt := Fmt or DT_WORDBREAK
      else Fmt := Fmt or DT_SINGLELINE;
    AcDrawText(FCommonData.FCacheBMP.Canvas.Handle, Caption, rText, Fmt);
    h := HeightOf(rText);
    t := Max((Height - h) div 2, Margin);
    b := Height - t;

    Fmt := 0;
    if GetControlsAlignment = taRightJustify then begin
      rText := Rect(Width - w - Margin + 2, t, Width - Margin, b);
      if not WordWrap then Fmt := DT_LEFT;
    end
    else begin
      rText := Rect(Margin, t, w + Margin, b);
    end;
    OffsetRect(rText, -integer(WordWrap), -1);
    if WordWrap
      then Fmt := Fmt or DT_WORDBREAK or DT_TOP or DT_CENTER
      else Fmt := Fmt or DT_SINGLELINE or DT_TOP;

    acWriteTextEx(FCommonData.FCacheBmp.Canvas, PacChar(Caption), True, rText, Fmt, FCommonData, ControlIsActive(FCommonData) and not ReadOnly);

    FCommonData.FCacheBmp.Canvas.Pen.Style := psClear;
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
    if Focused and ShowFocus then begin
      dec(rText.Bottom, 1 + integer(not WordWrap));
      inc(rText.Top);
      InflateRect(rText, 1, 1);
      FocusRect(FCommonData.FCacheBmp.Canvas, rText);
    end;
  end;
end;

procedure TsRadioButton.DrawSkinGlyph(i: integer);
var
  R : TRect;
  Mode : integer;
begin
  if FCommonData.FCacheBmp.Width < 1 then exit;
  CtrlParentColor := clFuchsia;
  R := SkinCheckRect(i);
  if FPressed then Mode := 2 else if ControlIsActive(FCommonData) and not ReadOnly then Mode := 1 else Mode := 0;
  sAlphaGraph.DrawSkinGlyph(FCommonData.FCacheBmp, R.TopLeft, Mode, 1, FCommonData.SkinManager.ma[i]);
end;

{$IFDEF TNTUNICODE}
function TsRadioButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

function TsRadioButton.GetCaption: TWideCaption;
begin
  Result := TntControl_GetText(Self)
end;

function TsRadioButton.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;
{$ENDIF}

function TsRadioButton.GetReadOnly: boolean;
begin
  if (Parent is TsRadioGroup) then begin
     Result := not TsRadioGroup(Parent).CanModify
  end
  else Result := FReadOnly;
end;

function TsRadioButton.GlyphHeight: integer;
begin
  Result := GlyphChecked.Height div 2;
end;

function TsRadioButton.GlyphMaskIndex(Checked : boolean): smallint;
begin
  if Checked
    then Result := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinManager.ConstData.IndexGLobalInfo, s_GLobalInfo, s_RadioButtonChecked)
    else Result := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinManager.ConstData.IndexGLobalInfo, s_GLobalInfo, s_RadioButtonUnChecked);
end;

function TsRadioButton.GlyphWidth: integer;
begin
  Result := GlyphChecked.Width div 3;
end;

procedure TsRadioButton.Invalidate;
begin
  inherited;
  if AutoSize then WordWrap := False;
end;

{$IFDEF TNTUNICODE}
function TsRadioButton.IsCaptionStored: Boolean;
begin
  Result := TntControl_IsCaptionStored(Self);