islider.pas

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

                       iosBottomRight : ScaleObject.Edge  := FTrackRect.Bottom;
                       iosTopLeft     : ScaleObject.Edge  := FTrackRect.Top;
                     end;
                   end;
  end;

  ScaleObject.Draw(Canvas);
end;
//****************************************************************************************************************************************************
procedure TiSlider.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AfterPointer  : Boolean;
  BeforePointer : Boolean;
begin
  if Button = mbLeft then
    begin
      PositionedChanged := False;
      SetFocus;
      UserGenerated := True;
      try
        case FMouseControlStyle of
          ismcsSlideOnly : begin
                             FMouseDown   := True;
                             FMouseDownX  := X;
                             FMouseDownY  := Y;
                             FPositionOld := Position;
                           end;
          ismcsSlidePage : begin
                             AfterPointer  := False;
                             BeforePointer := False;
                             case FOrientation of
                               ioVertical   : begin
                                                if (X < FPointerRect.Left) or (X > FPointerRect.Right) then exit;
                                                if FReverseScale then
                                                  begin
                                                    if Y < FPointerRect.Top    then BeforePointer := True;
                                                    if Y > FPointerRect.Bottom then AfterPointer  := True;
                                                  end
                                                else
                                                  begin
                                                    if Y < FPointerRect.Top    then AfterPointer  := True;
                                                    if Y > FPointerRect.Bottom then BeforePointer := True;
                                                  end;
                                              end;
                               else           begin
                                                if (Y < FPointerRect.Top) or (Y > FPointerRect.Bottom) then exit;
                                                if FReverseScale then
                                                  begin
                                                    if X < FPointerRect.Left   then AfterPointer  := True;
                                                    if X > FPointerRect.Right  then BeforePointer := True;
                                                  end
                                                else
                                                  begin
                                                    if X < FPointerRect.Left   then BeforePointer := True;
                                                    if X > FPointerRect.Right  then AfterPointer  := True;
                                                  end;
                                              end;
                             end;
                             if BeforePointer then Position := Position - FKeyPageStepSize
                               else if AfterPointer then Position := Position + FKeyPageStepSize
                                 else
                                   begin
                                     FMouseDown   := True;
                                     FMouseDownX  := X;
                                     FMouseDownY  := Y;
                                     FPositionOld := Position;
                                   end;
                           end;
          ismcsGoto      : begin
                             case FOrientation of
                               ioVertical   : Position := GetPixelsToPosition(y);
                               else           Position := GetPixelsToPosition(x);
                             end;
                             FMouseDown   := True;
                           end;

        end;
      finally
        UserGenerated := False;
      end;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDown then
    begin
      UserGenerated := True;
      try
        case FMouseControlStyle of
          ismcsSlideOnly : case Forientation of
                             ioHorizontal : if FReverseScale then
                                                 Position := FPositionOld + (FMouseDownX - X)/TravelRange*(PositionMax - PositionMin)
                                            else Position := FPositionOld - (FMouseDownX - X)/TravelRange*(PositionMax - PositionMin);
                             ioVertical   : if FReverseScale then
                                                 Position := FPositionOld - (FMouseDownY - Y)/TravelRange*(PositionMax - PositionMin)
                                            else Position := FPositionOld + (FMouseDownY - Y)/TravelRange*(PositionMax - PositionMin);
                           end;
          ismcsSlidePage,
          ismcsGoto      : begin
                             case FOrientation of
                               ioVertical   : Position := GetPixelsToPosition(y);
                               else           Position := GetPixelsToPosition(x);
                             end;
                           end;
        end;
      finally
        UserGenerated := False;
      end;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  InvalidateChange;
  if FMouseDown  then
    begin
      FMouseDown := False;
      DoPositionChangeFinished;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iWantSpecialKey(var CharCode: Word; var Result: Longint);
begin
  if CharCode in [VK_LEFT, VK_DOWN, VK_RIGHT, VK_UP] then Result := 1 else Result := 0;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iKeyUp(var CharCode: Word; Shift: TShiftState);
begin
  inherited;
  InvalidateChange;
  if FKeyDown then
    begin
      FKeyDown := False;
      if PositionedChanged then DoPositionChangeFinished;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  FKeyDown := True;
  UserGenerated := True;
  try
    //KYLIX TODO
    {$ifndef iCLX}
    if      (CharCode = VK_LEFT) or (CharCode = VK_DOWN) then
      begin
        Position := Position - FKeyArrowStepSize;
        CharCode := 0;
      end
    else if (CharCode = VK_RIGHT) or (CharCode = VK_UP) then
      begin
        Position := Position + FKeyArrowStepSize;
        CharCode := 0;
      end
    else if (CharCode = VK_PRIOR) then //PageUp
      begin
        Position := Position + FKeyPageStepSize;
        CharCode := 0;
      end
    else if (CharCode = VK_NEXT) then //PageDown
      begin
        Position := Position - FKeyPageStepSize;
        CharCode := 0;
      end
    else if (CharCode = VK_HOME) then
      begin
        Position := PositionMin;
        CharCode := 0;
      end
    else if (CharCode = VK_END) then
      begin
        Position := PositionMax;
        CharCode := 0;
      end;
    {$endif}
  finally
    UserGenerated := False;
  end;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiSlider.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('KeyArrowStepSize_2', ReadKeyArrowStepSize, WriteKeyArrowStepSize, True);
  Filer.DefineProperty('KeyPageStepSize_2',  ReadKeyPageStepSize, WriteKeyPageStepSize, True);
end;
//****************************************************************************************************************************************************
procedure TiSlider.ReadKeyArrowStepSize(Reader: TReader);
begin
  FKeyArrowStepSize := Reader.ReadFloat;
end;
//****************************************************************************************************************************************************
procedure TiSlider.ReadKeyPageStepSize(Reader: TReader);
begin
  FKeyPageStepSize := Reader.ReadFloat;
end;
//****************************************************************************************************************************************************
procedure TiSlider.WriteKeyArrowStepSize(Writer: TWriter);
begin
  Writer.WriteFloat(FKeyArrowStepSize);
end;
//****************************************************************************************************************************************************
procedure TiSlider.WriteKeyPageStepSize(Writer: TWriter);
begin
  Writer.WriteFloat(FKeyPageStepSize);
end;
//****************************************************************************************************************************************************
procedure TiSlider.DoOPCPositionChangeFinished;
begin
  OPCOutputData('Position', Position);
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}function TiSlider.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint      ): Boolean;{$endif}
{$ifdef iCLX}function TiSlider.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; const MousePos: TPoint): Boolean;{$endif}
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

  if (Now -FLastWheelTime)*24*60*60*1000 < 30 then Exit;
  FLastWheelTime := Now;

  UserGenerated := True;
  try
    Position := Position + WheelDelta/ABS(WheelDelta) * FMouseWheelStepSize;
    DoPositionChangeFinished;
  finally
    UserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiSlider.iDoKillFocus;
begin
  inherited;
  FMouseDown := False;
  FKeyDown   := False;
end;
//****************************************************************************************************************************************************
end.