sgroupbox.pas

Alpha Controls 界面控件包

        AlphaBroadCast(Self, Message);
        Repaint;
      end
      else AlphaBroadCast(Self, Message);
      exit
    end
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_PREPARING : begin
        Message.LParam := integer(FCommonData.BGChanged or FCommonData.Updating {or (Name = '')});
        exit
      end;
      AC_URGENTPAINT : begin // v4.08
        CommonWndProc(Message, FCommonData);
        if FCommonData.UrgentPainting then PrepareCache;
        Exit
      end;
      AC_ENDPARENTUPDATE : if FCommonData.Updating {or FCommonData.HalfVisible} then begin
        FCommonData.Updating := False;
        if Visible or (csDesigning in ComponentState) then Repaint;
        Exit;
      end;
    end
    else case Message.Msg of
      WM_PRINT : begin
        SkinData.Updating := False;
        PaintToDC(TWMPaint(Message).DC);
      end;
      CM_TEXTCHANGED : begin
        SkinData.Invalidate;
        Exit;
      end;
      WM_ERASEBKGND : begin
        Message.Result := 1;
        Exit;
      end;
      CM_VISIBLECHANGED, WM_WINDOWPOSCHANGED{, WM_WINDOWPOSCHANGING} : begin //v4.42
        FCommonData.BGChanged := True;
      end;
      WM_KILLFOCUS, WM_SETFOCUS: begin inherited; exit end; // v4.12
      WM_MOVE : begin
        FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.RepaintIfMoved; // v4.53
{        if FCommonData.BGChanged then begin
          m := MakeMessage(SM_ALPHACMD, MakeWParam(1, AC_SETBGCHANGED), 0, 0);
          BroadCast(m); // v4.84
        end;}
      end;
    end;
    CommonWndProc(Message, FCommonData);
    if Message.Result <> 1 then
    inherited;
    case Message.Msg of
      WM_SIZE : if (csDesigning in ComponentState) then Repaint // v4.31
    end
  end;
end;

procedure TsGroupBox.WriteText(R: TRect; CI : TCacheInfo);
var
//  Text: string;
  sSection : string;
  sIndex : integer;
begin
  if FCaptionSkin = '' then begin
    sSection := s_CHECKBOX;
    sIndex := FCommonData.SkinManager.GetSkinIndex(sSection);
    if not CI.Ready and (Parent <> nil)
      then FillDC(FCommonData.FCacheBmp.Canvas.Handle, R, ColorToRGB(TsHackedControl(Parent).Color))
      else begin
        PaintItem(sIndex, sSection, CI, True, integer(Focused), R, Point(Left + R.Left, Top + R.Top), FCommonData.FCacheBmp, FCommonData.SkinManager);
      end;
  end
  else begin                   
    sSection := FCaptionSkin;
    sIndex := FCommonData.SkinManager.GetSkinIndex(sSection);
    CI.Bmp := FCommonData.FCacheBmp;
    CI.X := 0;
    CI.Y := 0;
    PaintItem(sIndex, sSection, CI, True, integer(Focused), R, Point({Left + 1}0, {R.Top + {Top + 1}0), FCommonData.FCacheBmp, FCommonData.SkinManager);
  end;
//  Text := Caption;

{$IFDEF TNTUNICODE}
//  sGraphUtils.WriteUniCode(FCommonData.FCacheBmp.Canvas, Caption, True, R, DT_CENTER, FCommonData, ControlIsActive(FCommonData));
  WriteTextExW(FCommonData.FCacheBmp.Canvas, PWideChar(Caption), True, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER, FCommonData, False);
{$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PChar(Caption), True, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER, SkinData, False);
{$ENDIF}
end;

{ TsGroupButton }

type
  TsGroupButton = class(TsRadioButton)
  private
    FInClick: Boolean;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor InternalCreate(RadioGroup: TsRadioGroup);
    destructor Destroy; override;
  end;

constructor TsGroupButton.InternalCreate(RadioGroup: TsRadioGroup);
begin
  inherited Create(RadioGroup);
  SkinData.SkinManager := RadioGroup.SkinData.SkinManager;
  SkinData.SkinSection := s_RADIOBUTTON;
  ShowFocus := True;
  RadioGroup.FButtons.Add(Self);
  Visible := False;
  Enabled := RadioGroup.Enabled;
  ParentShowHint := False;
  OnClick := RadioGroup.ButtonClick;
  Parent := RadioGroup;
  TabStop := False; // v4.31
  SkinData.CustomFont := RadioGroup.SkinData.CustomFont;
  AnimatEvents := RadioGroup.AnimatEvents;
//  ControlStyle := ControlStyle + [csopaque]
end;

destructor TsGroupButton.Destroy;
begin
  TsRadioGroup(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;

procedure TsGroupButton.CNCommand(var Message: TWMCommand);
begin
  if not FInClick then begin
    FInClick := True;
    try
      if {not SkinData.Skinned and v4.65}((Message.NotifyCode = BN_CLICKED) or (Message.NotifyCode = BN_DOUBLECLICKED)) and
                TsRadioGroup(Parent).CanModify then inherited;
    except
      Application.HandleException(Self);
    end;
    FInClick := False;
  end;
end;

procedure TsGroupButton.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  TsRadioGroup(Parent).KeyPress(Key);
  if (Key = #8) or (Key = ' ') then begin
    if not TsRadioGroup(Parent).CanModify then Key := #0;
  end;
end;

procedure TsGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  TsRadioGroup(Parent).KeyDown(Key, Shift);
end;

{ TsRadioGroup }

procedure TsRadioGroup.AfterConstruction;
begin
  inherited;
//  UpdateButtons;
end;

procedure TsRadioGroup.ArrangeButtons;
var
  ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
  DeferHandle: THandle;
  ALeft: Integer;
begin
  if (FButtons.Count <> 0) and not FReading then begin
    DC := GetDC(0);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
    ReleaseDC(0, DC);
    ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
    ButtonWidth := (Width - 10) div FColumns;
    I := Height - HeightOf(CaptionRect) - 5;
    ButtonHeight := I div ButtonsPerCol;
    TopMargin := HeightOf(CaptionRect) + 2;
    DeferHandle := BeginDeferWindowPos(FButtons.Count);
    try
      for I := 0 to FButtons.Count - 1 do with TsGroupButton(FButtons[I]) do begin
        TsGroupButton(FButtons[I]).SkinData.SkinManager := Self.SkinData.SkinManager;
        BiDiMode := self.BiDiMode;
        ALeft := (I div ButtonsPerCol) * ButtonWidth + 8;
        if UseRightToLeftAlignment then ALeft := Self.ClientWidth - ALeft - ButtonWidth;
        DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
                                      ALeft,
                                      (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
                                      ButtonWidth, ButtonHeight,
                                      SWP_NOZORDER or SWP_NOACTIVATE);
        Visible := True;
      end;
    finally
      EndDeferWindowPos(DeferHandle);
    end;
  end;
end;

procedure TsRadioGroup.ButtonClick(Sender: TObject);
begin
  if not FUpdating then begin
    FItemIndex := FButtons.IndexOf(Sender);
    Changed;
    Click;
  end;
end;

function TsRadioGroup.CanModify: Boolean;
begin
  Result := True;
end;

procedure TsRadioGroup.CMEnabledChanged(var Message: TMessage);
var
  I: Integer;
begin
  inherited;
  for I := 0 to FButtons.Count - 1 do begin
    TsGroupButton(FButtons[I]).Enabled := Enabled;
    TsGroupButton(FButtons[I]).SkinData.BGChanged := True;
  end;
end;

procedure TsRadioGroup.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ArrangeButtons;
end;

constructor TsRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csSetCaption, csDoubleClicks];
  FButtons := TList.Create;
{$IFDEF TNTUNICODE}
  FItems := TTntStringList.Create;
  TTntStringList(FItems).OnChange := ItemsChange;
{$ELSE}
  FItems := TStringList.Create;
  TStringList(FItems).OnChange := ItemsChange;
{$ENDIF}
  FItemIndex := -1;
  FColumns := 1;
  FAnimatEvents := [aeGlobalDef];
end;

destructor TsRadioGroup.Destroy;
begin
  SetButtonCount(0);
  TStringList(FItems).OnChange := nil;
  FItems.Free;
  FButtons.Free;
  inherited Destroy;
end;

procedure TsRadioGroup.FlipChildren(AllLevels: Boolean);
begin
//
end;

function TsRadioGroup.GetButtons(Index: Integer): TsRadioButton;
begin
  Result := TsRadioButton(FButtons[Index]);
end;

procedure TsRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
//
end;

procedure TsRadioGroup.ItemsChange(Sender: TObject);
var
  i : integer;
begin
  if not FReading then begin
    if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
    UpdateButtons;
  end;
  for i := 0 to FButtons.Count - 1 do begin
    TsRadioButton(FButtons[i]).Loaded;
  end;
end;

procedure TsRadioGroup.Loaded;
begin
  inherited Loaded;
  ArrangeButtons;
end;

procedure TsRadioGroup.ReadState(Reader: TReader);
begin
  FReading := True;
  inherited ReadState(Reader);
  FReading := False;
  UpdateButtons;
end;

procedure TsRadioGroup.SetButtonCount(Value: Integer);
begin
  while FButtons.Count < Value do TsGroupButton.InternalCreate(Self);
  while FButtons.Count > Value do TsGroupButton(FButtons.Last).Free;
end;

procedure TsRadioGroup.SetColumns(Value: Integer);
begin
  if Value < 1 then Value := 1;
  if Value > 16 then Value := 16;
  if FColumns <> Value then begin
    FColumns := Value;
    ArrangeButtons;
    Invalidate;
  end;
end;

procedure TsRadioGroup.SetItemIndex(Value: Integer);
begin
  if FReading then FItemIndex := Value else begin
    if Value < -1 then Value := -1;
    if Value >= FButtons.Count then Value := FButtons.Count - 1;
    if FItemIndex <> Value then begin
      if FItemIndex >= 0 then TsGroupButton(FButtons[FItemIndex]).Checked := False;
      FItemIndex := Value;
      if FItemIndex >= 0 then TsGroupButton(FButtons[FItemIndex]).Checked := True;
    end;
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsRadioGroup.SetItems(Value: TTntStrings);
begin
  FItems.Assign(Value);
end;
{$ELSE}
procedure TsRadioGroup.SetItems(Value: TStrings);
begin
  FItems.Assign(Value);
end;
{$ENDIF}

procedure TsRadioGroup.UpdateButtons;
var
  I: Integer;
begin
  SetButtonCount(FItems.Count);
  for I := 0 to FButtons.Count - 1 do TsGroupButton(FButtons[I]).Caption := FItems[I];
  if FItemIndex >= 0 then begin
    FUpdating := True;
    TsGroupButton(FButtons[FItemIndex]).Checked := True;
    FUpdating := False;
  end;
  ArrangeButtons;
  Invalidate;
end;

procedure TsRadioGroup.WMSize(var Message: TWMSize);
begin
  inherited;
  ArrangeButtons;
end;

procedure TsRadioGroup.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
//    AC_SETNEWSKIN,
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then ArrangeButtons;
  end;
  inherited;
end;

end.