qispinselector.pas

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

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

{$ifdef iVCL}unit  iSpinSelector;{$endif}
{$ifdef iCLX}unit QiSpinSelector;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} Menus,  iTypes,  iGPFunctions, iComponent,   iCustomComponent,  iComboBoxDisplay,  iEditorBasicComponents;{$ENDIF}
  {$IFDEF iCLX}QMenus, QiTypes, QiGPFunctions, QiComponent, QiCustomComponent, QiComboBoxDisplay, QiEditorBasicComponents;{$ENDIF}

type
  TiSpinItem = class(TObject)
  public
    Caption : String;
    Value   : Double;
  end;

  TiSpinSelector = class(TiCustomComponent)
  private
    FOldValue           : Double;
    FItemList           : TStringList;
    FItemIndex          : Integer;
    FOldItemIndex       : Integer;
    FFont               : TFont;
    FDoingAutoSize      : Boolean;
    FUserGenerated      : Boolean;

    FTimer              : TTimer;
    FFirstTimerMessage  : Boolean;

    FAutoSize           : Boolean;
    FColor              : TColor;

    FButtonRectUp       : TRect;
    FButtonRectDown     : TRect;
    FButtonrectDefault  : TRect;
    FMouseDownUp        : Boolean;
    FMouseDownDown      : Boolean;
    FMouseDownDefault   : Boolean;

    FMouseDownTime      : Double;
    FFastIncrement      : Integer;
    FFastSecondsDelay   : Double;

    FOnChange           : TNotifyEvent;
    FOnChangeUser       : TNotifyEvent;
    FOnBeforeUserChange : TOnBeforeChangeDouble;
    FOnBeforeChange     : TOnBeforeChangeDouble;
    FOnAutoSize         : TNotifyEvent;
    FRepeatInitialDelay : Integer;
    FRepeatInterval     : Integer;
    FDefaultValue       : Double;
  protected
    procedure SetFont     (const Value: TFont);
    procedure iSetAutoSize(const Value: Boolean);
    procedure SetColor    (const Value: TColor);
    procedure SetItemIndex(const Value: Integer);
    procedure SetValue    (const Value: Double);

    function GetValue     : Double;
    function GetItemCount : Integer;
    function GetItemIndex : Integer;
    function GetText      : String;

    procedure DefineProperties(Filer: TFiler); override;
    procedure WriteItems      (Writer: TWriter);
    procedure ReadItems       (Reader: TReader);
    function  DoWriteItems : Boolean;

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

    procedure iDoSetFocus;                                                          override;
    procedure iDoKillFocus;                                                         override;

    procedure TimerEvent(Sender: TObject);

    procedure iPaintTo(Canvas: TCanvas);                                            override;
    procedure DrawButton       (const Canvas: TCanvas; ARect: TRect; MouseDown, ArrowUp: Boolean);
    procedure DrawDefaultButton(const Canvas: TCanvas);

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

    {$ifdef iVCL}
    procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
    {$endif}

    procedure FontChange(Sender : TObject);

    procedure DoChange; virtual;
    procedure DoAutoSize;

    property OnAutoSize    : TNotifyEvent  read FOnAutoSize  write FOnAutoSize;

    procedure DoButtonUpClick;
    procedure DoButtonDownClick;
    procedure DoButtonDefaultClick;

    {$ifdef iVCL}procedure SetEnabled(      Value: Boolean); override;{$endif}
    {$ifdef iCLX}procedure SetEnabled(const Value: Boolean); override;{$endif}

    procedure SetItemIndexByValue  (Value: Double);
  public
    constructor Create(AOwner: TComponent);  override;
    destructor  Destroy;                     override;

    procedure AddItem(Caption: String; Value : Double); reintroduce;
    procedure RemoveAllItems;

    function GetItemCaption       (Index: Integer): String;
    function GetItemValue         (Index: Integer): Double;
    function GetItemCaptionByValue(Value: Double): String;

    procedure SetItemCaption(Index: Integer; Value: String);
    procedure SetItemValue  (Index: Integer; Value: Double);

    procedure SetItemIndexByCaption(Value: String);

    function GetMaxItemsWidth(Canvas: TCanvas): Integer;

    procedure AssignItems(SpinSelector: TiSpinSelector);

    property ItemCount          : Integer               read GetItemCount;
    property Text               : String                read GetText;
  published
    property ItemIndex          : Integer               read GetItemIndex        write SetItemIndex;
    property Value              : Double                read GetValue            write SetValue;
    property AutoSize           : Boolean               read FAutoSize           write iSetAutoSize       default True;
    property Font               : TFont                 read FFont               write SetFont;

    property RepeatInitialDelay : Integer               read FRepeatInitialDelay write FRepeatInitialDelay default 500;
    property RepeatInterval     : Integer               read FRepeatInterval     write FRepeatInterval     default 50;

    property FastIncrement      : Integer               read FFastIncrement      write FFastIncrement;
    property FastSecondsDelay   : Double                read FFastSecondsDelay   write FFastSecondsDelay;

    property DefaultValue       : Double                read FDefaultValue       write FDefaultValue;

    property OnChange           : TNotifyEvent          read FOnChange           write FOnChange;
    property OnChangeUser       : TNotifyEvent          read FOnChangeUser       write FOnChangeUser;
    property OnBeforeChange     : TOnBeforeChangeDouble read FOnBeforeChange     write FOnBeforeChange;
    property OnBeforeUserChange : TOnBeforeChangeDouble read FOnBeforeUserChange write FOnBeforeUserChange;

    property Width        default 145;
    property Height       default 21;
    property TabStop      default True;
    property TabOrder;

    property BackGroundColor;

    property ErrorActive;
    property ErrorText;
    property ErrorFont;
    property ErrorBackGroundColor;
  end;

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

  Width           := 145;
  Height          := 21;
  TabStop         := True;
  BorderStyle     := ibsLowered;
  BackGroundColor := clBlack;

  FColor              := clWindow;
  FOldValue           := -1;
  FAutoSize           := True;
  FItemIndex          := -1;

  FFastIncrement      := 0;
  FFastSecondsDelay   := 2;

  FItemList           := TStringList.Create;
  FFont               := TFont.Create;
  Font.Color          := clLime;
  FFont.Style         := [fsBold];
  Font.OnChange       := FontChange;

  FRepeatInitialDelay := 500;
  FRepeatInterval     := 50;

  FTimer              := TTimer.Create(Self);
  FTimer.Enabled      := False;
  FTimer.OnTimer      := TimerEvent;
end;
//****************************************************************************************************************************************************
destructor TiSpinSelector.Destroy;
begin
  RemoveAllItems;
  FItemList.Free;
  FFont.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DoChange;
var
  NewValue  : Double;
  CanChange : Boolean;
begin
  if csLoading in ComponentState then Exit;

  NewValue := GetValue;
  CanChange := True;

  if                       Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Value',             CanChange);
  if UserGenerated then if Assigned(FOnBeforeUserChange)    then FOnBeforeUserChange   (Self, FOldValue, NewValue, CanChange);
                        if Assigned(FOnBeforeChange)        then FOnBeforeChange       (Self, FOldValue, NewValue, CanChange);

  if not CanChange then
    begin
      FItemIndex := FOldItemIndex;
      InvalidateChange;
      Exit;
    end;

  {$ifdef iVCL}
  if OPCOutputData('Value', NewValue) then
    begin
      FItemIndex := FOldItemIndex;
      InvalidateChange;
      Exit;
    end;
  {$ENDIF}

  FOldValue := NewValue;

  if not(csLoading in ComponentState) then
    begin
      if                        Assigned(OnChangeProtected)   then OnChangeProtected (Self, 'Value');
      if                        Assigned(FOnChange)           then FOnChange         (Self);
      if UserGenerated then  if Assigned(FOnChangeUser)       then FOnChangeUser     (Self);
      if UserGenerated then  if (Owner is TiCustomEditorForm) then (Owner as TiCustomEditorForm).UserChange;

    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.FontChange(Sender : TObject);
begin
  DoAutoSize;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetColor(const Value: TColor);begin SetColorProperty(Value, FColor, irtInvalidate);end;
procedure TiSpinSelector.SetFont (const Value: TFont );begin FFont.Assign(Value);                           end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DrawDefaultButton(const Canvas: TCanvas);
const
  Size = 4;
var
  APoint : TPoint;
begin
  with Canvas, FButtonrectDefault do
    begin
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;

      FillRect(FButtonrectDefault);

      if FMouseDownDefault then                                                
        iDrawEdge(Canvas, FButtonrectDefault, idesSunken)
      else
        iDrawEdge(Canvas, FButtonrectDefault, idesRaised);

      Pen.Style   := psClear;           
      Brush.Color := clBlack;
      Brush.Style := bsSolid;

      APoint := GetRectCenterPoint(FButtonrectDefault);

      Ellipse(APoint.X -Size, APoint.Y - Size, APoint.X + Size, APoint.Y + Size);
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DrawButton(const Canvas: TCanvas; ARect: TRect; MouseDown, ArrowUp: Boolean);
const
  Length = 2;
var
  CenterPoint : TPoint;
begin
  with Canvas, ARect do
    begin
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;

      FillRect(ARect);

      if MouseDown then
        iDrawEdge(Canvas, ARect, idesSunken)
      else
        iDrawEdge(Canvas, ARect, idesRaised);

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

      CenterPoint := GetRectCenterPoint(ARect);

      if ArrowUp then
        begin
          Canvas.Polygon([Point(CenterPoint.X - 3, CenterPoint.Y + 1),
                          Point(CenterPoint.X + 3, CenterPoint.Y + 1),
                          Point(CenterPoint.X    , CenterPoint.Y - 2)]);
        end
      else
        begin
          Canvas.Polygon([Point(CenterPoint.X - 3, CenterPoint.Y - 2),
                          Point(CenterPoint.X + 3, CenterPoint.Y - 2),
                          Point(CenterPoint.X    , CenterPoint.Y + 1)]);
        end
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iPaintTo(Canvas: TCanvas);
var
  AText         : String;
  ATextRect     : TRect;
  ATextFlags    : TiTextFlags;
  BorderMargin  : Integer;
begin
  with Canvas do
    begin
      FButtonrectDefault.Top    := 2;
      FButtonrectDefault.Bottom := Height - 2;
      FButtonrectDefault.Right  := Width - 2;
      FButtonrectDefault.Left   := FButtonrectDefault.Right - 14;

      FButtonRectUp.Top         := 2;
      FButtonRectUp.Bottom      := Height div 2;
      FButtonRectUp.Right       := FButtonrectDefault.Left;
      FButtonRectUp.Left        := FButtonRectUp.Right - 15;

      FButtonRectDown.Top       := Height div 2;
      FButtonRectDown.Bottom    := Height -2;
      FButtonRectDown.Right     := FButtonRectUp.Right;
      FButtonRectDown.Left      := FButtonRectUp.Left;

      if ErrorActive then
           DrawBackGround(Canvas, ErrorBackGroundColor)
      else DrawBackGround(Canvas, BackGroundColor);

      DrawBorder    (Canvas);
      BorderMargin := GetBorderMargin;

      ATextRect.Top        :=                      (2 + BorderMargin);
      ATextRect.Bottom     := Height -             (2 + BorderMargin);

      ATextRect.Left       :=                      (2 + BorderMargin);
      ATextRect.Right      := FButtonRectUp.Left - (2);

      ATextFlags := [itfHRight, itfVCenter, itfSingleLine];

      OffsetRect(ATextRect, -3, 0);

      if Enabled then
        begin
          if ErrorActive then
            begin
              Font.Assign(ErrorFont);
              AText := ErrorText;
              iDrawText(Canvas, AText, ATextRect, ATextFlags);
            end
          else
            begin
              Font.Assign(FFont);
              if (ItemIndex >= 0) and (ItemIndex < FItemList.Count) then AText := (FItemList.Objects[ItemIndex] as TiSpinItem).Caption else AText := '';

              iDrawText(Canvas, AText, ATextRect, ATextFlags);
            end;
        end;

      DrawButton(Canvas, FButtonRectUp,   FMouseDownUp,   True);
      DrawButton(Canvas, FButtonRectDown, FMouseDownDown, False);
      DrawDefaultButton(Canvas);