rvofficeradiobtn.pas

richviewaction 1.58 需要richview 1.9.46

  if FImageIndex<>Value then begin
    FImageIndex := Value;
    Changed(False);
  end;
end;
{========================== TOfficeGroupButton ================================}
type
  TOfficeGroupButton = class(TRVOfficeRadioButton)
    private
      FInClick: Boolean;
      procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
      procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    protected
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
      procedure KeyPress(var Key: Char); override;
      procedure DblClick; override;
    public
      constructor InternalCreate(RadioGroup: TRVOfficeRadioGroup);
      destructor Destroy; override;
  end;
{------------------------------------------------------------------------------}
constructor TOfficeGroupButton.InternalCreate(RadioGroup: TRVOfficeRadioGroup);
begin
  inherited Create(RadioGroup);
  RadioGroup.FButtons.Add(Self);
  Visible        := False;
  Enabled        := RadioGroup.Enabled;
  OnClick        := RadioGroup.ButtonClick;
  Parent         := RadioGroup;
end;
{------------------------------------------------------------------------------}
destructor TOfficeGroupButton.Destroy;
begin
  TRVOfficeRadioGroup(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupButton.CNCommand(var Msg: TWMCommand);
begin
  if not FInClick then begin
    FInClick := True;
    try
      if ((Msg.NotifyCode = BN_CLICKED) or
        (Msg.NotifyCode = BN_DOUBLECLICKED) or
        (Msg.NotifyCode = BN_SETFOCUS)) and
        TRVOfficeRadioGroup(Parent).CanModify then
        inherited;
    except
      Application.HandleException(Self);
    end;
    FInClick := False;
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupButton.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := Msg.Result or DLGC_WANTARROWS;	
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupButton.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  TRVOfficeRadioGroup(Parent).KeyPress(Key);
  if ((Key = #8) or (Key = ' ')) and not TRVOfficeRadioGroup(Parent).CanModify then
    Key := #0;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
var Index: Integer;
begin
  if (Key=VK_LEFT) or (Key=VK_RIGHT) or (Key=VK_UP) or (Key=VK_DOWN) then begin
     Index := TRVOfficeRadioGroup(Parent).FButtons.IndexOf(Self);
     Index := TRVOfficeRadioGroup(Parent).GetAnother(Index, Key);
     if Index>=0 then
       TRVOfficeRadioButton(TRVOfficeRadioGroup(Parent).FButtons[Index]).SetFocus;
     Key := 0;
     exit;
  end;
  inherited KeyDown(Key, Shift);
  TRVOfficeRadioGroup(Parent).KeyDown(Key, Shift);
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupButton.DblClick;
begin
  inherited;
  if Assigned(TRVOfficeRadioGroup(Parent).OnDblClickItem) then
    TRVOfficeRadioGroup(Parent).OnDblClickItem(Parent);
end;
{============================ TOfficeGroupItems ===============================}
constructor TOfficeGroupItems.Create(RadioGroup: TRVOfficeRadioGroup);
begin
  inherited Create(TOfficeGroupItem);
  FRadioGroup := RadioGroup;
end;
{------------------------------------------------------------------------------}
function TOfficeGroupItems.Add: TOfficeGroupItem;
begin
  Result := TOfficeGroupItem(inherited Add);
end;
{------------------------------------------------------------------------------}
function TOfficeGroupItems.GetItem(Index: Integer): TOfficeGroupItem;
begin
  Result := TOfficeGroupItem(inherited GetItem(Index));
end;
{------------------------------------------------------------------------------}
function TOfficeGroupItems.GetOwner: TPersistent;
begin
  Result := FRadioGroup;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF4}
function TOfficeGroupItems.Insert(Index: Integer): TOfficeGroupItem;
begin
  Result := TOfficeGroupItem(inherited Insert(Index));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TOfficeGroupItems.SetItem(Index: Integer;
  Value: TOfficeGroupItem);
begin
  inherited SetItem(Index, Value);
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItems.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    FRadioGroup.UpdateButton(Item.Index)
  else
    FRadioGroup.UpdateButtons;
end;
{============================== TRVOfficeRadioGroup =============================}
constructor TRVOfficeRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csSetCaption, csDoubleClicks];
  FButtons     := TList.Create;
  FItems       := TOfficeGroupItems.Create(Self);
  FItemIndex   := -1;
  FColumns     := 1;
  FMargin      := 10;
  FSelColor    := clHighlight;
  FSelWidth    := 2;
  FTextAreaHeight := 30;
  FUseXPThemes := True;
  FDisabled3D  := True;
  Width        := 200;
  Height       := 200;
  TabStop      := True;
  {$IFDEF USERVKSDEVTE}
  AddThemeNotification(Self);
  {$ENDIF}
  //DoubleBuffered := True;
end;
{------------------------------------------------------------------------------}
destructor TRVOfficeRadioGroup.Destroy;
begin
  SetButtonCount(0);
  FItems.Free;
  FButtons.Free;
  {$IFDEF USERVKSDEVTE}
  RemoveThemeNotification(Self);
  {$ENDIF}
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.Loaded;
begin
  inherited Loaded;
  ArrangeButtons;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (AComponent=FImages) then begin
    FImages := nil;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.ReadState(Reader: TReader);
begin
  FReading := True;
  inherited ReadState(Reader);
  FReading := False;
  UpdateButtons;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF4}
procedure TRVOfficeRadioGroup.FlipChildren(AllLevels: Boolean);
begin

end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin

end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.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-Margin*2) div FColumns;
    TopMargin := Metrics.tmHeight + 1;
    ButtonHeight := (Height-TopMargin-Margin*2) div ButtonsPerCol;
    DeferHandle := BeginDeferWindowPos(FButtons.Count);
    try
      for i := 0 to FButtons.Count - 1 do
        with TOfficeGroupButton(FButtons[I]) do begin
          {$IFDEF RICHVIEWDEF4}
          BiDiMode := Self.BiDiMode;
          {$ENDIF}
          ALeft := (i div ButtonsPerCol) * ButtonWidth + Margin + Margin div 2;
          {$IFDEF RICHVIEWDEF4}
          if UseRightToLeftAlignment then
            ALeft := Self.ClientWidth - ALeft - ButtonWidth+Margin;
          {$ENDIF}
          DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
            ALeft,
            (I mod ButtonsPerCol) * ButtonHeight + TopMargin+Margin,
            ButtonWidth-Margin, ButtonHeight,
            SWP_NOZORDER or SWP_NOACTIVATE);
          Visible := True;
        end;
    finally
      EndDeferWindowPos(DeferHandle);
    end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.ButtonClick(Sender: TObject);
begin
  if not FUpdating then begin
    FItemIndex := FButtons.IndexOf(Sender);
    Changed;
    Click;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetMargin(Value: Integer);
begin
  if FMargin<>Value then begin
    FMargin := Value;
    if not FReading then
      ArrangeButtons;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetImages(Value: TRVImageList);
begin
  if FImages<>Value then begin
    FImages := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetDisabled3d(Value: Boolean);
begin
  if FDisabled3d<>Value then begin
    FDisabled3d := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetSelColor(Value: TColor);
begin
  if FSelColor<>Value then begin
    FSelColor := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetSelWidth(Value: Integer);
begin
  if FSelWidth<>Value then begin
    FSelWidth := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetTextAreaHeight(Value: Integer);
begin
  if FTextAreaHeight<>Value then begin
    FTextAreaHeight := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetTextPosition(Value: TORBTextPosition);
begin
  if FTextPosition<>Value then begin
    FTextPosition := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetSquare(const Value: Boolean);
begin
  if FSquare<>Value then begin
    FSquare := Value;
    UpdateButtonsGlbl(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetUseXPThemes(const Value: Boolean);
begin
  if FUseXPThemes<>Value then begin
    FUseXPThemes := Value;
    FreeThemeHandle;
    CreateThemeHandle;
    UpdateButtonsGlbl(True);
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetCustomDraw(Value: TORGCustomDrawEvent);
begin
  FOnCustomDraw := Value;
  UpdateButtonsGlbl(True);
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.DoCustomDraw(Sender: TRVOfficeRadioButton;
  Canvas: TCanvas; const ARect: TRect; var DoDefault: Boolean);
begin
  if Assigned(FOnCustomDraw) then
    FOnCustomDraw(Self, FButtons.IndexOf(Sender), Canvas, ARect, DoDefault);
end;

{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetButtonCount(Value: Integer);
begin
  while FButtons.Count<Value do
    TOfficeGroupButton.InternalCreate(Self);
  while FButtons.Count>Value do
    TOfficeGroupButton(FButtons.Last).Free;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetColumns(Value: Integer);
begin
  AdjustValue(Value, 1, 16);
  if FColumns<>Value then begin
    FColumns := Value;
    ArrangeButtons;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioGroup.SetItemIndex(Value: Integer);
begin
  if FReading then
    FItemIndex := Value
  else begin
    AdjustValue(Value, -1, FButtons.Count-1);
    if FItemIndex<>Value then begin