qispinselector.pas

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

      if HasFocus then
        begin
          Font.Color := (not BackGroundColor) and $FFFFFF;
          iDrawFocusRect(Canvas, Rect(4, 4, FButtonRectUp.Left - 2, Height - 4), BackGroundColor);
        end;
  end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Enabled then Exit;
  if ErrorActive then Exit;
  iSetFocus(Self);

  if      PtInRect(FButtonRectUp,      Point(X,Y)) then FMouseDownUp      := True
  else if PtInRect(FButtonRectDown,    Point(X,Y)) then FMouseDownDown    := True
  else if PtInRect(FButtonrectDefault, Point(X,Y)) then FMouseDownDefault := True;

  if FMouseDownUp or FMouseDownDown then
    begin
      FTimer.Interval    := FRepeatInitialDelay;
      FTimer.Enabled     := True;
      FFirstTimerMessage := True;
      FMouseDownTime     := Now;
    end;

  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDownUp      and PtInRect(FButtonRectUp,      Point(X, Y)) then DoButtonUpClick;
  if FMouseDownDown    and PtInRect(FButtonRectDown,    Point(X, Y)) then DoButtonDownClick;
  if FMouseDownDefault and PtInRect(FButtonrectDefault, Point(X, Y)) then DoButtonDefaultClick;

  FMouseDownUp      := False;
  FMouseDownDown    := False;
  FMouseDownDefault := False;
  FTimer.Enabled    := False;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
procedure TiSpinSelector.WMGetDLGCode(var Message: TMessage);
begin
  inherited;
  Message.Result := Message.Result + DLGC_WANTARROWS;
end;
{$endif}
//****************************************************************************************************************************************************
procedure TiSpinSelector.iDoSetFocus;
begin
  inherited iDoSetFocus;
  if ErrorActive then Exit;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iDoKillFocus;
begin
  inherited iDoKillFocus;
  FMouseDownUp      := False;
  FMouseDownDown    := False;
  FMouseDownDefault := False;
  FTimer.Enabled    := False;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  if ErrorActive then Exit;

  case CharCode of
    VK_LEFT,
    VK_UP     : DoButtonUpClick;
    VK_RIGHT,
    VK_DOWN   : DoButtonDownClick;
    VK_HOME   : ItemIndex := 0;
    VK_END    : ItemIndex := FItemList.Count-1;
  end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.iSetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
    begin
      FAutoSize := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DoAutoSize;
begin
  if FDoingAutoSize                                                   then Exit;
  if csLoading in ComponentState                                      then Exit;
  if not Assigned(Parent) {$ifdef iVCL}and (ParentWindow = 0){$endif} then Exit;

  if FAutoSize then
    begin
      FDoingAutoSize := True;
      try
        with Canvas do
          begin
            Font.Assign(FFont);
            Height := 2*GetBorderMargin + 6 + TextHeight('ABC');
          end;
        if Assigned(FOnAutoSize) then FOnAutoSize(Self);
      finally
        FDoingAutoSize := False;
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetItemIndex(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue > (FItemList.Count - 1) then TempValue := (FItemList.Count - 1);
  if TempValue < -1 then TempValue := -1;

  if TempValue <> FItemIndex then
    begin
      if FItemIndex <> - 1 then FOldValue := Integer(FItemList.Objects[FItemIndex]) else FOldValue := -1;
      FOldItemIndex := FItemIndex;
      FItemIndex    := TempValue;
      DoChange;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetValue: Double;
begin
  if ItemIndex <> - 1 then
    begin
      Result := (FItemList.Objects[ItemIndex] as TiSpinItem).Value
    end
  else Result := -1;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetText: String;
begin
  if ItemIndex <> - 1 then
    begin
      Result := (FItemList.Objects[ItemIndex] as TiSpinItem).Caption
    end
  else Result := 'N/A';
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetValue(const Value: Double);
begin
  if Value <> GetValue then
    begin
      SetItemIndexByValue(Value);
    end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.AddItem(Caption: String; Value: Double);
var
  SpinItem : TiSpinItem;
begin
  SpinItem         := TiSpinItem.Create;
  SpinItem.Caption := Caption;
  SpinItem.Value   := Value;

  FItemList.AddObject('', SpinItem);

  if ItemIndex = - 1 then ItemIndex := 0;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.RemoveAllItems;
begin
  while FItemList.Count <> 0 do
    begin
      FItemList.Objects[0].Free;
      FItemList.Delete(0);
    end;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetItemCaption(Index: Integer): String;
begin
  Result := (FItemList.Objects[Index] as TiSpinItem).Caption;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetItemValue(Index: Integer): Double;
begin
  Result := (FItemList.Objects[Index] as TiSpinItem).Value;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetItemCaption(Index: Integer; Value: String);
begin
  (FItemList.Objects[Index] as TiSpinItem).Caption := Value;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetItemValue(Index: Integer; Value: Double);
begin
  (FItemList.Objects[Index] as TiSpinItem).Value := Value;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetItemCount: Integer;
begin
  Result := FItemList.Count;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('Items', ReadItems, WriteItems, DoWriteItems);
  inherited;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.DoWriteItems: Boolean;
begin
  Result := FItemList.Count <> 0;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.WriteItems(Writer: TWriter);
var
  x : Integer;
begin
  Writer.WriteListBegin;
  for x := 0 to FItemList.Count - 1 do
    begin
      Writer.WriteString (FItemList.Strings[x]);
      Writer.WriteInteger(Integer(FItemList.Objects[x]));
    end;
  Writer.WriteListEnd;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.ReadItems(Reader: TReader);
var
  Caption : String;
  Value   : Integer;
begin
  FItemList.Clear;
  Reader.ReadListBegin;
  while not Reader.EndOfList do
    begin                                                                   
      Caption := Reader.ReadString;
      Value   := Reader.ReadInteger;

      FItemList.AddObject(Caption, TObject(Value));
    end;
  Reader.ReadListEnd;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DoButtonUpClick;
var
  NewIndex : Integer;
begin
  if FItemList.Count = 0 then Exit;

  if (FFastIncrement <> 0) and ((Now - FMouseDownTime)*(24*60*60) > FFastSecondsDelay) then
    begin
      NewIndex := (ItemIndex div FFastIncrement)*FFastIncrement + FFastIncrement;
    end
  else
    begin
      NewIndex := ItemIndex + 1;
    end;

  if NewIndex > (ItemCount - 1) then NewIndex := (ItemCount - 1);

  ItemIndex := NewIndex;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DoButtonDownClick;
var
  NewIndex : Integer;
begin
  if FItemList.Count = 0 then Exit;

  if (FFastIncrement <> 0) and ((Now - FMouseDownTime)*(24*60*60) > FFastSecondsDelay) then
    begin
      NewIndex := (ItemIndex div FFastIncrement)*FFastIncrement - FFastIncrement;
    end
  else
    begin
      NewIndex := ItemIndex - 1;
    end;

  if NewIndex < 0 then NewIndex := 0;

  ItemIndex := NewIndex;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.DoButtonDefaultClick;
begin
  if FItemList.Count = 0 then Exit;
  Value := FDefaultValue;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.TimerEvent(Sender: TObject);
begin
  if FFirstTimerMessage then
    begin
      FTimer.Interval := FRepeatInterval;
      FFirstTimerMessage := False;
    end;

  FUserGenerated := True;
  try
    if FMouseDownUp then DoButtonUpClick else DoButtonDownClick;
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetItemIndexByValue(Value: Double);
var
  x : Integer;
begin
  for x := 0 to ItemCount-1 do
    if GetItemValue(x) = Value then
      begin
        ItemIndex := x;
        Break;
      end;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.SetItemIndexByCaption(Value: String);
var
  x : Integer;
begin
  for x := 0 to ItemCount-1 do
    if GetItemCaption(x) = Value then
      begin
        ItemIndex := x;
        Break;
      end;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetItemCaptionByValue(Value: Double): String;
var
  x     : Integer;
  Index : Integer;
begin
  Index := -1;
  for x := 0 to ItemCount-1 do
    if GetItemValue(x) = Value then
      begin
        Index := x;
        Break;
      end;

  if Index <> - 1 then
    Result := GetItemCaption(Index)
  else Result := 'Error';
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetMaxItemsWidth(Canvas: TCanvas): Integer;
var
  x      : Integer;
  AText  : String;
  AWidth : Integer;
begin
  Result := 0;
  with Canvas do
    for x := 0 to ItemCount-1 do
      begin
        AText := GetItemCaption(x);
        AWidth := TextWidth(AText);
        if AWidth > Result then Result := AWidth;
      end;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}procedure TiSpinSelector.SetEnabled(      Value: Boolean);{$endif}
{$ifdef iCLX}procedure TiSpinSelector.SetEnabled(const Value: Boolean);{$endif}
begin
  inherited SetEnabled(Value);
  InvalidateChange;
end;
//****************************************************************************************************************************************************
function TiSpinSelector.GetItemIndex: Integer;
begin
  if FItemList.Count = 0 then FItemIndex := -1;
  if FitemIndex > (ItemCount - 1) then FItemIndex := ItemCount -1;
  Result := FItemIndex;
end;
//****************************************************************************************************************************************************
procedure TiSpinSelector.AssignItems(SpinSelector: TiSpinSelector);
var
  x : Integer;
begin
   RemoveAllItems;
   for x := 0 to SpinSelector.ItemCount-1 do
     AddItem(SpinSelector.GetItemCaption(x), SpinSelector.GetItemValue(x));
end;
//****************************************************************************************************************************************************
end.