rvofficeradiobtn.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       TRVOfficeRadioButton, TRVOfficeRadioGroup v1.2  }
{       Selectors like in Microsoft Office              }
{                                                       }
{       Copyright (c) 2002-2007, Sergey Tkachenko       }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

{==============================================================================}
{

 "Radio button" and group of buttons that look like selectors from MS Office
 (sunken white rectangle with image and optional text label below, for
  example for choosing bullets and numbering).
 Support XP themes.

}
{==============================================================================}

unit RVOfficeRadioBtn;

{

Changes:
  v1.4
  - Charset is uses even when drawing themed text
  v1.3
  - Support for ThemeEngine (www.ksdev.com) 3.5.9+
  v1.2
  - UseXPThemes: Boolean (default True) - use or not themes of WinXP (if available)
  - Compatibility with TThemeManager by Mike Lischke (www.lischke-online.de)
    (older version caused a crash of theme manager)
  v1.1:
  - Square: Boolean - property for TRVOfficeRadioButton and TRVOfficeRadioGroup.
    If True, width and height of sunken rectangle will be equal
  - Height of text area is scaled proportionally to screen's PixelsPerInch
  - Fix: word-wrapping did not work

  ================ TRVOfficeRadioButton ======================

TRVOfficeRadioButton has all properties of TRadioButton
(actually, it is inherited from TRadioButton).

It has additional properties:
* FillColor: TColor (default clWindow)
  Background color of sunken rectangle
* SelColor: TColor (default clHighlight)
  Color of rectangle for showing selected button
* SelWidth : Integer (default 2)
  Width of rectangle for showing selected button
* TextAreaHeight: Integer (default 30)
  Height (in pixels) of text area for displaying Caption.
  This area can be below or above the sunken rectangle.
  Set it to 0 to hide Caption.
  Caption can be wrapped.
* TextPosition: TORBTextPosition (default orbtpBottom)
  Defines the position of Caption (Bottom or Top)
* Disabled3D: Boolean (default True)
  Set it to False to draw disabled Caption without 3D effect,
  like in MS Office
* Images: TRVImageList;
  (TRVImageList is an alias for TCustomImageList)
  Link to ImageList for drawing images
* ImageIndex: TImageIndex (default -1)
  Index of image in Images.
* Square: Boolean (default false)
  If True, width and height of sunken rectangle will be equal
  
Additional event:
* OnCustomDraw: TORBCustomDrawEvent;
  TORBCustomDrawEvent = procedure (Sender: TRVOfficeRadioButton;
    Canvas: TCanvas; const ARect: TRect;
    var DoDefault: Boolean) of object;
  Allows to draw your own image instead of (or together with, if you do
  not set DoDefault to false) image from image list.
  Draw your image onto specified Canvas, in specified ARect.

  ================ TRVOfficeRadioGroup ======================

This component is similar to TRadioGroup, with the following exceptions:
- this is a group of TRVOfficeRadioButtons;
- Items property is not a TStringList, but TCollection
- this component allows to disable, set hint and helpcontext for individual buttons
- right/left key moves focus to the button to the right/left (in TRadioGroup,
  they work just like down/up keys)
- there is an event that occurs when double-clicking individual button.

TRVOfficeRadioGroup has all properties of TRadioGroup.

Additional properties:
* Items: TOfficeGroupItems
  Collection of objects defining properties of individual buttons
  (FillColor,ImageIndex,Enabled,Hint,HelpContext,HelpKeyword,HelpType,Caption)
* Images,SelColor,SelWidth,TextAreaHeight,Disabled3D,TextPosition,Square
  Assigned to the corresponding properties of all radiobuttons in the group.
* Margin
  Spacing between columns, and between borders and outermost radiobuttons.
  Spacing between rows = 0 - use TextAreaHeight instead.

Additional events:
* OnDblClickItem: TNotifyEvent
  Occurs when user double clicks some radiobutton.
* OnCustomDraw: TORGCustomDrawEvent
  TORGCustomDrawEvent = procedure (Sender: TRVOfficeRadioGroup;
    ItemIndex: Integer; Canvas: TCanvas; const ARect: TRect;
    var DoDefault: Boolean) of object;
  Custom drawing of the ItemIndex-th radiobutton
}

interface
{$I RV_Defs.inc}
{$I RichViewActions.inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls,
  {$IFDEF RICHVIEWDEF4}
  ImgList,
  {$ENDIF}
  {$IFDEF USERVKSDEVTE}
  te_theme,
  {$ENDIF}
  Forms, RVXPTheme;

const
  CM_DENYSUBCLASSING = CM_BASE + 2000; // For compatibility with TThemeManager by Mike Lischke

type
  {$IFNDEF RICHVIEWDEF5}
  TImageIndex = Integer;
  {$ENDIF}

  {$IFDEF RICHVIEWDEF4}
  TRVImageList = TCustomImageList;
  {$ELSE}
  TRVImageList = TImageList;
  {$ENDIF}

  TRVOfficeRadioButton = class;
  TRVOfficeRadioGroup = class;

  TORBTextPosition = (orbtpBottom, orbtpTop);

  TORBCustomDrawEvent = procedure (Sender: TRVOfficeRadioButton;
    Canvas: TCanvas; const ARect: TRect;
    var DoDefault: Boolean) of object;
  TORGCustomDrawEvent = procedure (Sender: TRVOfficeRadioGroup;
    ItemIndex: Integer; Canvas: TCanvas; const ARect: TRect;
    var DoDefault: Boolean) of object;

  TRVOfficeRadioButton = class(TRadioButton)
    private
      FFillColor: TColor;
      FTextAreaHeight: Integer;
      FSelColor: TColor;
      FSelWidth: Integer;
      FDisabled3d: Boolean;
      FImageIndex: TImageIndex;
      FImageChangeLink: TChangeLink;
      FTextPosition: TORBTextPosition;
      FOnCustomDraw: TORBCustomDrawEvent;
      FImages: TRVImageList;
      FSquare: Boolean;
      FThemeEdit, FThemeRadio: HTheme;
      FUseXPThemes: Boolean;
      FLargeSelection: Boolean;
      procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
      {$IFDEF USERVKSDEVTE}
      procedure SNMThemeMessage(var Msg: TMessage); message SNM_THEMEMESSAGE;
      {$ENDIF}
      procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
      procedure DrawTo(Canvas: TCanvas; const ARect: TRect; AFocused: Boolean);
      procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
      procedure BMSetCheck(var Msg: TMessage); message BM_SETCHECK;
      procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
      procedure CMDenySubclassing(var Msg: TMessage); message CM_DENYSUBCLASSING;
      procedure SetFillColor(Value: TColor);
      procedure SetTextAreaHeight(const Value: Integer);
      procedure SetSelColor(const Value: TColor);
      procedure SetSelWidth(const Value: Integer);
      procedure SetDisabled3d(const Value: Boolean);
      procedure SetImages(const Value: TRVImageList);
      procedure SetImageIndex(const Value: TImageIndex);
      procedure ImageListChange(Sender: TObject);
      procedure SetTextPosition(Value: TORBTextPosition);
      function DoCustomDraw(Canvas: TCanvas; R: TRect): Boolean;
      procedure SetSquare(const Value: Boolean);
      procedure CreateThemeHandle;
      procedure FreeThemeHandle;
      procedure SetUseXPThemes(const Value: Boolean);
      procedure SetLargeSelection(const Value: Boolean);
    protected
      procedure CreateParams(var Params: TCreateParams); override;
      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
      procedure CreateWnd; override;
      procedure DestroyWnd; override;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      property FillColor: TColor read FFillColor write SetFillColor default clWindow;
      property SelColor: TColor read FSelColor write SetSelColor default clHighlight;
      property SelWidth: Integer read FSelWidth write SetSelWidth default 2;
      property TextAreaHeight: Integer read FTextAreaHeight write SetTextAreaHeight default 30;
      property Disabled3D: Boolean read FDisabled3d write SetDisabled3d default True;
      property Images: TRVImageList read FImages write SetImages;
      property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
      property Square: Boolean read FSquare write SetSquare default False;
      property LargeSelection: Boolean read FLargeSelection write SetLargeSelection default False;
      property TextPosition: TORBTextPosition read FTextPosition write SetTextPosition default orbtpBottom;
      property OnCustomDraw: TORBCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
      property UseXPThemes: Boolean read FUseXPThemes write SetUseXPThemes default True;
      property TabStop;
  end;

  TOfficeGroupItem = class (TCollectionItem)
    private
      FEnabled: Boolean;
      FHint: String;
      FFillColor: TColor;
      FHelpContext: THelpContext;
      {$IFDEF RICHVIEWDEF6}
      FHelpType: THelpType;
      FHelpKeyword: String;
      {$ENDIF}
      FImageIndex: TImageIndex;
      FCaption: TCaption;
      procedure SetEnabled(Value: Boolean);
      procedure SetFillColor(Value: TColor);
      procedure SetHelpContext(Value: THelpContext);
      {$IFDEF RICHVIEWDEF6}
      procedure SetHelpKeyword(Value: String);
      procedure SetHelpType(Value: THelpType);
      {$ENDIF}
      procedure SetHint(Value: String);
      procedure SetImageIndex(Value: TImageIndex);
      procedure SetCaption(const Value: TCaption);
    public
      constructor Create(Collection: TCollection); override;
      procedure AssignTo(Dest: TPersistent); override;
      procedure Assign(Source: TPersistent); override;
    published
      property FillColor: TColor read FFillColor write SetFillColor default clWindow;
      property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      property Hint: String read FHint write SetHint;
      property HelpContext: THelpContext read FHelpContext write SetHelpContext default 0;
      {$IFDEF RICHVIEWDEF6}
      property HelpKeyword: String read FHelpKeyword write SetHelpKeyword;
      property HelpType: THelpType read FHelpType write SetHelpType default htContext;
      {$ENDIF}
      property Caption: TCaption read FCaption write SetCaption stored True;
  end;

  TOfficeGroupItems = class(TCollection)
    private
      FRadioGroup: TRVOfficeRadioGroup;
      function GetItem(Index: Integer): TOfficeGroupItem;
      procedure SetItem(Index: Integer; Value: TOfficeGroupItem);
    protected
      function GetOwner: TPersistent; override;
      procedure Update(Item: TCollectionItem); override;
    public
      constructor Create(RadioGroup: TRVOfficeRadioGroup);
      function Add: TOfficeGroupItem;
      {$IFDEF RICHVIEWDEF4}
      function Insert(Index: Integer): TOfficeGroupItem;
      {$ENDIF}
      property Items[Index: Integer]: TOfficeGroupItem read GetItem write SetItem; default;
  end;

  TRVOfficeRadioGroup = class(TCustomGroupBox)
    private
      FButtons: TList;
      FItems: TOfficeGroupItems;
      FItemIndex: Integer;
      FColumns: Integer;
      FReading: Boolean;
      FUpdating: Boolean;
      FMargin: Integer;
      FImages: TRVImageList;
      FDisabled3d: Boolean;
      FSelWidth: Integer;
      FTextAreaHeight: Integer;
      FSelColor: TColor;
      FTextPosition: TORBTextPosition;
      FOnCustomDraw: TORGCustomDrawEvent;
      FOnDblClickItem: TNotifyEvent;
      FSquare: Boolean;
      FUseXPThemes: Boolean;
      FTheme: HTheme;
      procedure ArrangeButtons;
      procedure ButtonClick(Sender: TObject);
      procedure SetItems(Value: TOfficeGroupItems);
      procedure UpdateButtons;
      procedure UpdateButtonsGlbl(Repaint: Boolean);
      procedure UpdateButton(Index: Integer);
      procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
      procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
      procedure WMSize(var Msg: TWMSize); message WM_SIZE;
      procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
      procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
      {$IFDEF USERVKSDEVTE}
      procedure SNMThemeMessage(var Msg: TMessage); message SNM_THEMEMESSAGE;
      {$ENDIF}
      procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED;
      procedure WMSetFocus(var Msg: TMessage); message WM_SETFOCUS;
      procedure CMDenySubclassing(var Msg: TMessage); message CM_DENYSUBCLASSING;
      procedure SetMargin(Value: Integer);
      procedure SetButtonCount(Value: Integer);
      procedure SetColumns(Value: Integer);
      procedure SetItemIndex(Value: Integer);
      procedure SetImages(Value: TRVImageList);
      procedure SetDisabled3d(Value: Boolean);
      procedure SetSelColor(Value: TColor);
      procedure SetSelWidth(Value: Integer);
      procedure SetTextAreaHeight(Value: Integer);
      procedure SetTextPosition(Value: TORBTextPosition);
      procedure DoCustomDraw(Sender: TRVOfficeRadioButton; Canvas: TCanvas; const ARect: TRect;
                 var DoDefault: Boolean);
      procedure SetCustomDraw(Value: TORGCustomDrawEvent);
      function GetAnother(Index: Integer; Key: Word): Integer;
      procedure SetSquare(const Value: Boolean);
      procedure SetUseXPThemes(const Value: Boolean);
      procedure PerformEraseBackground(DC: HDC; FullPainting: Boolean);
      procedure CreateThemeHandle;
      procedure FreeThemeHandle;
      function GetThemeState: Integer;
      function GetCaptionRect(DC: THandle): TRect;
    protected
      procedure Loaded; override;
      procedure ReadState(Reader: TReader); override;
      function CanModify: Boolean; virtual;
      procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
      procedure CreateWnd; override;
      procedure DestroyWnd; override;
      procedure Paint; override;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      {$IFDEF RICHVIEWDEF4}
      procedure FlipChildren(AllLevels: Boolean); override;
      {$ENDIF}
    published
      property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
      property Columns: Integer read FColumns write SetColumns default 1;
      property Items: TOfficeGroupItems read FItems write SetItems;
      property Margin: Integer read FMargin write SetMargin default 10;
      property Images: TRVImageList read FImages write SetImages;
      property SelColor: TColor read FSelColor write SetSelColor default clHighlight;
      property SelWidth: Integer read FSelWidth write SetSelWidth default 2;
      property TextAreaHeight: Integer read FTextAreaHeight write SetTextAreaHeight default 30;
      property Disabled3D: Boolean read FDisabled3d write SetDisabled3d default True;
      property TextPosition: TORBTextPosition read FTextPosition write SetTextPosition default orbtpBottom;
      property Square: Boolean read FSquare write SetSquare default False;
      property OnCustomDraw: TORGCustomDrawEvent read FOnCustomDraw write SetCustomDraw;
      property OnDblClickItem: TNotifyEvent read FOnDblClickItem write FOnDblClickItem;
      property UseXPThemes: Boolean read FUseXPThemes write SetUseXPThemes default True;
      property Align;
      {$IFDEF RICHVIEWDEF4}
      property Anchors;
      property BiDiMode;
      property DragKind;
      property Constraints;