iradiogroup.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiRadioGroup Component                          }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iRadioGroup;{$endif}
{$ifdef iCLX}unit QiRadioGroup;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iMath,  iCustomComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiMath, QiCustomComponent;{$ENDIF}

type
  TiRadioGroup = class(TiCustomComponent)
  private
    FMouseDown       : Boolean;
    FMouseDownIndex  : Integer;
    FKeyDown         : Boolean;
    FUserGenerated   : Boolean;

    FItemsRowStart   : Integer;
    FItemsRowSpacing : Double;
    FItemsColStart   : Integer;
    FItemsColSpacing : Double;
    FMaxRows         : Integer;

    FCaption         : String;
    FOnChange        : TNotifyEvent;
    FOnChangeUser    : TNotifyEvent;
    FFont            : TFont;
    FItems           : TStrings;
    FItemIndex       : Integer;
    FColumns         : Integer;
  protected
    procedure SetCaption  (const Value: String);
    procedure SetFont     (const Value: TFont);
    procedure SetItems    (const Value: TStrings);
    procedure SetItemIndex(const Value: Integer);
    procedure SetColumns  (const Value: Integer);

    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove(                      Shift: TShiftState; X, Y: Integer); override;

    procedure iKeyUp  (var CharCode: Word; Shift: TShiftState);                    override;
    procedure iKeyDown(var CharCode: Word; Shift: TShiftState);                    override;

    procedure iWantSpecialKey(var CharCode: Word; var Result: Integer);            override;

    procedure iDoSetFocus;                                                         override;
    procedure iDoKillFocus;                                                        override;

    procedure SubObjectChange(Sender: TObject);

    function GetMouseItemIndex(X, Y: Integer): Integer;

    procedure DoChange; virtual;

    procedure iPaintTo(Canvas: TCanvas);    override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;
  published
    property Width  default 97;
    property Height default 17;

    property Caption      : String       read FCaption       write SetCaption;
    property Font         : TFont        read FFont          write SetFont;

    property Items        : TStrings     read FItems         write SetItems;
    property ItemIndex    : Integer      read FItemIndex     write SetItemIndex;

    property Columns      : Integer      read FColumns       write SetColumns     default 1;

    property OnChange     : TNotifyEvent read FOnChange      write FOnChange;
    property OnChangeUser : TNotifyEvent read FOnChangeUser  write FOnChangeUser;

    property BackGroundColor;
    property TabOrder;
    property TabStop              default True;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  TabStop := True;

  FCaption   := 'Radio Group';
  Width      := 97;
  Height     := 17;

  FColumns   := 1;

  FFont := TFont.Create;
  FFont.OnChange := SubObjectChange;

  FItems := TStringList.Create;
  (FItems as TStringList).OnChange := SubObjectChange;
end;
//****************************************************************************************************************************************************
destructor TiRadioGroup.Destroy;
begin
  FFont.Free;
  FItems.Free;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiRadioGroup.DoChange;
begin
  if not Loading then
    begin
      if                        Assigned(OnChangeProtected) then OnChangeProtected(Self, 'ItemIndex');
      if                        Assigned(FOnChange)         then FOnChange        (Self);
      if FUserGenerated then if Assigned(FOnChangeUser)     then FOnChangeUser    (Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SetCaption(const Value: String);
begin
  if FCaption <> Value then
    begin
      FCaption := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iPaintTo(Canvas: TCanvas);
var
  x           : Integer;
  ABoxRect    : TRect;
  ATextRect   : TRect;
  AText       : String;
  TitleHeight : Integer;
  TitleLeft   : Integer;
  BoxTop      : Integer;
  ItemCenterX : Integer;
  ItemCenterY : Integer;
  ShowFocus   : Boolean;
begin
  DrawBackGround(Canvas, BackGroundColor);

  with Canvas do
    begin
      Font.Assign(FFont);
      Brush.Style := bsSolid;

      TitleLeft    := TextWidth ('A');
      TitleHeight  := TextHeight('ABC');
      BoxTop       := TitleHeight div 2;

      Brush.Color := BackGroundColor;
      FillRect(ABoxRect);

      iDrawEdge(Canvas, ABoxRect, idesSunken);
                                                                            
      Pen.Color := clBtnHighlight;
      PolyLine([Point(1,       BoxTop+1), Point(Width-2, BoxTop+1)]);
      PolyLine([Point(1,       BoxTop+1), Point(1,       Height-1)]);

      Pen.Color := clBtnShadow;
      PolyLine([Point(0, BoxTop), Point(Width-2, BoxTop), Point(Width-2, Height-2), Point(0, Height-2), Point(0, BoxTop)]);

      Pen.Color := clBtnHighlight;
      //PolyLine([Point(1,       BoxTop+1), Point(Width-2, BoxTop+1)]);
      PolyLine([Point(Width-1, BoxTop+1), Point(Width-1, Height-1)]);
      PolyLine([Point(Width-1, Height-1), Point(0,       Height-1)]);

      Brush.Color := BackGroundColor;
      Brush.Style := bsSolid;

      ATextRect := Rect(TitleLeft, 0, TitleLeft + TextWidth(FCaption), TextHeight(FCaption));
      FillRect(ATextRect);
      iDrawText(Canvas, FCaption, ATextRect, [itfHLeft, itfVCenter]);

      if FItems.Count > 0 then
        begin
          FMaxRows          := (FItems.Count div FColumns) + 1*ord((FItems.Count mod FColumns) <> 0);
          FItemsRowSpacing := (Height - TitleHeight - TitleHeight div 4) div FMaxRows;
          FItemsRowStart   :=  Round(TitleHeight + FItemsRowSpacing/2);

          FItemsColStart   := 14;
          FItemsColSpacing := (Width - 14) div FColumns;

          for x := 0 to FItems.Count-1 do
            begin
              ItemCenterY := FItemsRowStart + Round((x mod FMaxRows)*FItemsRowSpacing);
              ItemCenterX := FItemsColStart + Round((x div FMaxRows)*FItemsColSpacing);
              AText       := FItems.Strings[x];

              Brush.Style := bsSolid;
              Pen.Style   := psSolid;

              if (FMouseDown or FKeyDown) and (x = FMouseDownIndex) then
                begin
                  Brush.Color := clBtnFace;
                  Pen.Color   := clBtnFace;
                end
              else
                begin
                  Brush.Color := clWhite;
                  Pen.Color   := clWhite;
                end;

              Rectangle(ItemCenterX - 3, ItemCenterY - 4, ItemCenterX + 5, ItemCenterY + 4);

              Pen.Color := cl3DDkShadow;
              PolyLine([Point(ItemCenterX-4, ItemCenterY-2), Point(ItemCenterX-4, ItemCenterY+2)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY+2), Point(ItemCenterX-3, ItemCenterY+3)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY-3), Point(ItemCenterX-3, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY-4), Point(ItemCenterX-1, ItemCenterY-4)]);
              PolyLine([Point(ItemCenterX-1, ItemCenterY-5), Point(ItemCenterX+3, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX+3, ItemCenterY-4), Point(ItemCenterX+5, ItemCenterY-4)]);