rvofficeradiobtn.pas

richviewaction 1.58 需要richview 1.9.46

      if FItemIndex >= 0 then
        TOfficeGroupButton(FButtons[FItemIndex]).Checked := False;
      FItemIndex := Value;
      if FItemIndex >= 0 then
        TOfficeGroupButton(FButtons[FItemIndex]).Checked := True;
    end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetItems(Value: TOfficeGroupItems);
begin
  FItems.Assign(Value);
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.UpdateButtons;
var i: Integer;
begin
  if not FReading then begin
    AdjustValue(FItemIndex, -1, FItems.Count-1);
    SetButtonCount(FItems.Count);
    UpdateButtonsGlbl(False);
    for i := 0 to FButtons.Count - 1 do
      TOfficeGroupButton(FButtons[i]).Assign(FItems[i]);
    if FItemIndex >= 0 then begin
      FUpdating := True;
      TOfficeGroupButton(FButtons[FItemIndex]).Checked := True;
      FUpdating := False;
    end;
    ArrangeButtons;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.UpdateButtonsGlbl(Repaint: Boolean);
var i: Integer;
    btn: TOfficeGroupButton;
begin
  if not FReading then
    for i := 0 to FButtons.Count - 1 do begin
      btn := TOfficeGroupButton(FButtons[i]);
      btn.Images          := Images;
      btn.FSelColor       := SelColor;
      btn.FSelWidth       := SelWidth;
      btn.FTextAreaHeight := TextAreaHeight;
      btn.FDisabled3d     := Disabled3D;
      btn.FTextPosition   := TextPosition;
      btn.FSquare         := Square;
      btn.UseXPThemes     := UseXPThemes;
      if Assigned(FOnCustomDraw) then
        btn.OnCustomDraw := DoCustomDraw
      else
        btn.OnCustomDraw := nil;
      if Repaint then
        btn.Invalidate;
    end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.UpdateButton(Index: Integer);
begin
  if not FReading then begin
    TOfficeGroupButton(FButtons[Index]).Assign(FItems[Index]);
    TOfficeGroupButton(FButtons[Index]).Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.CMEnabledChanged(var Msg: TMessage);
var
  i: Integer;
begin
  inherited;
  for i := 0 to FButtons.Count-1 do
    TOfficeGroupButton(FButtons[i]).Enabled := Enabled;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  ArrangeButtons;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.WMSize(var Msg: TWMSize);
begin
  inherited;
  ArrangeButtons;
end;
{------------------------------------------------------------------------------}
function TRVOfficeRadioGroup.CanModify: Boolean;
begin
  Result := True;
end;
{------------------------------------------------------------------------------}
function TRVOfficeRadioGroup.GetAnother(Index: Integer; Key: Word): Integer;
var ButtonsPerCol,i: Integer;
    AllDisabled: Boolean;
    {.......................................}
    function MakeStep(Index: Integer): Integer;
    begin
      case Key of
        VK_DOWN:
          Result := Index+1;
        VK_UP:
          Result := Index-1;
        VK_RIGHT:
          begin
            if Index=(Columns*ButtonsPerCol)-1 then
              Result := 0
            else begin
              Result := Index+ButtonsPerCol;
              if Index div ButtonsPerCol = Columns-1 then
                inc(Result);
            end;
          end;
        VK_LEFT:
          begin
            if Index=0 then
              Result := (Columns*ButtonsPerCol)-1
            else begin
              Result := Index-ButtonsPerCol;
              if Index div ButtonsPerCol = 0 then
                dec(Result);
            end;
          end;
        else
          Result := 0;
      end;
    end;
    {.......................................}
begin
  AllDisabled := True;
  for i := 0 to FButtons.Count-1 do
    if TRVOfficeRadioButton(FButtons[i]).CanFocus then begin
      AllDisabled := False;
      break;
    end;
  if AllDisabled then begin
    Result := -1;
    exit;
  end;
  ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
  Result := Index;
  repeat
    Result := MakeStep(Result);
    if Result<0 then
      inc(Result,(Columns*ButtonsPerCol));
    Result := Result mod (Columns*ButtonsPerCol);
  until (Result<FButtons.Count) and TRVOfficeRadioButton(FButtons[Result]).CanFocus;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.CreateThemeHandle;
begin
  if UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed and RV_IsThemeActive then
    FTheme := RV_OpenThemeData(Handle, PWideChar(WideString('Button')))
  else
    FTheme := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.FreeThemeHandle;
begin
  if FTheme<>0 then
    RV_CloseThemeData(FTheme);
  FTheme := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.CreateWnd;
begin
  inherited;
  CreateThemeHandle
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.DestroyWnd;
begin
  inherited;
  FreeThemeHandle;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.WMThemeChanged(var Msg: TMessage);
begin
  FreeThemeHandle;
  CreateThemeHandle;
  Invalidate;
  Msg.Result := 1;
end;

function TRVOfficeRadioGroup.GetThemeState: Integer;
begin
  if Enabled then
    Result := GBS_NORMAL
  else
    Result := GBS_DISABLED;
end;

procedure TRVOfficeRadioGroup.PerformEraseBackground(DC: HDC; FullPainting: Boolean);
var
  LastOrigin: TPoint;
begin
  GetWindowOrgEx(DC, LastOrigin);
  SetWindowOrgEx(DC, LastOrigin.X + Left, LastOrigin.Y + Top, nil);
  Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
  if FullPainting then
    Parent.Perform(WM_PAINT, Integer(DC), 0);
  SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
end;

procedure TRVOfficeRadioGroup.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  if not UseXPThemes or (FTheme=0) then begin
    inherited;
    exit;
  end;
  if DoubleBuffered then
    PerformEraseBackground(Msg.DC, False)
  else if RV_IsThemeBackgroundPartiallyTransparent(FTheme, BP_GROUPBOX, GetThemeState) then
    RV_DrawThemeParentBackground(Handle, Msg.DC, nil);
  Msg.Result := 1;
end;

function TRVOfficeRadioGroup.GetCaptionRect(DC: THandle): TRect;
var Size: TSize;
begin
  if Text <> '' then begin
    GetTextExtentPoint32(DC, PChar(Text), Length(Text), Size);
    Result := Rect(0, 0, Size.cx, Size.cy);
    if not UseRightToLeftAlignment then
      OffsetRect(Result, 8, 0)
    else
      OffsetRect(Result, Width - 8 - Result.Right, 0);
    end
  else
    Result := Rect(0, 0, 0, 0);
end;

procedure TRVOfficeRadioGroup.Paint;
var
    CaptionRect,
    OuterRect: TRect;
begin
  {$IFDEF USERVKSDEVTE}
  if IsObjectDefined(kgscGroupBox, ktoDefault) then begin
    if CurrentTheme.IsGroupTransparent(kgscGroupBox, ktoDefault) then
      DrawControlBackground(Self, Canvas.Handle);
    if not Enabled then
      Canvas.Font := CurrentTheme.Fonts[ktfGroupBoxTextDisabled]
    else
      Canvas.Font := CurrentTheme.Fonts[ktfGroupBoxTextNormal];
    CaptionRect := GetCaptionRect(Canvas.Handle);
    CurrentTheme.GroupDraw(kgscGroupBox, Canvas,
      GroupInfo(Rect(0, 0, Width, Height), CaptionRect, kgdsNormal));
    CurrentTheme.GroupDrawText(kgscGroupBox, Canvas,
      GroupInfo(Rect(0, 0, Width, Height), CaptionRect, kgdsNormal),
      TextInfo(CaptionRect, Text, DT_CENTER or DT_VCENTER or DT_SINGLELINE));
    exit;
  end;
  {$ENDIF}

  if not UseXPThemes or (FTheme=0) then begin
    inherited;
    exit;
  end;

  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, Canvas.Handle);
  {$ENDIF}
{
  if DoubleBuffered then
    PerformEraseBackground(Canvas.Handle, True)
  else if RV_IsThemeBackgroundPartiallyTransparent(FTheme, BP_GROUPBOX, GetThemeState) then
    RV_DrawThemeParentBackground(Handle, Canvas.Handle, nil);
 }
  Canvas.Font := Font;


  CaptionRect := GetCaptionRect(Canvas.Handle);

  OuterRect := ClientRect;
  OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
  with CaptionRect do
    ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);

  RV_DrawThemeBackground(FTheme, Canvas.Handle, BP_GROUPBOX, GetThemeState, OuterRect, nil);

  SelectClipRgn(Canvas.Handle, 0);
  if (Text <> '') then
    RV_DrawThemeText(FTheme, Canvas.Handle, BP_GROUPBOX, GetThemeState,
      PWideChar(_GetWideString(Text, Font.Charset)),
      Length(_GetWideString(Text, Font.Charset)), DT_LEFT, 0, CaptionRect);

  PaintControls(Canvas.Handle, nil);

end;

procedure TRVOfficeRadioGroup.WMPaint(var Msg: TWMPaint);
var PS: TPaintStruct;
    CaptionRect,
    OuterRect: TRect;
    LastFont: HFONT;
begin
  {$IFDEF USERVKSDEVTE}
  if CurrentTheme<>nil then begin
    inherited;
    exit;
  end;
  {$ENDIF}

  if not UseXPThemes or (FTheme=0) then begin
    inherited;
    exit;
  end;

  BeginPaint(Handle, PS);

  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, PS.hdc);
  {$ENDIF}

  LastFont := SelectObject(PS.hdc, Font.Handle);
  SetTextColor(PS.hdc, ColorToRGB(Font.Color));
  CaptionRect := GetCaptionRect(PS.hdc);

  OuterRect := ClientRect;
  OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
  with CaptionRect do
    ExcludeClipRect(PS.hdc, Left, Top, Right, Bottom);

  RV_DrawThemeBackground(FTheme, ps.hdc, BP_GROUPBOX, GetThemeState, OuterRect, nil);

  SelectClipRgn(PS.hdc, 0);
  if Text <> '' then
    RV_DrawThemeText(FTheme, PS.hdc, BP_GROUPBOX, GetThemeState,
      PWideChar(_GetWideString(Text, Font.Charset)),
      Length(_GetWideString(Text, Font.Charset)), DT_LEFT, 0, CaptionRect);

  SelectObject(PS.hdc, LastFont);

  PaintControls(PS.hdc, nil);
  EndPaint(Handle, PS);

  Msg.Result := 0;
end;

procedure TRVOfficeRadioGroup.WMSetFocus(var Msg: TMessage);
begin
  inherited;
  if not CanFocus then
    exit;
  if ItemIndex>=0 then
    TRVOfficeRadioButton(FButtons[ItemIndex]).SetFocus;
end;

procedure TRVOfficeRadioGroup.CMDenySubclassing(var Msg: TMessage);
begin
  Msg.Result := 1;
end;
{$IFDEF USERVKSDEVTE}
procedure TRVOfficeRadioGroup.SNMThemeMessage(var Msg: TMessage);
begin
  case Msg.wParam of
    SMP_APPLYTHEME, SMP_CHANGETHEME, SMP_REPAINT, SMP_REMOVETHEME:
      Invalidate;
  end;
end;
{$ENDIF}



end.