wwradiogroup.pas

胜天进销存源码,国产优秀的进销存

unit wwradiogroup;
{
//
// Components : TwwRadioGroup
//
// Copyright (c) 2001 by Woll2Woll Software
//
// 8/7/01 - Avoid Idx out of range related to itemindex<>0 for bound control
// 10/01/2001 - Correct typo that caused itemindex not to get stored in unbound case.
// 5/17/2002-Don't call inherited. This can cause a popupmenu item to fire in grid.
// 7/30/04 - Fix return probelm outside grid as this code should only be for grid
}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, wwframe, dbctrls, db, wwradiobutton, wwclearbuttongroup,
  grids, imglist, wwdbgrid, wwintl;

{$i wwIfDef.pas}

type
  TwwCustomRadioGroup=class;
  TwwCreateRadioButton = procedure (
    Sender: TwwCustomRadioGroup;
    RadioButton: TwwRadioButton) of object;

  TwwRGEditFrame = class(TwwEditFrame)  // Change defaults
  published
     property FocusBorders default [];
     property NonFocusBorders default [];
  end;
  TwwRGWinButtonIndents=class(TwwWinButtonIndents)
  protected
    procedure Repaint(FWinControl: TWinControl); override;
  end;

  TwwCustomRadioGroup = class(TwwCustomTransparentGroupBox)
  private
    FOnCreateRadioButton: TwwCreateRadioButton;
    FIndents: TwwWinButtonIndents;
    FFrame: TwwEditFrame;
    FButtonFrame: TwwRGEditFrame;
    FItems: TStrings;
    FItemIndex: Integer;
    FColumns: Integer;
    FReading: Boolean;
    FUpdating: Boolean;
    FShowBorder: boolean;
    FShowGroupCaption: boolean;
    FShowFocusRect: boolean;
    FTransparentActiveItem: boolean;
    FImages: TCustomImageList;
    FGlyphImages: TCustomImageList;
    FButtons: TList;
    PaintCopyTextColor: TColor;
    FShowText: boolean;
    FFocused: boolean;
    SkipSetChildFocus: boolean;
    FWordWrap: boolean;
    FAlignment: TLeftRight;
    FNoSpacing: boolean;
    FAnyClickToggles: boolean;
    FDisableThemes: boolean;
    FController: TwwController;
    FArrowsModifySelection: boolean;

    procedure SetController(Value: TwwController);
    procedure ArrangeButtons;
    procedure ButtonClick(Sender: TObject);
    procedure ItemsChange(Sender: TObject);
    procedure SetButtonCount(Value: Integer);
    procedure SetColumns(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure SetItems(Value: TStrings);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    function StoreItemIndex: boolean; virtual;
    function IsTransparent: boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoCreateRadioButton(RadioButton: TwwRadioButton); virtual;
    procedure SetParent(AParent: TWinControl); override;
    procedure Paint; override;
    procedure Loaded; override;
    procedure ReadState(Reader: TReader); override;
    function CanModify: Boolean; virtual;
    function HaveBorder: boolean; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    property Columns: Integer read FColumns write SetColumns default 1;
    property ItemIndex: Integer read FItemIndex write SetItemIndex stored StoreItemIndex default -1;
    property Items: TStrings read FItems write SetItems;
  public
    LastBrushColor: TColor;
    InCNKeyDown: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure FlipChildren(AllLevels: Boolean); override;
    procedure UpdateButtons;
    property Controller : TwwController read FController write SetController;
    property ButtonFrame: TwwRGEditFrame read FButtonFrame write FButtonFrame;
    property Frame: TwwEditFrame read FFrame write FFrame;
    property ShowBorder : boolean read FShowBorder write FShowBorder default True;
    property ShowGroupCaption : boolean read FShowGroupCaption write FShowGroupCaption default True;
    property ShowFocusRect: boolean read FShowFocusRect write FShowFocusRect default true;
    property TransparentActiveItem: boolean read FTransparentActiveItem write FTransparentActiveItem default False;
    property Images: TCustomImageList read FImages write FImages;
    property GlyphImages: TCustomImageList read FGlyphImages write FGlyphImages;
    property Indents: TwwWinButtonIndents read FIndents write FIndents;
    property OnCreateRadioButton: TwwCreateRadioButton read FOnCreateRadioButton write FOnCreateRadioButton;
    property ShowText: boolean read FShowText write FShowText default True;
    property WordWrap: boolean read FWordWrap write FWordWrap default False;
    property Alignment: TLeftRight read FAlignment write FAlignment default taRightJustify;
    property NoSpacing: boolean read FNoSpacing write FNoSpacing default False;
    property AnyClickToggles: boolean read FAnyClickToggles write FAnyClickToggles;
    property ArrowsModifySelection: boolean read FArrowsModifySelection write FArrowsModifySelection default false;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes;
//    property Buttons : TList read FButtons;
  end;

  TwRadioGroup = class(TwwCustomRadioGroup)
  published
    property Align;
    property Anchors;
//    property AnyClickToggles; // Undocumented currently, so not published
    property BiDiMode;
    property Caption;
    property Color;
    property Columns;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ButtonFrame;
    property ItemIndex;
    property Items;
    property Constraints;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowBorder;
    property ShowGroupCaption;
    property TabOrder;
    property TabStop default True;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
  end;

  TwwRadioGroup = class(TwwCustomRadioGroup)
  private
    FDataLink: TFieldDataLink;
    FValue: string;
    FValues: TStrings;
    FInSetValue: Boolean;
    FOnChange: TNotifyEvent;
    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetValue(const Value: string);
    procedure SetItems(Value: TStrings);
    procedure SetValues(Value: TStrings);
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure SetColor(Value: TColor);
    Function GetColor: TColor;
    function IsColorStored: Boolean;
  protected
    function StoreItemIndex: boolean; override; //8/7/01
    procedure Paint; override;
    procedure Change; dynamic;
    procedure Click; override;
    procedure KeyPress(var Key: Char); override;
    function CanModify: Boolean; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    property DataLink: TFieldDataLink read FDataLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
    property Value: string read FValue write SetValue;
    function GetButtonValue(Index: Integer): string;
    Function GetDisplayValue(const Value: string): string;
  published
    property Controller;
    property DisableThemes;
    property ItemIndex;
    property TransparentActiveItem;
    property Frame;
    property ButtonFrame;
    property Indents;
    property Images;
    property GlyphImages;
    property ShowBorder;
    property ShowGroupCaption;
    property ShowFocusRect;
    property Transparent;
    property ShowText;
    property NoSpacing;

    property ArrowsModifySelection;
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;

    // No clWindow default for this control as it makes clWindow ignored
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Columns;
    property Constraints;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Items write SetItems;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property WordWrap;
    property Alignment;
    property Values: TStrings read FValues write SetValues;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
    property OnCreateRadioButton;
  end;

implementation

uses
   {$ifdef wwDelphi7Up}
   themes,
   {$endif}
   {$ifdef ThemeManager}
   thememgr, themesrv, uxtheme,
   {$endif}
   wwcommon;

{ TGroupButton }

type
  TGroupButton = class(TwwRadioButton)
  private
    FInClick: Boolean;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  protected
    function GetShowText: boolean; override;
    Function GetEffectiveChecked: boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function GetButtonIndex: integer; override;
    function GetLastBrushColor: TColor; override;
    function GetPaintCopyTextColor: TColor; override;
  public
    constructor InternalCreate(RadioGroup: TwwCustomRadioGroup);
    destructor Destroy; override;
  end;

constructor TGroupButton.InternalCreate(RadioGroup: TwwCustomRadioGroup);
begin
  inherited Create(RadioGroup);
  RadioGroup.FButtons.Add(Self);
  Visible := False;
  Enabled := RadioGroup.Enabled;
  ParentShowHint := False;
  OnClick := RadioGroup.ButtonClick;
  Parent := RadioGroup;
end;

destructor TGroupButton.Destroy;
begin
  TwwCustomRadioGroup(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;

Function TGroupButton.GetEffectiveChecked: boolean;
var i: integer;
begin
   result:= Checked;
   if (csPaintCopy in ControlState) then
   begin
     if Owner is TwwRadioGroup then
       with TwwRadioGroup(Owner) do begin
          if not DataLink.Active or (DataLink.Field=nil) then exit;
          
          for i:= 0 to FButtons.count-1 do
            if FButtons[i]=self then
            begin
               result := DataLink.Field.Text = GetButtonValue(i);
               break;
            end
       end
   end;
end;

procedure TwwCustomRadioGroup.WMPaint(var Message: TWMPaint);
begin
  PaintCopyTextColor:= clNone;
  if IsInGridPaint(self) and (message.dc<>0) then
  begin
     PaintCopyTextColor:= GetTextColor(message.dc);
  end;
  inherited;
end;

procedure TGroupButton.WMPaint(var Message: TWMPaint);
begin
   inherited;
end;

procedure TGroupButton.CNCommand(var Message: TWMCommand);
begin
  if not FInClick then
  begin
    FInClick := True;
    try
      if ((Message.NotifyCode = BN_CLICKED) or
        (Message.NotifyCode = BN_DOUBLECLICKED)) and
        TwwCustomRadioGroup(Parent).CanModify then
        inherited;
    except
      Application.HandleException(Self);
    end;
    FInClick := False;
  end;
end;

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


function TGroupButton.GetButtonIndex: integer;
var i: integer;
begin
  result:=0;
  with TwwCustomRadioGroup(Owner) do begin
     for I := 0 to FButtons.Count - 1 do begin
         if FButtons[i]=self then begin
            result:=i;
            break;
         end
     end
  end
end;

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

{ TCustomRadioGroup }

// Allow radiogroup embedded in grid to cycle through and exit if at ends
procedure TGroupButton.CNKeyDown(var Message: TWMKeyDown);
var key: integer;
  procedure SendToParent;
  begin
    with TwwCustomRadioGroup(parent) do
    begin
       if not wwIsClass(parent.classtype, 'TwwDBGrid') then exit;
       Parent.setFocus;

      { If grid does not have focus then SetFocus raised exception }
      if Parent.focused then  { 7/2/98 }
         PostMessage(parent.handle, WM_KEYDOWN, message.charcode, 0);
      message.charcode := 0;
    end
  end;

begin
  key:= message.charcode;

  if (key = VK_TAB) then // On tab should go to parent form's next/prev control
  begin
     // Set focus back to radiogroup so tabbing and shift-tabbing work fine
     TwwCustomRadioGroup(parent).SkipSetChildFocus:= True;
     try
        Parent.SetFocus;
     finally
        TwwCustomRadioGroup(parent).SkipSetChildFocus:= False;
     end;
  end;

  if (key in [vk_up, vk_down, vk_left, vk_right]) then
  with TwwCustomRadioGroup(parent) do