qiswitchmultiposition.pas

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

  TempOnPositionChange : TNotifyEvent;
begin
  TempOnPositionChange := FOnPositionChange;
  FOnPositionChange    := nil;
  try
    SetPosition(Value);
  finally
    FOnPositionChange := TempOnPositionChange;
  end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPosition(const Value: Integer);
var
  CanEdit : Boolean;
begin
  if FPosition <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Position', CanEdit);
      if CanEdit then
        begin
          FPosition          := Value;
          FPositionedChanged := True;
          if not Loading then
            begin
              if FPosition < 0 then FPosition := 0;
              if FPosition > (FPositionLabelsList.Count-1) then FPosition := FPositionLabelsList.Count-1;
            end;
          BackGroundChange;
          DoPositionChange;
          {$ifdef iVCL}OPCOutputData('Position', FPosition);{$endif}
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionIndicatorBevelStyle(const Value: TiBevelStyle);
begin
  if FPositionIndicatorBevelStyle <> Value then
    begin
      FPositionIndicatorBevelStyle := Value;
      BackGroundChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.UpdateLabelList;
var
  TempString  : ShortString;
  BuildString : String;
  x           : Integer;
begin
  FPositionLabelsList.Clear;
  TempString := FPositionLabels;
  BuildString := '';
  for x := 1 to Length(TempString) do
    begin
      if TempString[x] <> ',' then BuildString := BuildString + TempString[x]
        else
          begin
            if Trim(BuildString) = '' then FPositionLabelsList.Add('???') else FPositionLabelsList.Add(Trim(BuildString));
            if FMaximumLabels <> 0 then if FPositionLabelsList.Count = FMaximumLabels then exit;
            BuildString := '';
          end;
    end;

  if Trim(BuildString) <> '' then FPositionLabelsList.Add(Trim(BuildString));

  if FPositionLabelsList.Count = 0 then FPosition := 0
  else if FPosition > (FPositionLabelsList.Count - 1) then FPosition := FPositionLabelsList.Count - 1;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionLabels(const Value: String);
begin
  if Length(Value) > 255 then raise Exception.Create('Position Label String Must be < 256 Characters');

  if FPositionLabels <> Value then
    begin
      FPositionLabels := Value;
      UpdateLabelList;
      BackGroundChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.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 TiSwitchMultiPosition.iKeyUp(var CharCode: Word; Shift: TShiftState);
begin
  InvalidateChange;
  if FKeyDown then
    begin
      FKeyDown   := False;
      FMouseDown := False;
      if PositionedChanged then
        begin
          PositionedChanged := False;
          if Assigned(OnPositionChangeFinished) then OnPositionChangeFinished(Self)
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  FKeyDown      := True;
  FMouseDown    := False;
  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 := 0;
        CharCode := 0;
      end
    else if (CharCode = VK_END) then
      begin
        Position := FPositionLabelsList.Count-1;
        CharCode := 0;
      end;
    {$endif}
  finally
    UserGenerated := False;
  end;
  inherited;
end;
//*************************************************************************************************************************************
function TiSwitchMultiPosition.GetPositionLabel(Index: Integer): String;
begin
  if (Index > FPositionLabelsList.Count-1) or (Index < 0) then raise Exception.Create('Index out of Bounds');
  Result := FPositionLabelsList.Strings[Index];
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.SetPositionLabel(Index: Integer; const Value: String);
begin
  if (Index > FPositionLabelsList.Count-1) or (Index < 0) then raise Exception.Create('Index out of Bounds');
  FPositionLabelsList.Strings[Index] := Value;
  BackGroundChange;
end;
//*************************************************************************************************************************************
function TiSwitchMultiPosition.GetPositionLabelCount: Integer;
begin
  Result := FPositionLabelsList.Count;
end;
//*************************************************************************************************************************************
procedure TiSwitchMultiPosition.iDoKillFocus;
begin
  inherited;
  FMouseDown := False;
  FKeyDown   := False;
end;
//*************************************************************************************************************************************
{$ifdef iVCL}function TiSwitchMultiPosition.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint      ): Boolean;{$endif}
{$ifdef iCLX}function TiSwitchMultiPosition.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;

  Position := Position + WheelDelta div ABS(WheelDelta);
end;
//****************************************************************************************************************************************************
end.