qiswitchquad.pas

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

  FRightRect  := Rect(2*(Width div 3),    Width div 3,     Width,       2*(Width div 3));
  FTopRect    := Rect(Width div 3,     0,               2*(Width div 3),   Width div 3);
  FBottomRect := Rect(Width div 3,     2*(Width div 3), 2*(Width div 3),   Width);
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iPaintTo(Canvas: TCanvas);
var
  Point1 : TPoint;
  Point2 : TPoint;
  Point3 : TPoint;
begin
  CalcRects;
  with Canvas do
    begin
      DrawBackGround(Canvas, BackGroundColor);

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

      with FTopRect do
        begin
          Point1 := Point(Left, Bottom);
          Point2 := Point((Left + Right) div 2, Top);
          Point3 := Point(Right, Bottom);

          Polygon([Point1, Point2, Point3]);

          if (FQuadState = iqsTop) and (FMouseDown or FArrowKeyDown) then
            begin
              Pen.Color := clBlack; PolyLine([Point1, Point2]);
              Pen.Color := clWhite; PolyLine([Point2, Point3]);
              Pen.Color := clWhite; PolyLine([Point3, Point1]);
            end
          else
            begin
              Pen.Color := clWhite; PolyLine([Point1, Point2]);
              Pen.Color := clBlack; PolyLine([Point2, Point3]);
              Pen.Color := clBlack; PolyLine([Point3, Point1]);
            end;
        end;

      with FLeftRect do
        begin
          Point1 := Point(Left, (Top + Bottom) div 2);
          Point2 := Point(Right, Top);
          Point3 := Point(Right, Bottom);

          Polygon([Point1, Point2, Point3]);

          if (FQuadState = iqsLeft) and (FMouseDown or FArrowKeyDown) then
            begin
              Pen.Color := clBlack; PolyLine([Point1, Point2]);
              Pen.Color := clWhite; PolyLine([Point2, Point3]);
              Pen.Color := clWhite; PolyLine([Point3, Point1]);
            end
          else
            begin
              Pen.Color := clWhite; PolyLine([Point1, Point2]);
              Pen.Color := clBlack; PolyLine([Point2, Point3]);
              Pen.Color := clGray;  PolyLine([Point3, Point1]);
            end;
         end;

      with FRightRect do
        begin
          Point1 := Point(Left, Top);
          Point2 := Point(Right, (Top + Bottom) div 2);
          Point3 := Point(Left, Bottom);

          Polygon([Point1, Point2, Point3]);

          if (FQuadState = iqsRight) and (FMouseDown or FArrowKeyDown) then
            begin
              Pen.Color := clBlack; PolyLine([Point1, Point2]);
              Pen.Color := clWhite; PolyLine([Point2, Point3]);
              Pen.Color := clBlack; PolyLine([Point3, Point1]);
            end
          else
            begin
              Pen.Color := clWhite; PolyLine([Point1, Point2]);
              Pen.Color := clBlack; PolyLine([Point2, Point3]);
              Pen.Color := clWhite; PolyLine([Point3, Point1]);
            end;
        end;

      with FBottomRect do
        begin
          Point1 := Point(Left, Top);
          Point2 := Point(Right, Top);
          Point3 := Point((Left + Right) div 2, Bottom);

          Polygon([Point1, Point2, Point3]);

          if (FQuadState = iqsBottom) and (FMouseDown or FArrowKeyDown) then
            begin
              Pen.Color := clBlack; PolyLine([Point1, Point2]);
              Pen.Color := clWhite; PolyLine([Point2, Point3]);
              Pen.Color := clBlack; PolyLine([Point3, Point1]);
            end
          else
            begin
              Pen.Color := clWhite; PolyLine([Point1, Point2]);
              Pen.Color := clBlack; PolyLine([Point2, Point3]);
              Pen.Color := clGray;  PolyLine([Point3, Point1]);
            end;
        end;

      if ShowFocusRect and HasFocus then iDrawFocusRect(Canvas, ClientRect, BackGroundColor);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iDoKillFocus;
begin
  FArrowKeyDown := False;
  FMouseDown    := False;
  TimerStop;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.TimerEvent(Sender: TObject);
begin
  DoQuadEvent;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  if FUseArrowKeys then
    begin
      //KYLIX TODO
      {$ifndef iCLX}
      if      CharCode = VK_LEFT  then FQuadState := iqsLeft
      else if CharCode = VK_RIGHT then FQuadState := iqsRight
      else if CharCode = VK_UP    then FQuadState := iqsTop
      else if CharCode = VK_DOWN  then FQuadState := iqsBottom
      else                             FQuadState := iqsNone;

      if (FQuadState <> iqsNone) then
        begin
          CharCode := 0;
          FArrowKeyDown    := True;
          TimerStart(FRepeatInitialDelay, FRepeatInterval);
          InvalidateChange;
        end;
      {$endif}
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iWantSpecialKey(var CharCode: Word; var Result: Longint);
begin
  Result := 0;
  if FUseArrowKeys then if CharCode in [VK_LEFT, VK_DOWN, VK_RIGHT, VK_UP] then Result := 1;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.iKeyUp(var CharCode: Word; Shift: TShiftState);
begin
  if FArrowKeyDown then
    begin
      //KYLIX TODO
      {$ifndef iCLX}
      if (CharCode = VK_LEFT) or (CharCode = VK_RIGHT) or (CharCode = VK_UP) or (CharCode = VK_DOWN) then
        begin
          FArrowKeyDown := False;
          InvalidateChange;
          DoQuadEvent;
          CharCode := 0;
        end;
      {$endif}
    end;
  TimerStop;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoQuadEvent;
begin
  FUserGenerated := True;
  try
    if      FQuadState = iqsLeft   then DoClickLeft
    else if FQuadState = iqsRight  then DoClickRight
    else if FQuadState = iqsTop    then DoClickUp
    else if FQuadState = iqsBottom then DoClickDown;
  finally
    FUserGenerated := False;
  end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoClickLeft;
begin
  if not Loading then
    begin
      ValueX := ValueX - IncrementX;
      if Assigned(FOnClickLeft) then FOnClickLeft(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoClickRight;
begin
  if not Loading then
    begin
      ValueX := ValueX + IncrementX;
      if Assigned(FOnClickRight) then FOnClickRight(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoClickUp;
begin
  if not Loading then
    begin
      ValueY := ValueY + IncrementY;
      if Assigned(FOnClickUp) then FOnClickUp(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoClickDown;
begin
  if not Loading then
    begin
      ValueY := ValueY - IncrementY;
      if Assigned(FOnClickDown) then FOnClickDown(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoValueXChange;
begin
  if not Loading then
    begin
      if                        Assigned(OnChangeProtected)   then OnChangeProtected  (Self, 'ValueX');
      if                        Assigned(FOnValueXChange)     then FOnValueXChange    (Self);
      if FUserGenerated then if Assigned(FOnValueXChangeUser) then FOnValueXChangeUser(Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchQuad.DoValueYChange;
begin
  if not Loading then
    begin
      if                        Assigned(OnChangeProtected)   then OnChangeProtected  (Self, 'ValueY');
      if                        Assigned(FOnValueYChange)     then FOnValueYChange    (Self);
      if FUserGenerated then if Assigned(FOnValueYChangeUser) then FOnValueYChangeUser(Self);
    end;
end;
//*************************************************************************************************************************************
end.