imodecombobox.pas

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

//****************************************************************************************************************************************************
procedure TiModeComboBox.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i                 : Integer;
  DisplayWasShowing : Boolean;
  ScreenPoint       : TPoint;
begin
  if Button <> mbLeft then Exit;

  DisplayWasShowing := FDisplay.IsShowing;

  SetFocus;

  if ErrorActive then Exit;

  if not DisplayWasShowing then
    begin
      FMouseDown        := True;

      FDisplay.Font.Assign(FFont);

      FDisplay.MinWidth := Width;
      {$IFDEF iVCL}ShowWindow(FDisplay.Handle, SW_SHOW);{$ENDIF}

      FDisplay.Items.Clear;

      for i := 0 to FItemList.Count-1 do
        FDisplay.Items.Add(FItemList.Strings[i]);

      FDisplay.SetUp;

      ScreenPoint := ClientToScreen(Point(0, 0));

      if ScreenPoint.Y + Height + FDisplay.NeededHeight > Screen.Height then
        begin
          FDisplay.Top    := ScreenPoint.Y - FDisplay.NeededHeight;
          FDisplay.Height := FDisplay.NeededHeight
        end
      else
        begin
          FDisplay.Top    := ScreenPoint.Y + Height;
          FDisplay.Height := FDisplay.NeededHeight
        end;

      if ScreenPoint.X + FDisplay.NeededWidth > Screen.Width then
        begin
          FDisplay.Left  := ScreenPoint.X + Width - FDisplay.NeededWidth;
          FDisplay.Width := FDisplay.NeededWidth
        end
      else
        begin
          FDisplay.Left  := ScreenPoint.X;
          FDisplay.Width := FDisplay.NeededWidth;
        end;
  end;

  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FMouseDown := False;
  if FDisplay.IsShowing then FDisplay.Execute;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if not FMouseDown then Exit;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
procedure TiModeComboBox.WMGetDLGCode(var Message: TMessage);
begin
  inherited;
  Message.Result := Message.Result + DLGC_WANTARROWS;
end;
{$endif}
//****************************************************************************************************************************************************
procedure TiModeComboBox.iDoSetFocus;
begin
  inherited iDoSetFocus;
  if ErrorActive then Exit;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iDoKillFocus;
begin
  inherited iDoKillFocus;                      
  FMouseDown := False;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  if ErrorActive then Exit;

  case CharCode of
    VK_LEFT,
    VK_UP     : if ItemIndex > 0                 then ItemIndex := ItemIndex - 1;
    VK_RIGHT,
    VK_DOWN   : if ItemIndex < FItemList.Count-1 then ItemIndex := ItemIndex + 1;
    VK_HOME   : ItemIndex := 0;
    VK_END    : ItemIndex := FItemList.Count-1;
  end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iSetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
    begin
      FAutoSize := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.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 + 4 + TextHeight('ABC');
          end;
        if Assigned(FOnAutoSize) then FOnAutoSize(Self);
      finally
        FDoingAutoSize := False;
      end;                                          
    end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.DisplayDestroy(Sender: TObject);
begin
  FDisplay := nil;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.DisplaySelectIndex(Sender: TObject);
begin
  UserGenerated := True;
  try
    ItemIndex := FDisplay.SelectIndex;
  finally
    UserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetItemIndex(const Value: Integer);
var
  TempValue : Integer;
begin
  if (csLoading in ComponentState) then
    begin
      FItemIndex := Value;
      Exit;
    end;

  TempValue := Value;
  if TempValue > (FItemList.Count - 1) then TempValue := (FItemList.Count - 1);
  if TempValue < -1 then TempValue := -1;

  if TempValue <> FItemIndex then
    begin
      if (TempValue <> - 1) and (FItemList.Count <> 0) then
        begin
          if FItemIndex <> - 1 then FOldValue := Integer(FItemList.Objects[FItemIndex]) else FOldValue := -1;
          FOldItemIndex := FItemIndex;
        end
      else FOldValue := -1;
      FItemIndex    := TempValue;
      FDisplay.SelectIndex := ItemIndex;
      DoChange;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
function TiModeComboBox.GetValue: Integer;
begin
  if (ItemIndex <> - 1) and (FItemList.Count <> 0) then
    begin
      Result := Integer(FItemList.Objects[ItemIndex]);
    end
  else Result := -1;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetValue(const Value: Integer);
begin
  if (csLoading in ComponentState) then Exit;

  if Value <> GetValue then
    begin
      ItemIndex := FItemList.IndexOfObject(TObject(Value));
    end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.AddItem(Caption: String; Value: Integer);
begin
  FItemList.AddObject(Caption, TObject(Value));
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.RemoveAllItems;
begin
  ItemIndex := -1;
  FItemList.Clear;
end;
//****************************************************************************************************************************************************
function TiModeComboBox.GetItemCaption(Index: Integer): String;
begin
  Result := FItemList.Strings[Index];
end;
//****************************************************************************************************************************************************
function TiModeComboBox.GetItemValue(Index: Integer): Integer;
begin
  Result := Integer(FItemList.Objects[Index]);
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetItemCaption(Index: Integer; Value: String);
begin
  FItemList.Strings[Index] := Value;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetItemValue(Index, Value: Integer);
begin
  FItemList.Objects[Index] := TObject(Value);
end;
//****************************************************************************************************************************************************
function TiModeComboBox.GetItemCount: Integer;
begin
  Result := FItemList.Count;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetValueNoEvent(const Value: Integer);
var
  TempOnValueChange : TNotifyEvent;
begin
  TempOnValueChange := FOnChange;
  FOnChange:= nil;
  try
    SetValue(Value);
  finally
    FOnChange := TempOnValueChange;
  end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('Items', ReadItems, WriteItems, DoWriteItems);
  inherited;
end;
//****************************************************************************************************************************************************
function TiModeComboBox.DoWriteItems: Boolean;
begin
  Result := FItemList.Count <> 0;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.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 TiModeComboBox.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;
//****************************************************************************************************************************************************
{$ifdef iVCL}
procedure TiModeComboBox.OPCItemActivateSend(Index: Integer);
var
  OldValue : Double;
begin
  OldValue := Value;
  OPCItemActivate(Index);
  OPCItem[Index].Data := OldValue;
end;
{$endif}
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetDropDownColor(const Value: TColor);
begin
  FDisplay.Color := Value;
end;
//****************************************************************************************************************************************************
function TiModeComboBox.GetDropDownColor: TColor;
begin
  Result := FDisplay.Color;
end;
//****************************************************************************************************************************************************
end.