rvofficeradiobtn.pas

richviewaction 1.58 需要richview 1.9.46

    GetTextRect(R);
    //Canvas.Brush.Color := Color;
    //Canvas.FillRect(R);
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Style := [fsBold];
    Canvas.Font.Handle;
    Canvas.Font := Font;
    Canvas.Font.Handle;    
    Flags := DT_CENTER or DT_WORDBREAK;
    {$IFDEF RICHVIEWDEF4}
    Flags := DrawTextBiDiModeFlags(Flags);
    {$ENDIF}
    if not Checked then begin
      if not Enabled then
        State := RBS_UNCHECKEDDISABLED
      else
        State := RBS_UNCHECKEDNORMAL;
      end
    else begin
      if not Enabled then
        State := RBS_CHECKEDDISABLED
      else
        State := RBS_CHECKEDNORMAL;
    end;
    if TextPosition=orbtpBottom then
      inc(R.Top,2)
    else begin
      y := R.Bottom-2;
      if FThemeRadio<>0 then
        RV_DrawThemeText(FThemeRadio, Canvas.Handle, BP_RADIOBUTTON, State,
          PWideChar(_GetWideString(Caption, Font.Charset)),
          Length(_GetWideString(Caption, Font.Charset)),
          Flags or DT_CALCRECT, 0, R)
      else
        DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
      R := Rect(0, y - (R.Bottom-R.Top), ARect.Right, y);
    end;
    if not Enabled and Disabled3D and (FThemeRadio=0) then begin
      OffsetRect(R, 1, 1);
      Canvas.Font.Color := clBtnHighlight;
      DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, Flags);
      OffsetRect(R, -1, -1);
      Canvas.Font.Color := clBtnShadow;
      DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, Flags);
      end
    else begin
      if not Enabled then
        Canvas.Font.Color := clBtnShadow;
      if FThemeRadio<>0 then
        RV_DrawThemeText(FThemeRadio, Canvas.Handle, BP_RADIOBUTTON, State,
          PWideChar(_GetWideString(Caption, Font.Charset)),
          Length(_GetWideString(Caption, Font.Charset)),
          Flags, 0, R)
      else
        DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, Flags);
    end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CNDrawItem(var Msg: TWMDrawItem);
var Canvas: TCanvas;
    MemDC: HDC;
    MemBitmap, OldBitmap: HBITMAP;
begin
  if {$IFDEF USERVKSDEVTE} (CurrentTheme=nil) and {$ENDIF} (FThemeEdit<>0) then begin
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := Msg.DrawItemStruct.hDC;
      DrawTo(Canvas, Msg.DrawItemStruct.rcItem, (Msg.DrawItemStruct.itemState and ODS_FOCUS) <> 0);
    finally
      Canvas.Handle := 0;
      Canvas.Free;
    end;
    exit;
  end;

  with Msg.DrawItemStruct.rcItem do
    MemBitmap := CreateCompatibleBitmap(Msg.DrawItemStruct.hDC, Right-Left, Bottom-Top);
  MemDC := CreateCompatibleDC(Msg.DrawItemStruct.hDC);
  OldBitmap := SelectObject(MemDC, MemBitmap);
  try
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := MemDC;
      DrawTo(Canvas, Msg.DrawItemStruct.rcItem, (Msg.DrawItemStruct.itemState and ODS_FOCUS) <> 0);
    finally
      Canvas.Handle := 0;
      Canvas.Free;
    end;
    with Msg.DrawItemStruct.rcItem do
      BitBlt(Msg.DrawItemStruct.hDC, Left, Top, Right-Left, Bottom-Top, MemDC, 0, 0, SRCCOPY);
  finally
    SelectObject(MemDC, OldBitmap);
    DeleteDC(MemDC);
    DeleteObject(MemBitmap);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetFillColor(Value: TColor);
begin
  if FFillColor<>Value then begin
    FFillColor := Value;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetTextAreaHeight(const Value: Integer);
begin
  if FTextAreaHeight<>Value then begin
    FTextAreaHeight := Value;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetSelColor(const Value: TColor);
begin
  if FSelColor<>Value then begin
    FSelColor := Value;
    if Checked then
      Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetSelWidth(const Value: Integer);
begin
  if FSelWidth<>Value then begin
    FSelWidth := Value;
    if Checked then
      Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetDisabled3d(const Value: Boolean);
begin
  if FDisabled3D<>Value then begin
    FDisabled3D := Value;
    if not Enabled then
      Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetTextPosition(Value: TORBTextPosition);
begin
  if FTextPosition<>Value then begin
    FTextPosition := Value;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetImages(const Value: TRVImageList);
begin
  if Images <> nil then
    Images.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if Images <> nil then begin
    Images.RegisterChanges(FImageChangeLink);
    Images.FreeNotification(Self);
  end
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex<>Value then begin
    FImageIndex := Value;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetSquare(const Value: Boolean);
begin
  if FSquare<>Value then begin
    FSquare := Value;
    Invalidate;
  end;
end;
procedure TRVOfficeRadioButton.SetLargeSelection(const Value: Boolean);
begin
  if FLargeSelection<>Value then begin
    FLargeSelection := Value;
    Invalidate;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (AComponent=FImages) then begin
      FImages := nil;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.ImageListChange(Sender: TObject);
begin
  Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CreateThemeHandle;
begin
  if UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed and RV_IsThemeActive then begin
    FThemeEdit := RV_OpenThemeData(Handle, PWideChar(WideString('Edit')));
    FThemeRadio := RV_OpenThemeData(Handle, PWideChar(WideString('Button')));
    end
  else begin
    FThemeEdit := 0;
    FThemeRadio := 0;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.FreeThemeHandle;
begin
  if FThemeEdit<>0 then
    RV_CloseThemeData(FThemeEdit);
  FThemeEdit := 0;
  if FThemeRadio<>0 then
    RV_CloseThemeData(FThemeRadio);
  FThemeRadio := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.CreateWnd;
begin
  inherited;
  CreateThemeHandle;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.DestroyWnd;
begin
  inherited;
  FreeThemeHandle;
end;
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.WMThemeChanged(var Message: TMessage);
begin
  FreeThemeHandle;
  CreateThemeHandle;
  Invalidate;
  Message.Result := 1;
end;
{------------------------------------------------------------------------------}
{$IFDEF USERVKSDEVTE}
procedure TRVOfficeRadioButton.SNMThemeMessage(var Msg: TMessage);
begin
  case Msg.wParam of
    SMP_APPLYTHEME, SMP_CHANGETHEME, SMP_REPAINT, SMP_REMOVETHEME:
      Invalidate;
  end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TRVOfficeRadioButton.SetUseXPThemes(const Value: Boolean);
begin
  if FUseXPThemes<>Value then begin
    FUseXPThemes := Value;
    if HandleAllocated then begin
      FreeThemeHandle;
      CreateThemeHandle;
      Invalidate;
    end;
  end;
end;
{========================= TOfficeGroupItem ===================================}
procedure TOfficeGroupItem.AssignTo(Dest: TPersistent);
begin
  if Dest is TRVOfficeRadioButton then begin
    TRVOfficeRadioButton(Dest).FFillColor  := FFillColor;
    TRVOfficeRadioButton(Dest).FImageIndex := FImageIndex;
    TRVOfficeRadioButton(Dest).Enabled     := FEnabled;
    TRVOfficeRadioButton(Dest).Hint        := FHint;
    TRVOfficeRadioButton(Dest).HelpContext := FHelpContext;
    {$IFDEF RICHVIEWDEF6}
    TRVOfficeRadioButton(Dest).HelpKeyword := FHelpKeyword;
    TRVOfficeRadioButton(Dest).HelpType    := FHelpType;
    {$ENDIF}
    TRVOfficeRadioButton(Dest).Caption     := FCaption;
    end
  else
    inherited;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.Assign(Source: TPersistent);
begin
  if Source is TOfficeGroupItem then begin
    FFillColor   := TOfficeGroupItem(Source).FFillColor;
    FImageIndex  := TOfficeGroupItem(Source).FImageIndex;
    FEnabled     := TOfficeGroupItem(Source).FEnabled;
    FHint        := TOfficeGroupItem(Source).FHint;
    FHelpContext := TOfficeGroupItem(Source).FHelpContext;
    {$IFDEF RICHVIEWDEF6}
    FHelpKeyword := TOfficeGroupItem(Source).FHelpKeyword;
    FHelpType    := TOfficeGroupItem(Source).FHelpType;
    {$ENDIF}
    FCaption     := TOfficeGroupItem(Source).FCaption;
    end
  else
    inherited;
end;
{------------------------------------------------------------------------------}
constructor TOfficeGroupItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFillColor  := clWindow;
  FImageIndex := -1;
  FEnabled    := True;
  {$IFDEF RICHVIEWDEF6}
  FHelpType   := htContext;
  {$ENDIF}
  FCaption    := 'Item';
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetCaption(const Value: TCaption);
begin
  if FCaption<>Value then begin
    FCaption := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetEnabled(Value: Boolean);
begin
  if FEnabled<>Value then begin
    FEnabled := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetFillColor(Value: TColor);
begin
  if FFillColor<>Value then begin
    FFillColor := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetHelpContext(Value: THelpContext);
begin
  if FHelpContext<>Value then begin
    FHelpContext := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF6}
procedure TOfficeGroupItem.SetHelpKeyword(Value: String);
begin
  if FHelpKeyword<>Value then begin
    FHelpKeyword := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetHelpType(Value: THelpType);
begin
  if FHelpType<>Value then begin
    FHelpType := Value;
    Changed(False);
  end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetHint(Value: String);
begin
  if FHint<>Value then begin
    FHint := Value;
    Changed(False);
  end;
end;
{------------------------------------------------------------------------------}
procedure TOfficeGroupItem.SetImageIndex(Value: TImageIndex);
begin