wwradiobutton.pas

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

{
//
// Components : TwwCustomRadioButton
//
// Copyright (c) 2001 by Woll2Woll Software
//
// 8/6/2001-  Support radiobuttons font settings.
// 9/19/2001- Radiobuttons in grid when dgAlwaysShowEditor is False and grid is still focused will have
//            their text painted black instead of the highlight text color. This corrects that problem.
}
unit wwradiobutton;

interface
         
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, wwframe, grids, wwcommon, imglist;

{$i wwIfDef.pas}

type
  TwwWinButtonIndents=class(TPersistent)
  private
    FWinControl: TWinControl;
    FIndentBX: integer;
    FIndentBY: integer;
    FIndentTX: integer;
    FIndentTY: integer;
    procedure SetIndentBX(Value: integer);
    procedure SetIndentBY(Value: integer);
    procedure SetIndentTX(Value: integer);
    procedure SetIndentTY(Value: integer);
  protected
    procedure Repaint(FWinControl: TWinControl); virtual;
  public
    constructor Create(AOwner: TComponent);
    Procedure Assign(Source: TPersistent); override;
  published
    property ButtonX: integer read FIndentBX write SetIndentBX default 0;
    property ButtonY: integer read FIndentBY write SetIndentBY default 0;
    property TextX: integer read FIndentTX write SetIndentTX default 0;
    property TextY: integer read FIndentTY write SetIndentTY default 0;
  end;

  TwwTransparentRegion = (wwtrBorder, wwtrText, wwtrIcon);
  TwwTransparentRegions = Set of TwwTransparentRegion;
  TwwCustomRadioButton = class(TRadioButton)
  private
    FCanvas: TControlCanvas;
    FFrame: TwwEditFrame;
//    FIndentX: integer;
//    FIndentY: integer;
//    FIndentTextX: integer;
//    FIndentTextY: integer;
    FIndents: TwwWinButtonIndents;

    FAlwaysTransparent: boolean;
    FValueChecked: string;
    FValueUnchecked: string;
    FShowFocusRect: boolean;
    SpaceKeyPressed: boolean;
    FImages: TCustomImageList;
    FGlyphImages: TCustomImageList;
    FWordWrap: boolean;

    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;

    function isTransparentEffective: boolean;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct); virtual;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure BMSetCheck(var Message: TMessage); message BM_SETCHECK;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;

    { Private declarations }
{    procedure SetIndentX(Value: integer);
    procedure SetIndentY(Value: integer);
    procedure SetIndentTextX(Value: integer);
    procedure SetIndentTextY(Value: integer);}
    Function IsMouseInControl: boolean;
  protected
    function GetShowText: boolean; virtual;
    procedure TransparentInvalidate(Regions: TwwTransparentRegions);
    function GetPaintCopyTextColor: TColor; virtual;
    function GetLastBrushColor: TColor; virtual;
    function GetButtonIndex: integer; virtual;
    Function GetEffectiveChecked: boolean; virtual;
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; virtual;
    procedure PaintBorder;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure ComputeImageRect(var DrawRect: TRect); virtual;
    procedure ComputeTextRect(var DrawRect: TRect); virtual;
    procedure ComputeGlyphRect(var DrawRect: TRect); virtual;
    procedure Notification(AComponent: TComponent;
             Operation: TOperation); override;
    Function GetCanvas: TCanvas; virtual;
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
    procedure SetChecked(Value: Boolean); override;

//    procedure PaintButton; virtual;
    { Protected declarations }
  public
    destructor Destroy; override;
    constructor Create(AOwner: TComponent); override;
    property Canvas: TCanvas read GetCanvas;
    property Frame: TwwEditFrame read FFrame write FFrame;
  published
    property AlwaysTransparent: boolean read FAlwaysTransparent write FAlwaysTransparent;
    property Indents: TwwWinButtonIndents read FIndents write FIndents;
//    property IndentRadioButtonX: integer read FIndentX write SetIndentX;
//    property IndentRadioButtonY: integer read FIndentY write SetIndentY;
//    property IndentTextX: integer read FIndentTextX write SetIndentTextX;
//    property IndentTextY: integer read FIndentTextY write SetIndentTextY;
    property ValueChecked: string read FValueChecked write FValueChecked;
    property ValueUnchecked: string read FValueUnchecked write FValueUnchecked;
    property ShowFocusRect: boolean read FShowFocusRect write FShowFocusRect default true;
    property Images: TCustomImageList read FImages write FImages;
    property GlyphImages: TCustomImageList read FGlyphImages write FGlyphImages;

    property Action;
    property Alignment;
//    property AllowGrayed;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
//    property State;
    property TabOrder;
    property TabStop;
    property Visible;
    property WordWrap: boolean read FWordWrap write FWordWrap default False;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnStartDock;
    property OnStartDrag;
    { Published declarations }
  end;

TwwRadioButton=class(TwwCustomRadioButton)
published
    property Action;
    property Alignment;
    property AlwaysTransparent;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Checked;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Frame;
    property Images;
    property Indents;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowFocusRect;
    property TabOrder;
    property TabStop default False;
    property ValueChecked;
    property ValueUnchecked;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnStartDock;
    property OnStartDrag;
end;


implementation

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

procedure TwwCustomRadioButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and CanFocus then
    begin
      SetFocus;
      if Focused then
         Checked := True;
      Result := 1;
    end else
      inherited;
end;

procedure TwwCustomRadioButton.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TwwCustomRadioButton.WMPaint(var Message: TWMPaint);
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;
begin
  inherited;
  PaintBorder;

  if csPaintCopy in ControlState then
  begin
    CanvasNeeded;
    FCanvas.Handle := Message.dc;
    Paint;
    FCanvas.Handle := 0;
  end;
end;

procedure TwwCustomRadioButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;
begin
  CanvasNeeded;
  FCanvas.Handle := DrawItemStruct.hDC;
  Paint;
  PaintBorder;
  FCanvas.Handle := 0;
end;

procedure TwwCustomRadioButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
{$ifdef wwUseThemeManager}
var r: TRect;
{$endif}
begin
  if IsInwwObjectViewPaint(parent) or IsInwwGridPaint(parent) or
    ((IsTransparentEffective and (not Focused)) or AlwaysTransparent) then
  begin
     if not (csDesigning in ComponentState) then Message.result:= 1
     else inherited;
  end
  else if wwUseThemes(parent) then
  begin
    {$ifdef wwUseThemeManager}
    if (parent is TCustomGrid) then
    begin
       r:= ClientRect;
       if (FCanvas<>nil) then
       begin
          FCanvas.Brush.Color:= Color;
          Windows.FillRect(message.dc, r, FCanvas.brush.handle );
       end;
       message.result:=1
    end
    else begin
      { Get the parent to draw its background into the control's background. }
      ThemeServices.DrawParentBackground(Handle, Message.DC, nil, False);
      message.result:=1;
    end
    {$endif}
  end
  else inherited;

//  if Frame.enabled and not (csDesigning in ComponentState) then
//      message.result:=1
//   else inherited;
end;

procedure TwwCustomRadioButton.CreateParams(var Params: TCreateParams);
const
  Alignments: array[Boolean, TLeftRight] of DWORD =
    ((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
begin
   inherited;
   CreateSubClass(Params, 'BUTTON');
   if IsTransparentEffective then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;  // For transparency
   with Params do begin
     Style:= Style and not BS_3STATE;
     Style := Style or BS_ownerdraw;
     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
   end;
end;

Function TwwCustomRadioButton.GetEffectiveChecked: boolean;
begin
  result:= Checked;
end;

procedure TwwCustomRadioButton.CreateWnd;
  procedure DisableParentClipping;
  begin
     SetWindowLong(GetParent(Handle), GWL_STYLE,
      GetWindowLong(GetParent(Handle), GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
begin
   inherited;
   if IsTransparentEffective then
   begin
     DisableParentClipping;
   end;
end;

destructor TwwCustomRadioButton.Destroy;
begin
   FIndents.Free;
   FCanvas.Free;
   FFrame.Free;
   inherited;
end;

procedure TwwCustomRadioButton.Paint;
var
    r: TRect;
    IsInGrid: boolean;
//    rg: TwwRadioGroup;
    {$ifdef wwUseThemeManager}
    function GetRadioButtonThemeStyle(Pressed: boolean): TThemedButton;
    begin
         if not Enabled then
         begin