qiswitchquad.pas

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

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

{$ifdef iVCL}unit  iSwitchQuad;{$endif}
{$ifdef iCLX}unit QiSwitchQuad;{$endif}

interface

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

type
  TiQuadState  = (iqsNone, iqsLeft, iqsTop, iqsRight, iqsBottom);

  TiSwitchQuad = class(TiCustomComponent)
  private
    FArrowKeyDown       : Boolean;
    FMouseDown          : Boolean;
    FShowFocusRect      : Boolean;
    FLeftRect           : TRect;
    FTopRect            : TRect;
    FRightRect          : TRect;                   
    FBottomRect         : TRect;
    FOnClickDown        : TNotifyEvent;
    FOnClickRight       : TNotifyEvent;
    FOnClickLeft        : TNotifyEvent;
    FOnClickUp          : TNotifyEvent;
    FRepeatInitialDelay : Integer;
    FRepeatInterval     : Integer;
    FIncrementX         : Double;
    FValueY             : Double;
    FValueX             : Double;
    FIncrementY         : Double;
    FOnValueYChange     : TNotifyEvent;
    FOnValueXChange     : TNotifyEvent;
    FOnValueYChangeUser : TNotifyEvent;
    FOnValueXChangeUser : TNotifyEvent;
    FUseArrowKeys       : Boolean;
    FUserGenerated      : Boolean;
    FQuadState          : TiQuadState;
  protected
    procedure SetShowFocusRect(const Value: Boolean);
    procedure SetValueX       (const Value: Double);
    procedure SetValueY       (const Value: Double);

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

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

    procedure iDoKillFocus; override;
    procedure iPaintTo(Canvas: TCanvas); override;

    procedure DoClickLeft;
    procedure DoClickRight;
    procedure DoClickUp;
    procedure DoClickDown;
    procedure DoValueXChange;
    procedure DoValueYChange;
    procedure DoQuadEvent;

    procedure TimerEvent(Sender : TObject);

    procedure CalcRects;
  public
    constructor Create(AOwner: TComponent);                       override;
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure   SetValueXNoEvent(const Value : Double);
    procedure   SetValueYNoEvent(const Value : Double);
  published
    property ShowFocusRect      : Boolean      read FShowFocusRect      write SetShowFocusRect    default True;
    property RepeatInitialDelay : Integer      read FRepeatInitialDelay write FRepeatInitialDelay default 500;
    property RepeatInterval     : Integer      read FRepeatInterval     write FRepeatInterval     default 50;
    property ValueX             : Double       read FValueX             write SetValueX;
    property ValueY             : Double       read FValueY             write SetValueY;
    property IncrementX         : Double       read FIncrementX         write FIncrementX;
    property IncrementY         : Double       read FIncrementY         write FIncrementY;
    property UseArrowKeys       : Boolean      read FUseArrowKeys       write FUseArrowKeys       default True;

    property OnClickLeft        : TNotifyEvent read FOnClickLeft        write FOnClickLeft;
    property OnClickUp          : TNotifyEvent read FOnClickUp          write FOnClickUp;
    property OnClickRight       : TNotifyEvent read FOnClickRight       write FOnClickRight;
    property OnClickDown        : TNotifyEvent read FOnClickDown        write FOnClickDown;
    property OnValueXChange     : TNotifyEvent read FOnValueXChange     write FOnValueXChange;
    property OnValueYChange     : TNotifyEvent read FOnValueYChange     write FOnValueYChange;
    property OnValueXChangeUser : TNotifyEvent read FOnValueXChangeUser write FOnValueXChangeUser;
    property OnValueYChangeUser : TNotifyEvent read FOnValueYChangeUser write FOnValueYChangeUser;

    property Enabled;
    property BackGroundColor;
    property TabOrder;
    property TabStop          default True;
    property Transparent;
    property Width            default 65;
    property Height           default 65;
  end;

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

  Width   := 65;
  Height  := 65;
  TabStop := True;

  FIncrementX         := 1;
  FIncrementY         := 1;

  FUseArrowKeys       := True;

  FShowFocusRect      := True;
  FRepeatInitialDelay := 500;
  FRepeatInterval     := 50;

  OnInternalTimer     := TimerEvent;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if AWidth  <> Width  then
    begin
      AHeight := AWidth;
      AWidth  := AWidth;
    end
  else if AHeight <> Height then
    begin
      AHeight := AHeight;
      AWidth  := AHeight;
    end;

  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetShowFocusRect(const Value: Boolean);begin SetBooleanProperty(Value,FShowFocusRect, irtInvalidate);end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetValueXNoEvent(const Value: Double);
var
  TempOnValueXChange : TNotifyEvent;
begin
  TempOnValueXChange := FOnValueXChange;
  FOnValueXChange    := nil;
  try
    SetValueX(Value);
  finally
    FOnValueXChange := TempOnValueXChange;
  end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetValueYNoEvent(const Value: Double);
var
  TempOnValueYChange : TNotifyEvent;
begin
  TempOnValueYChange := FOnValueYChange;
  FOnValueYChange    := nil;
  try
    SetValueY(Value);
  finally
    FOnValueYChange := TempOnValueYChange;
  end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetValueX(const Value: Double);
var
  CanEdit : Boolean;
begin
  if FValueX <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'ValueX', CanEdit);
      if CanEdit then
        begin
          FValueX := Value;
          DoValueXChange;
          {$ifdef iVCL}OPCOutputData('ValueX', FValueX);{$endif}
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.SetValueY(const Value: Double);
var
  CanEdit : Boolean;
begin
  if FValueY <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'ValueY', CanEdit);
      if CanEdit then
        begin
          FValueY := Value;
          DoValueYChange;
          {$ifdef iVCL}OPCOutputData('ValueY', FValueY);{$endif}
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  CalcRects;
  if Button = mbLeft then                      
    begin
      SetFocus;
      FMouseDown := True;

      if      PtInRect(FLeftRect,   Point(X,Y)) then FQuadState  := iqsLeft
      else if PtInRect(FTopRect,    Point(X,Y)) then FQuadState  := iqsTop
      else if PtInRect(FRightRect,  Point(X,Y)) then FQuadState  := iqsRight
      else if PtInRect(FBottomRect, Point(X,Y)) then FQuadState  := iqsBottom
      else                                           FQuadState  := iqsNone;

      if (FQuadState <> iqsNone) and (not FArrowKeyDown) then TimerStart(FRepeatInitialDelay, FRepeatInterval);
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDown then
    begin
      InvalidateChange;
      FMouseDown := False;
      TimerStop;

      if      FQuadState = iqsLeft   then begin if PtInRect(FLeftRect,  Point(X,Y)) then DoQuadEvent; end
      else if FQuadState = iqsRight  then begin if PtInRect(FRightRect, Point(X,Y)) then DoQuadEvent; end
      else if FQuadState = iqsTop    then begin if PtInRect(FTopRect,   Point(X,Y)) then DoQuadEvent; end
      else if FQuadState = iqsBottom then begin if PtInRect(FBottomRect,Point(X,Y)) then DoQuadEvent; end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.CalcRects;
begin
  FLeftRect   := Rect(0,                  Width div 3,     Width div 3, 2*(Width div 3));