Logo Search packages:      
Sourcecode: lazarus version File versions

customcombobox.inc

{%MainUnit ../stdctrls.pp}

{******************************************************************************
                               TCustomComboBox
 ******************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

}

{------------------------------------------------------------------------------
  Method: TCustomComboBox.CreateWnd
  Params: ---
  Returns: Nothing

  Create the underlying interface-object.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.InitializeWnd;
var
  NewStrings: TStrings;
  ASelStart, ASelLength : integer;
begin
  inherited InitializeWnd;

  // get the interface based item list
  NewStrings:= TWSCustomComboBoxClass(WidgetSetClass).GetItems(Self);
  // then delete internal list
  if (FItems<>NewStrings) and (FItems<>nil) then begin
    NewStrings.Assign(FItems);
    FItems.Free;
  end;
  // and use the interface based list
  FItems:= NewStrings;

  if FItemIndex <> -1 then
    TWSCustomComboBoxClass(WidgetSetClass).SetItemIndex(Self, FItemIndex);
  TWSCustomComboBoxClass(WidgetSetClass).SetStyle(Self, FStyle);
  TWSCustomComboBoxClass(WidgetSetClass).SetArrowKeysTraverseList(Self, FArrowKeysTraverseList);
  TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);

  if FSelStart <> FSelLength then begin
    ASelStart:= FSelStart;
    ASelLength:= FSelLength;
    SelStart:= ASelStart;
    SelLength:= ASelLength;
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.DestroyWnd
  Params: ---
  Returns: Nothing

  Destroy the underlying interface-object.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.DestroyWnd;
var NewStrings : TStrings;
begin
  if not HandleAllocated then RaiseGDBException('');
  // store itemindex
  FItemIndex:= TWSCustomComboBoxClass(WidgetSetClass).GetItemIndex(Self);
  // create an internal list for storing items internally
  NewStrings:= TStringList.Create;
  // copy from interface based list
  if FItems<>nil then begin
    NewStrings.Assign(FItems);
    // delete interface based list
    FItems.Free;
  end;
  // and use the internal list
  FItems:= NewStrings;

  inherited DestroyWnd;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.DrawItem(Index: Integer; Rect: TRect;
    State: TOwnerDrawState);
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.DrawItem(Index: Integer; ARect: TRect;
  State: TOwnerDrawState);
begin
  //TControlCanvas(FCanvas).UpdateTextFlags;
  if Assigned(FOnDrawItem) then
    FOnDrawItem(Self, Index, ARect, State)
  else if not (odPainted in State) then
  begin
    FCanvas.FillRect(ARect);
    FCanvas.TextOut(ARect.Left + 2, ARect.Top, Items[Index]);
  end;
end;

procedure TCustomComboBox.DoEnter;
begin
  inherited DoEnter;
  //AutoSelect when DoEnter is fired by keyboard
  if (Style = csDropDownList) then Exit;//Non editable style
  if (FAutoSelect and not (csLButtonDown in ControlState)) then
  begin
   SelectAll;
   if (SelText = Text) then FAutoSelected := True;
  end;//End if (((Style = csDropDown) or.........
end;

procedure TCustomComboBox.DoExit;
begin
  FAutoSelected := False;
  inherited DoExit;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetSorted
  Params: val - true means "sort" the combo
  Returns: Nothing

  Set the "sorted" property of the combobox and Sort the current entries.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetSorted(Val : boolean);
begin
  if (Val <> FSorted) then begin
    FSorted:= Val;
    UpdateSorted;
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetMaxLength
  Params: val -
  Returns: Nothing

  Set the maximum length for user input.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetMaxLength(Val : integer);
begin
  if Val < 0 then Val:= 0;
  if Val<>MaxLength then begin
    fMaxlength:=Val;
    if HandleAllocated then
      TWSCustomComboBoxClass(WidgetSetClass).SetMaxLength(Self, Val);
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.GetMaxLength
  Params: ---
  Returns: the maximum length of user input

  Get the maximum length for user input.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetMaxLength : integer;
begin
  if HandleAllocated then
    fMaxLength := TWSCustomComboBoxClass(WidgetSetClass).GetMaxLength(Self);
  Result:=fMaxLength;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.DoChange
  Params: msg -
  Returns: Nothing

  Call handler for "OnChange"-event if one is assigned.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.LMChanged(var Msg);
begin
  Change;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.Change;

  Called on change
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then FOnChange(Self);
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.Select;

  Called whenever User changes the ItemIndex
  For Delphi compatibility ignore when user unselects by changing Text.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.Select;
begin
  if ItemIndex>=0 then
    if Assigned(FOnSelect) then
      FOnSelect(Self)
    else
      Change;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.DropDown;

  Called whenever the list popups.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.DropDown;
begin
  if Assigned(FOnDropDown) then FOnDropDown(Self);
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.CloseUp;

  Called whenever the list hides.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.CloseUp;
begin
  if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then exit;
  if not ReadOnly then
    EditingDone;
  if Assigned(FOnCloseUp) then FOnCloseUp(Self);
  if FAutoSelect then
   begin
    SelectAll;
    if (SelText = Text) then FAutoSelected := True;
   end;//End if FAutoSelect
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.AdjustDropDown;

 ------------------------------------------------------------------------------}
procedure TCustomComboBox.AdjustDropDown;
var
  Count, MinItemsWidth, MinItemsHeight: Integer;
begin
  if (not HandleAllocated) or (not DroppedDown) then exit;
  Count := Items.Count;
  if Count > DropDownCount then Count := DropDownCount;
  if Count < 1 then Count := 1;
  MinItemsWidth:=ItemWidth;
  MinItemsHeight:=Count*ItemHeight;
  SetComboMinDropDownSize(Handle,MinItemsWidth,MinItemsHeight,Count);
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.GetSelText
  Params: ---
  Returns: selected text

  Returns the selected part of text-field.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetSelText: string;
begin
  //debugln('TCustomComboBox.GetSelText ');
  if FStyle in [csDropDown, csSimple] then
    Result:= Copy(Text, SelStart, SelLength)
  else
    Result:= '';
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetSelText
  Params: val - new string for text-field
  Returns: nothings

  Replace the selected part of text-field with "val".
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetSelText(const Val: string);
var
  OldText, NewText: string;
begin
  //debugln('TCustomComboBox.SetSelText ',Val);
  if FStyle in [csDropDown, csSimple] then begin
    OldText:=Text;
    NewText:=LeftStr(OldText,SelStart-1)+Val
               +RightStr(OldText,length(OldText)-SelStart-SelLength+1);
    Text:=NewText;
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.GetSelStart
  Params: ---
  Returns: starting index of selected text

  Returns starting index of selected text
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetSelStart : integer;
begin
  if HandleAllocated then
    fSelStart:=TWSCustomComboBoxClass(WidgetSetClass).GetSelStart(Self);
  Result:=fSelStart;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetSelStart
  Params: val -
  Returns: nothing

  Sets starting index for selected text.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetSelStart(Val : integer);
begin
  fSelStart:=Val;
  if HandleAllocated then
    TWSCustomComboBoxClass(WidgetSetClass).SetSelStart(Self, Val);
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.GetSelLength
  Params: ---
  Returns: length of selected text

  Returns length of selected text
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetSelLength : integer;
begin
  if HandleAllocated then
    fSelLength := TWSCustomComboBoxClass(WidgetSetClass).GetSelLength(Self);
  Result:=fSelLength;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetSelLength
  Params: val -
  Returns: nothing

  Sets length of selected text.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetSelLength(Val : integer);
begin
  fSelLength:=Val;
  if HandleAllocated then
    TWSCustomComboBoxClass(WidgetSetClass).SetSelLength(Self, Val);
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SelectAll
  Params: -
  Returns: nothing

  Select entire text.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SelectAll;
var
  CurText: String;
begin
  //debugln('TCustomComboBox.SelectAll ');
  if (FStyle in [csDropDown, csSimple]) then begin
    CurText:=Text;
    if (CurText <> '') then begin
      SetSelStart(0);
      SetSelLength(Length(CurText));
    end;
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetStyle
  Params: val - new style for combobox
  Returns: nothing

  Sets a new style for the combobox.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetStyle(Val : TComboBoxStyle);
begin
  if Val <> FStyle then begin
    FStyle:= Val;
    case FStyle of
      csDropDown, csSimple: FReadOnly := false;
      csDropDownList: FReadOnly := true;
    end;
    if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
      TWSCustomComboBoxClass(WidgetSetClass).SetStyle(Self, Val);
  end;
end;

procedure TCustomComboBox.SetArrowKeysTraverseList(Value : Boolean);
begin
  if Value <> FArrowKeysTraverseList then begin
    FArrowKeysTraverseList := Value;
    if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
      TWSCustomComboBoxClass(WidgetSetClass).SetArrowKeysTraverseList(Self, Value);
   end;
end;

procedure TCustomComboBox.WMChar(var Message: TLMChar);
begin
  // all normal characters are handled by the ComboBox
  //debugln('TCustomEdit.WMChar ',DbgSName(Self),' ',dbgs(Message.CharCode));
  if (Message.CharCode in [ord('A')..ord('Z'),ord('a')..ord('z')]) then
    // eat normal keys, so they don't trigger accelerators
    Message.Result := 1
  else
    inherited WMChar(Message);
end;

procedure TCustomComboBox.SetCharCase(eccCharCase: TEditCharCase);
begin
 if (FCharCase <> eccCharCase) then
  begin
   FCharCase := eccCharCase;
   case FCharCase of
    ecUpperCase: Text := UpperCase(Text);
    ecLowerCase: Text := Lowercase(Text);
    end;//End case
  end;//End if (FCharCase <> eccCharCase)
end;

procedure TCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
var
  skip : Boolean;
  UserDropDown: boolean;
begin
  Skip := False;
  UserDropDown := ((Shift *[ssCtrl] = [ssCtrl]) and (Key = VK_DOWN));

  if AutoDropDown or UserDropDown or FReturnArrowState then
  begin
    case Key of
      VK_TAB,VK_RETURN:
       begin

        if FReturnArrowState = True then
        begin
          SetArrowKeysTraverseList(False); //we need this here, else we cannot traverse popup list
          FReturnArrowState := False;
        end;

        DroppedDown := False;
       end;
    else
      begin
        if ArrowKeysTraverseList = False then
        begin
          SetArrowKeysTraverseList(True); //we need this here, else we cannot traverse popup list
          FReturnArrowState := True;
          Skip := True;
        end;
        //AutoDropDown := True;
        DroppedDown := True;
        if UserDropDown then
          Skip := True;
      end;
    end;
  end;
  
  if Skip then
    Key := VK_UNKNOWN
  else
    inherited KeyDown(Key, Shift);
end;

procedure TCustomComboBox.KeyUp(var Key: Word; Shift: TShiftState);
var iSelStart: Integer;
    sCompleteText, sPrefixText, sResultText: string;
begin
 inherited KeyUp(Key, Shift);
 if ((cbactEnabled in FAutoCompleteText) and (Style <> csDropDownList)) then
  begin
   //Only happens with alpha-numeric keys and return key and editable Style
   if (IsEditableTextKey(Key) or (Key = VK_RETURN) or (ssShift in Shift)) then
    begin
     if (Key = VK_RETURN) then
      SelectAll else
      begin
       iSelStart := SelStart;//Capture original cursor position
       //End of line completion
       if ((iSelStart < Length(Text)) and (cbactEndOfLineComplete in FAutoCompleteText)) then Exit;
       sPrefixText := LeftStr(Text, iSelStart);
       sCompleteText := GetCompleteText(Text, iSelStart,
                                        (cbactSearchCaseSensitive in FAutoCompleteText),
                                        (cbactSearchAscending in FAutoCompleteText), Items);
       if not (sCompleteText = Text) then
        begin
         sResultText := sCompleteText;
         if ((cbactEndOfLineComplete in FAutoCompleteText) and
             (cbactRetainPrefixCase in FAutoCompleteText)) then
          begin//Retain Prefix Character cases
           Delete(sResultText, 1, iSelStart);
           Insert(sPrefixText, sResultText, 1);
          end;//End if ((cbactEndOfLineComplete in FAutoCompleteText) and....
         Text := sResultText;
         SelStart := iSelStart;
         SelLength := Length(Text);
        end;//End if not (sCompleteText = Text)
      end;//End if (Key = VK_RETURN)
    end;//End if (IsEditableTextKey(Key) or (Key = VK_RETURN) or (ssShift in Shift))
  end;//End if ((cbactEnabled in FAutoCompleteText) and (Style = csDropDown))
 //SelectAll when hitting return key for AutoSelect feature
 if (Key = VK_RETURN) then
  begin
   if FAutoSelect then
    begin
     SelectAll;
     if (SelText = Text) then FAutoSelected := True;
    end;//End if FAutoSelect
  end;//End if (Key = VK_RETURN)
end;

procedure TCustomComboBox.KeyPress(var Key: char);
begin
 //Convert character cases if FCharCase is not ecNormalCase
 case FCharCase of
  ecLowerCase: Key := lowerCase(Key);
  ecUpperCase: Key := upCase(Key);
  end;//End case
 inherited KeyPress(Key);
end;

procedure TCustomComboBox.MouseUp(Button: TMouseButton; Shift:TShiftState;
  X, Y: Integer);
begin
 inherited MouseUp(Button, Shift, X, Y);
 //AutoSelect when left mouse is clicked for the 1st time after having focus
 if (Button = mbLeft) then
  begin
   if (FAutoSelect and not FAutoSelected) then
    begin
     SelectAll;
     if (SelText = Text) then FAutoSelected := True;
    end;//End if (FAutoSelect and not FAutoSelected)
  end;//End if (Button = mbLeft)
  //if (Style = csDropDownList) then
  // DroppedDown := not DroppedDown;
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.SelectItem(const AnItem: String): Boolean;

  Selects the item with the Text of AnItem
 ------------------------------------------------------------------------------}
function TCustomComboBox.SelectItem(const AnItem: String): Boolean;
var
  i: integer;
  ValueChanged: boolean;
begin
  i:=Items.IndexOf(AnItem);
  if i>=0 then begin
    Result:=true;
    ValueChanged:=ItemIndex<>i;
    ItemIndex:=i;
    Text:=Items[i];
    if ValueChanged then begin
      Click;
      Select;
    end;
  end else
    Result:=false;
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.GetItemCount: Integer;

  Returns the number of items
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetItemCount: Integer;
begin
  Result:=Items.Count;
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.GetItemHeight: Integer;

  Gets default ItemHeight.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetItemHeight: Integer;
begin
  Result:=FItemHeight;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.SetDropDownCount(const AValue: Integer);

  Sets the number of items that fits into the drop down list.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetDropDownCount(const AValue: Integer);
begin
  FDropDownCount:=AValue;
  // ToDo
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.SetItemHeight(const AValue: Integer);

  Sets default ItemHeight. 0 or negative values are ignored.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetItemHeight(const AValue: Integer);
begin
  if AValue=FItemHeight then exit;
  FItemHeight:=AValue;
  // ToDo
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.GetDroppedDown: Boolean;

  Returns true, if list is shown.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetDroppedDown: Boolean;
begin
  Result:=FDroppedDown;
end;

function TCustomComboBox.GetAutoComplete: boolean;
begin
  Result := cbactEnabled in AutoCompleteText;
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.GetItemWidth: Integer;

  The ItemWidth is the minimum pixels, that is allocated for the items in the
  dropdown list.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetItemWidth: Integer;
begin
  Result:=FItemWidth;
end;

procedure TCustomComboBox.SetAutoComplete(const AValue: boolean);
begin
  if (cbactEnabled in FAutoCompleteText)=AValue then exit;
  if AValue then
    AutoCompleteText := AutoCompleteText + [cbactEnabled]
  else
    AutoCompleteText := AutoCompleteText - [cbactEnabled]
end;

{------------------------------------------------------------------------------
  function TCustomComboBox.GetDroppedDown: Boolean;


 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetDroppedDown(const AValue: Boolean);
begin
  if FDroppedDown=AValue then exit;
  if (not HandleAllocated) or (csLoading in ComponentState) then exit;
  ComboBoxDropDown(Handle,AValue);
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.SetItemWidth(const AValue: Integer);

  The ItemWidth is the minimum pixels, that is allocated for the items in the
  dropdown list.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetItemWidth(const AValue: Integer);
begin
  if FItemWidth=AValue then exit;
  FItemWidth:=AValue;
  AdjustDropDown;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetItems
  Params: value - stringlist with items for combobox
  Returns: nothing

  Assigns items for ComboBox from a stringlist.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetItems(Value : TStrings);
begin
  if (Value <> FItems) then begin
    FItems.Assign(Value);
  end;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.Create
  Params: AOwner - owner of the object
  Returns: reference to the newly created object

  Creates the object.
 ------------------------------------------------------------------------------}
constructor TCustomComboBox.Create(TheOwner : TComponent);
begin
  inherited Create(TheOwner);

  fCompStyle := csComboBox;
  SetInitialBounds(0,0,100,25);
  FItems := TStringlist.Create;
  FItemIndex:=-1;
  FDropDownCount:=8;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  ArrowKeysTraverseList := True;
  TabStop := true;
  ParentColor := false;
  FAutoCompleteText := [cbactEndOfLineComplete, cbactSearchAscending];
  FAutoSelect := False;
  FAutoSelected := False;
  FCharCase := ecNormal;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.Destroy
  Params: ---
  Returns: nothing

  Destroys the object.
 ------------------------------------------------------------------------------}
destructor TCustomComboBox.Destroy;
begin
  if HandleAllocated then DestroyHandle;
  FCanvas.Free;
  FCanvas:=nil;
  FItems.Free;
  FItems:=nil;
  inherited Destroy;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.AddItem(const Item: String; AnObject: TObject);

  Adds an Item with an associated object to Items
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.AddItem(const Item: String; AnObject: TObject);
begin
  Items.AddObject(Item,AnObject);
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.AddHistoryItem(const Item: string;
    MaxHistoryCount: integer; SetAsText, CaseSensitive: boolean);

  Adds an Item as first item. Removes the Item from old positions and removes
  last item if history is full.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.AddHistoryItem(const Item: string;
  MaxHistoryCount: integer; SetAsText, CaseSensitive: boolean);
begin
  AddHistoryItem(Item,nil,MaxHistoryCount,SetAsText,CaseSensitive);
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.AddHistoryItem(const Item: string;
    AnObject: TObject; MaxHistoryCount: integer;
    SetAsText, CaseSensitive: boolean);

  Adds an Item as first item. Removes the Item from old positions and removes
  last item if history is full.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.AddHistoryItem(const Item: string; AnObject: TObject;
  MaxHistoryCount: integer; SetAsText, CaseSensitive: boolean);
var i: integer;
begin
  // insert as first
  if (Items.Count=0)
  or (CaseSensitive and (AnsiCompareText(Items[0],Item)<>0))
  or (not CaseSensitive and (Items[0]<>Item)) then
  begin
    Items.InsertObject(0,Item,AnObject);
  end;
  // delete old
  for i:=Items.Count-1 downto 1 do begin
    if (CaseSensitive and (AnsiCompareText(Items[i],Item)=0))
    or (not CaseSensitive and (Items[i]=Item)) then
      Items.Delete(i);
  end;
  // delete overflow items
  while Items.Count>MaxHistoryCount do
    Items.Delete(Items.Count-1);
  // set as text
  if SetAsText then
    Text:=Item;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.Clear;

  Removes all Items
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.Clear;
begin
  Items.Clear;
  Text:='';
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.ClearSelection;

  Unselects all items.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.ClearSelection;
begin
  ItemIndex := -1;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.MeasureItem(Index: Integer; var TheHeight: Integer);

 ------------------------------------------------------------------------------}
procedure TCustomComboBox.MeasureItem(Index: Integer; var TheHeight: Integer);
begin
  if Assigned(OnMeasureItem) then
    OnMeasureItem(Self,Index,TheHeight);
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.GetItemIndex
  Params: ---
  Returns: index of the currently selected item

  Returns index of the currently selected item in the combobox. -1 is returned
  if no item is currently selected.
 ------------------------------------------------------------------------------}
function TCustomComboBox.GetItemIndex : integer;
begin
  if not (csDestroying in ComponentState)
  and not (csDestroyingHandle in ControlState) and HandleAllocated then
    FItemIndex:= TWSCustomComboBoxClass(WidgetSetClass).GetItemIndex(Self);
  Result:=FItemIndex;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.RealSetText
  Params: AValue -
  Returns: nothing

  If the text AValue occurs in the list of strings, then sets the itemindex,
  otherwise does the default action
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.RealSetText(const AValue: TCaption);
var
  I: integer;
begin
  I := FItems.IndexOf(AValue);
  if I >= 0 then
    ItemIndex := I
  else if (not (csLoading in ComponentState)) then
    ItemIndex := -1;
  inherited;
end;

{------------------------------------------------------------------------------
  Method: TCustomComboBox.SetItemIndex
  Params: Val -
  Returns: nothing

  Sets ths index of the currently selected item in the combobox.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.SetItemIndex(Val : integer);
begin
  //if CompareText(Name,'TextToFindComboBox')=0 then
  //  debugln('TCustomComboBox.SetItemIndex A ',DbgSName(Self),' Text="',Text,'"');
  if Val < -1 then Exit;
  if Val = GetItemIndex then exit;
  if (Val >= Items.Count) and (not (csLoading in ComponentState)) then exit;

  FItemIndex:= Val;
  if csLoading in ComponentState then Exit;
  
  if HandleAllocated then begin
    TWSCustomComboBoxClass(WidgetSetClass).SetItemIndex(Self, FItemIndex);
  end else begin
    // remember text, in case one reads text without creating handle
    if Val = -1
    then Text := ''
    else Text := FItems.Strings[FItemIndex];
  end;

  //if CompareText(Name,'TextToFindComboBox')=0 then
  //  debugln('TCustomComboBox.SetItemIndex END ',DbgSName(Self),' Text="',Text,'"');
end;

{------------------------------------------------------------------------------
  Procedure TCustomComboBox.LMDrawListItem(var TheMessage : TLMDrawListItem);

  Handler for custom drawing items.
 ------------------------------------------------------------------------------}
Procedure TCustomComboBox.LMDrawListItem(var TheMessage : TLMDrawListItem);
begin
  with TheMessage.DrawListItemStruct^ do
  begin
    FCanvas.Handle := DC;
    if Font<>nil then
      FCanvas.Font := Font;
    if Brush<>nil then
      FCanvas.Brush := Brush;
    if (ItemID >= 0) and (odSelected in ItemState) then
    begin
      FCanvas.Brush.Color := clHighlight;
      FCanvas.Font.Color := clHighlightText
    end;
    DrawItem(ItemID, Area, ItemState);
    if odFocused in ItemState then
      {DrawFocusRect(hDC, rcItem)};
    FCanvas.Handle := 0;
  end;
end;

procedure TCustomComboBox.LMMeasureItem(var TheMessage: TLMMeasureItem);
var
  AHeight: Integer;
begin
  with TheMessage.MeasureItemStruct^ do begin
    if Self.ItemHeight <> 0 then
      AHeight := Self.ItemHeight
    else
      Aheight := ItemHeight;
    MeasureItem(ItemId, AHeight);
    if AHeight>0 then
      ItemHeight := AHeight;
  end;
end;

procedure TCustomComboBox.LMSelChange(var TheMessage);
begin
  if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then exit;
  Select;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.CNCommand(var TheMessage: TLMCommand);

  Handler for various notifications.
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.CNCommand(var TheMessage: TLMCommand);
begin
  case TheMessage.NotifyCode of
    CBN_DROPDOWN:
      begin
        FDroppedDown:=true;
        DropDown;
        AdjustDropDown;
      end;
    CBN_CLOSEUP:
      begin
        FDroppedDown:=false;
        CloseUp;
      end;
  end;
end;

function TCustomComboBox.IsReadOnlyStored: boolean;
begin
  // these styles imply readonly value
  Result := not (FStyle in [csSimple, csDropDown, csDropDownList]);
  if Result then
    Result := FReadOnly <> false;
end;

procedure TCustomComboBox.SetReadOnly(const AValue: Boolean);
begin
  if FReadOnly=AValue then exit;
  if FStyle=csSimple then exit;
  FReadOnly:=AValue;
  case FStyle of
    csDropDown, csDropDownList: begin
      if FReadOnly
        then Style := csDropDownList
        else Style := csDropDown;
    end;
    csOwnerDrawFixed, csOwnerDrawVariable:
      if HandleAllocated then
        TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, AValue);
  end;
end;

{------------------------------------------------------------------------------
  procedure TCustomComboBox.UpdateSorted;
 ------------------------------------------------------------------------------}
procedure TCustomComboBox.UpdateSorted;
var
  lText: string;
  lIndex: integer;
begin
  if HandleAllocated then
    TWSCustomComboBoxClass(WidgetSetClass).Sort(Self, Items, FSorted)
  else if FItems is TStringList then
  begin
    // remember text
    lText := Text;
    TStringList(FItems).Sorted := FSorted;
    lIndex := FItems.IndexOf(lText);
    if lIndex >= 0 then
      ItemIndex := lIndex;
  end;
end;

// included by stdctrls.pp

Generated by  Doxygen 1.6.0   Back to index