jvcombobox.pas

East make Tray Icon in delphi

    ComboBox.DeselectProvider;
    SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
    ComboBox.Text := S;
    ComboBox.Update;
  end;
end;

procedure TJvComboBoxStrings.Delete(Index: Integer);
begin
  if (csLoading in ComboBox.ComponentState) and UseInternal then
    InternalList.Delete(Index)
  else
  begin
    ComboBox.DeselectProvider;
    SendMessage(ComboBox.Handle, CB_DELETESTRING, Index, 0);
  end;
end;

function TJvComboBoxStrings.Get(Index: Integer): string;
var
  Text: array [0..4095] of Char;
  Len: Integer;
begin
  if UseInternal then
    Result := InternalList[Index]
  else
  begin
    Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(@Text));
    if Len = CB_ERR then //Len := 0;
      Error(SListIndexError, Index);
    SetString(Result, Text, Len);
  end;
end;

function TJvComboBoxStrings.GetComboBox: TJvCustomComboBox;
begin
  {$IFDEF COMPILER6_UP}
  Result := TJvCustomComboBox(inherited ComboBox);
  {$ELSE}
  Result := FComboBox;
  {$ENDIF COMPILER6_UP}
end;

function TJvComboBoxStrings.GetCount: Integer;
begin
  if (DestroyCount > 0) and UseInternal then
    Result := 0
  else
  begin
    if UseInternal then
    begin
      {$IFDEF COMPILER5}
      if not ComboBox.IsDropping then
      {$ENDIF COMPILER5}
        Result := InternalList.Count
      {$IFDEF COMPILER5}
      else
        Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0)
      {$ENDIF COMPILER5}
    end
    else
      Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
  end;
end;

function TJvComboBoxStrings.GetInternalList: TStrings;
begin
  Result := FInternalList;
end;

function TJvComboBoxStrings.GetObject(Index: Integer): TObject;
begin
  if UseInternal then
    Result := InternalList.Objects[Index]
  else
  begin
    Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
    if Longint(Result) = CB_ERR then
      Error(SListIndexError, Index);
  end;
end;

function TJvComboBoxStrings.IndexOf(const S: string): Integer;
begin
  if UseInternal then
    Result := InternalList.IndexOf(S)
  else
    Result := SendMessage(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, Longint(PChar(S)));
end;

procedure TJvComboBoxStrings.Insert(Index: Integer; const S: string);
begin
  if (csLoading in ComboBox.ComponentState) and UseInternal then
    InternalList.Insert(Index, S)
  else
  begin
    ComboBox.DeselectProvider;
    if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index, Longint(PChar(S))) < 0 then
      raise EOutOfResources.CreateRes(@SInsertLineError);
  end;
end;

{ Copies the strings at the combo box to the InternalList. To minimize the memory usage when a
  large list is used, each item copied is immediately removed from the combo box list. }

procedure TJvComboBoxStrings.MakeListInternal;
var
  Cnt: Integer;
  Text: array [0..4095] of Char;
  Len: Integer;
  S: string;
  Obj: TObject;
begin
  SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(False), 0);
  try
    InternalList.Clear;
    Cnt := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
    while Cnt > 0 do
    begin
      Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, 0, Longint(@Text));
      SetString(S, Text, Len);
      Obj := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, 0, 0));
      SendMessage(ComboBox.Handle, CB_DELETESTRING, 0, 0);
      InternalList.AddObject(S, Obj);
      Dec(Cnt);
    end;
  finally
    UseInternal := True;
    if not Updating then
      SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(True), 0);
  end;
end;

procedure TJvComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if UseInternal then
    InternalList.Objects[Index] := AObject
  else
    SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(AObject));
end;

procedure TJvComboBoxStrings.SetComboBox(Value: TJvCustomComboBox);
begin
  {$IFDEF COMPILER6_UP}
  inherited ComboBox := Value;
  {$ELSE}
  FComboBox := Value;
  {$ENDIF COMPILER6_UP}
end;

procedure TJvComboBoxStrings.SetUpdateState(Updating: Boolean);
begin
  FUpdating := Updating;
  SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then
    ComboBox.Refresh;
end;

procedure TJvComboBoxStrings.SetWndDestroying(Destroying: Boolean);
begin
  if Destroying then
    Inc(FDestroyCnt)
  else
  if FDestroyCnt > 0 then
    Dec(FDestroyCnt);
end;

//=== { TJvCustomComboBox } ==================================================

constructor TJvCustomComboBox.Create(AOwner: TComponent);
{.$IFNDEF COMPILER7_UP}
var
  PI: PPropInfo;
  PStringsAddr: PStrings;
{.$ENDIF COMPILER7_UP}
begin
  inherited Create(AOwner);
  {$IFDEF COMPILER5}
  FAutoComplete := True;
  {$ENDIF COMPILER5}
  FConsumerSvc := TJvDataConsumer.Create(Self, [DPA_RenderDisabledAsGrayed,
    DPA_ConsumerDisplaysList]);
  FConsumerSvc.OnChanged := ConsumerServiceChanged;
  FConsumerSvc.AfterCreateSubSvc := ConsumerSubServiceCreated;
  {.$IFNDEF COMPILER7_UP}
  { The following hack assumes that TJvComboBox.Items reads directly from the private FItems field
    of TCustomComboBox and that TJvComboBox.Items is actually published.

    What we do here is remove the original string list used and place our own version in it's place.
    This would give us the benefit of keeping the list of strings (and objects) even if a provider
    is active and the combo box windows has no strings at all. }
  PI := GetPropInfo(TJvComboBox, 'Items');
  PStringsAddr := Pointer(Integer(PI.GetProc) and $00FFFFFF + Integer(Self));
  Items.Free;                                 // remove original item list (TComboBoxStrings instance)
  PStringsAddr^ := TJvComboBoxStrings.Create; // create our own implementation and put it in place.
  TJvComboBoxStrings(Items).ComboBox := Self; // link it to the combo box.
  {.$ENDIF COMPILER7_UP}
  {$IFDEF COMPILER5}
  FAutoCompleteCode := TJvComboBoxAutoComplete.Create(Self);
  FAutoCompleteCode.OnDropDown := DoDropDown;
  FAutoCompleteCode.OnChange := DoChange;
  FAutoCompleteCode.OnValueChange := DoValueChange;
  {$ENDIF COMPILER5}
  FSearching := False;
  FMaxPixel := TJvMaxPixel.Create(Self);
  FMaxPixel.OnChanged := MaxPixelChanged;
  FReadOnly := False; // ain
  FEmptyFontColor := clGrayText;
end;

destructor TJvCustomComboBox.Destroy;
begin
  FMaxPixel.Free;
  FreeAndNil(FConsumerSvc);
  inherited Destroy;
end;

{$IFDEF COMPILER5}
procedure TJvCustomComboBox.CloseUp;
begin
  if Assigned(FOnCloseUp) then
    FOnCloseUp(Self);
end;
{$ENDIF COMPILER5}

procedure TJvCustomComboBox.CNCommand(var Msg: TWMCommand);
var
  VL: IJvDataConsumerViewList;
  Item: IJvDataItem;
  ItemText: IJvDataItemText;
begin
  {$IFDEF COMPILER5}
  if Msg.NotifyCode = CBN_DROPDOWN then
    FIsDropping := True;
  try
  {$ENDIF COMPILER5}
    if (Msg.NotifyCode = CBN_SELCHANGE) and IsProviderSelected then
    begin
      Provider.Enter;
      try
        if Supports(Provider as IJvDataConsumer, IJvDataConsumerViewList, VL) then
        begin
          Item := VL.Item(ItemIndex);
          if Supports(Item, IJvDataItemText, ItemText) then
            Text := ItemText.Caption
          else
            Text := '';
        end
        else
        begin
          Item := nil;
          Text := '';
        end;
        Click;
        Select;
        Provider.ItemSelected(Item);
      finally
        Provider.Leave;
      end;
    end
    else
      inherited;
  {$IFDEF COMPILER5}
  finally
    if Msg.NotifyCode = CBN_DROPDOWN then
      FIsDropping := False;
  end;
  {$ENDIF COMPILER5}
end;

procedure TJvCustomComboBox.CNMeasureItem(var Msg: TWMMeasureItem);
begin
  inherited; // Normal behavior, specifically setting correct ItemHeight
  { Call MeasureItem if a provider is selected and the style is not csOwnerDrawVariable.
    if Style is set to csOwnerDrawVariable Measure will have been called already. }
  if (Style <> csOwnerDrawVariable) and IsProviderSelected then
    with Msg.MeasureItemStruct^ do
      MeasureItem(itemID, Integer(itemHeight));
end;

procedure TJvCustomComboBox.ConsumerServiceChanged(Sender: TJvDataConsumer;
  Reason: TJvDataConsumerChangeReason);
begin
  if (Reason = ccrProviderSelect) and not IsProviderSelected and not FProviderToggle then
  begin
    TJvComboBoxStrings(Items).MakeListInternal;
    FProviderIsActive := True;
    FProviderToggle := True;
    RecreateWnd;
  end
  else
  if (Reason = ccrProviderSelect) and IsProviderSelected and not FProviderToggle then
  begin
    TJvComboBoxStrings(Items).ActivateInternal; // apply internal string list to combo box
    FProviderIsActive := False;
    FProviderToggle := True;
    RecreateWnd;
  end;
  if not FProviderToggle or (Reason = ccrProviderSelect) then
  begin
    UpdateItemCount;
    Refresh;
  end;
  if FProviderToggle and (Reason = ccrProviderSelect) then
    FProviderToggle := False;
end;

procedure TJvCustomComboBox.ConsumerSubServiceCreated(Sender: TJvDataConsumer;
  SubSvc: TJvDataConsumerAggregatedObject);
var
  VL: IJvDataConsumerViewList;
begin
  if SubSvc.GetInterface(IJvDataConsumerViewList, VL) then
  begin
    VL.ExpandOnNewItem := True;
    VL.AutoExpandLevel := -1;
    VL.RebuildView;
  end;
end;

procedure TJvCustomComboBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if IsProviderSelected then
  begin
    Params.Style := Params.Style and not (CBS_SORT or CBS_HASSTRINGS);
    if Params.Style and (CBS_OWNERDRAWVARIABLE or CBS_OWNERDRAWFIXED) = 0 then
      Params.Style := Params.Style or CBS_OWNERDRAWFIXED;
  end;
  FIsFixedHeight := (Params.Style and CBS_OWNERDRAWVARIABLE) = 0;
end;

procedure TJvCustomComboBox.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(EditHandle, EM_SETREADONLY, Ord(ReadOnly), 0);
  UpdateItemCount;
  if Focused then
    DoEmptyValueEnter
  else
    DoEmptyValueExit;
end;

function TJvCustomComboBox.DeleteExactString(Value: string; All: Boolean;
  CaseSensitive: Boolean): Integer;
begin
  Result := TJvItemsSearchs.DeleteExactString(Items, Value, CaseSensitive);
end;

procedure TJvCustomComboBox.DeselectProvider;
begin
  Provider.Provider := nil;
end;

procedure TJvCustomComboBox.DestroyWnd;
begin
  if IsProviderSelected then
    TJvComboBoxStrings(Items).SetWndDestroying(True);
  try
    inherited DestroyWnd;
  finally
    if IsProviderSelected then
      TJvComboBoxStrings(Items).SetWndDestroying(False);
  end;
end;

procedure TJvCustomComboBox.DoEmptyValueEnter;
begin
  if EmptyValue <> '' then
  begin
    if FIsEmptyValue then
    begin
      Text := '';
      FIsEmptyValue := False;
      if not (csDesigning in ComponentState) then
        Font.Color := FOldFontColor;
    end;
  end;
end;

procedure TJvCustomComboBox.DoEmptyValueExit;
begin
  if EmptyValue <> '' then
  begin
    if Text = '' then
    begin
      Text := EmptyValue;
      FIsEmptyValue := True;
      if not (csDesigning in ComponentState) then
      begin
        FOldFontColor := Font.Color;
        Font.Color := FEmptyFontColor;
      end;
    end;
  end;
end;

procedure TJvCustomComboBox.DoEnter;
begin
  inherited DoEnter;
  DoEmptyValueEnter;
end;

procedure TJvCustomComboBox.DoExit;
begin
  inherited DoExit;
  DoEmptyValueExit;
end;

procedure TJvCustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  HeightIndex: Integer;
  NewHeight: Integer;
  InvokeOrgRender: Boolean;
  VL: IJvDataConsumerViewList;
  Item: IJvDataItem;
  ItemsRenderer: IJvDataItemsRenderer;
  ItemRenderer: IJvDataItemRenderer;
  ItemText: IJvDataItemText;
  DrawState: TProviderDrawStates;
begin
  if csDestroying in ComponentState then
    Exit;
  TControlCanvas(Canvas).UpdateTextFlags;
  if (MeasureStyle = cmsBeforeDraw) and not FIsFixedHeight then
  begin
    NewHeight := FLastSetItemHeight;
    if odComboBoxEdit in State then
      HeightIndex := -1
    else
      HeightIndex := Index;
    PerformMeasureItem(HeightIndex, NewHeight);
    Perform(CB_SETITEMHEIGHT, HeightIndex, NewHeight);
  end;
  // (rom) Strange, this is already the overridden implementor of OnDrawItem
  if Assigned(OnDrawItem) and (Style in [csOwnerDrawFixed, csOwnerDrawVariable]) then
    OnDrawItem(Self, Index, Rect, State)
  else
  begin
    InvokeOrgRender := False;
    DrawState := DP_OwnerDrawStateToProviderDrawState(State);
    if not Enabled then
      DrawState := DrawState + [pdsDisabled, pdsGrayed];
    if IsProviderSelected then
    begin
      Provider.Enter;
      try
        if Supports(Provider as IJvDataConsumer, IJvDataConsumerViewList, VL) then
        begin
          Item := VL.Item(Index);
          if Item <> nil then
          begin
            Inc(Rect.Left, VL.ItemLevel(Index) * VL.LevelIndent);
            Canvas.Font := Font;
            if odSelected in State then
            begin
              Canvas.Brush.Color := clHighlight;
              Canvas.Font.Color  := clHighlightText;
            end
            else
              Canvas.Brush.Color := Color;
            Canvas.FillRect(Rect);
            if Supports(Item, IJvDataItemRenderer, ItemRenderer) then
              ItemRenderer.Draw(Canvas, Rect, DrawState)
            else
            if DP_FindItemsRenderer(Item, ItemsRenderer) then
              ItemsRenderer.DrawItem(Canvas, Rect, Item, DrawState)
            else
            if Supports(Item, IJvDataItemText, ItemText) then
              Canvas.TextRect(Rect, Rect.Left, Rect.Top, ItemText.Caption)
            else
              Canvas.TextRect(Rect, Rect.Left, Rect.Top, RsDataItemRenderHasNoText);
          end
          else
            InvokeOrgRender := True;
        end
        else
          InvokeOrgRender := True;
      finally
        Provider.Leave;
      end;
    end
    else
      InvokeOrgRender := True;