jvlistbox.pas

East make Tray Icon in delphi

  else
  if (Reason = ccrProviderSelect) and IsProviderSelected and not FProviderToggle then
  begin
    FProviderIsActive := False;
    FProviderToggle := True;
    TJvListBoxStrings(Items).ActivateInternal; // apply internal string list to list box
    RecreateWnd;}
  end;
  if (not FProviderToggle or (Reason = ccrProviderSelect)) and IsProviderSelected then
  begin
    UpdateItemCount;
    Refresh;
  end;
  if FProviderToggle and (Reason = ccrProviderSelect) then
    FProviderToggle := False;
end;

procedure TJvCustomListBox.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;

function TJvCustomListBox.IsProviderSelected: Boolean;
begin
  Result := FProviderIsActive;
end;

function TJvCustomListBox.IsProviderToggle: Boolean;
begin
  Result := FProviderToggle;
end;

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

procedure TJvCustomListBox.UpdateItemCount;
var
  VL: IJvDataConsumerViewList;
  Cnt: Integer;
  EmptyChr: Char;
begin
  if HandleAllocated and IsProviderSelected and Supports(Provider as IJvDataConsumer, IJvDataConsumerViewList, VL) then
  begin
    Cnt := VL.Count - SendMessage(Handle, LB_GETCOUNT, 0, 0);
    EmptyChr := #0;
    while Cnt > 0 do
    begin
      SendMessage(Handle, LB_ADDSTRING, 0, LParam(@EmptyChr));
      Dec(Cnt);
    end;
    while Cnt < 0 do
    begin
      SendMessage(Handle, LB_DELETESTRING, 0, 0);
      Inc(Cnt);
    end;
  end;
end;

procedure TJvCustomListBox.LBFindString(var Msg: TMessage);
begin
  if IsProviderSelected then
    Msg.Result := SearchPrefix(PChar(Msg.LParam), False, Msg.WParam)
  else
    inherited;
end;

procedure TJvCustomListBox.LBFindStringExact(var Msg: TMessage);
begin
  if IsProviderSelected then
    Msg.Result := SearchExactString(PChar(Msg.LParam), False, Msg.WParam)
  else
    inherited;
end;

procedure TJvCustomListBox.LBSelectString(var Msg: TMessage);
begin
  if IsProviderSelected then
  begin
    Msg.Result := SearchExactString(PChar(Msg.LParam), False, Msg.WParam);
    if Msg.Result > 0 then
      Perform(LB_SETCURSEL, Msg.Result, 0);
  end
  else
    inherited;
end;

procedure TJvCustomListBox.LBGetText(var Msg: TMessage);
begin
  if IsProviderSelected then
  begin
    if (Msg.WParam >= 0) and (Msg.WParam < ConsumerStrings.Count) then
    begin
      StrCopy(PChar(Msg.LParam), PChar(ConsumerStrings[Msg.WParam]));
      Msg.Result := StrLen(PChar(Msg.LParam));
    end
    else
      Msg.Result := LB_ERR;
  end
  else
    inherited;
end;

procedure TJvCustomListBox.LBGetTextLen(var Msg: TMessage);
begin
  if IsProviderSelected then
  begin
    if (Msg.WParam >= 0) and (Msg.WParam < ConsumerStrings.Count) then
      Msg.Result := Length(ConsumerStrings[Msg.WParam])
    else
      Msg.Result := LB_ERR;
  end
  else
    inherited;
end;

function TJvCustomListBox.GetDragImages: TDragImageList;
begin
  Result := FDragImage;
end;

function TJvCustomListBox.GetLimitToClientWidth: Boolean;
begin
  Result := FMultiline and (ScrollBars in [ssNone, ssVertical]);
end;

procedure TJvCustomListBox.InvertSelection;
var
  I: Integer;
begin
  if MultiSelect then
  begin
    ItemsShowing.BeginUpdate;
    for I := 0 to ItemsShowing.Count - 1 do
      Selected[I] := not Selected[I];
    ItemsShowing.EndUpdate;
  end;
end;

procedure TJvCustomListBox.LBAddString(var Msg: TMessage);
var
  LSize: TSize;
begin
  { (rb) Because TJvDirectoryListBox displays shorter strings than it stores in
         it's Items property - ie it stores the complete path, displays only
         the last part of a directory - the following code will cause the
         TJvCustomListBox think that the size of the strings are bigger than
         they really are (thus you probably will see a horizontal scroll bar)
  }
  if not LimitToClientWidth then
  begin
    MeasureString(PChar(Msg.LParam), 0, LSize);
    if LSize.cx > FMaxWidth then
      SetMaxWidth(LSize.cx);
  end;
  inherited;
  if Assigned(FOnAddString) then
    FOnAddString(Self, StrPas(PChar(Msg.LParam)));
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvCustomListBox.LBDeleteString(var Msg: TMessage);
var
  LSize: TSize;
  InheritedCalled: Boolean;
begin
  InheritedCalled := False;
  if not LimitToClientWidth then
  begin
    if Msg.WParam < ItemsShowing.Count then
      MeasureString(ItemsShowing[Msg.WParam], 0, LSize)
    else
      LSize.cx := FMaxWidth;
    InheritedCalled := LSize.cx = FMaxWidth;
    if InheritedCalled then
    begin
      inherited;
      RemeasureAll;
    end;
  end;
  if (Msg.WParam < ItemsShowing.Count) and Assigned(FOnDeleteString) then
    FOnDeleteString(Self, ItemsShowing.Strings[Msg.WParam]);
  if not InheritedCalled then
    inherited;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvCustomListBox.LBInsertString(var Msg: TMessage);
var
  LSize: TSize;
begin
  if not LimitToClientWidth then
  begin
    MeasureString(PChar(Msg.LParam), 0, LSize);
    if LSize.cx > FMaxWidth then
      SetMaxWidth(LSize.cx);
  end;
  inherited;
end;

procedure TJvCustomListBox.Loaded;
begin
  inherited Loaded;
  UpdateStyle;
end;

procedure TJvCustomListBox.DrawProviderItem(Canvas: TCanvas; Rect: TRect; Index: Integer;
  State: TOwnerDrawState);
var
  DrawState: TProviderDrawStates;
  VL: IJvDataConsumerViewList;
  Item: IJvDataItem;
  ItemsRenderer: IJvDataItemsRenderer;
  ItemRenderer: IJvDataItemRenderer;
  ItemText: IJvDataItemText;
  AText: string;
begin
  DrawState := DP_OwnerDrawStateToProviderDrawState(State);
  if not Enabled then
    DrawState := DrawState + [pdsDisabled, pdsGrayed];
  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);
        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
        begin
          AText := ItemText.Caption;
          DoGetText(Index,AText);
          Canvas.TextRect(Rect, Rect.Left, Rect.Top, AText);
        end
        else
        begin
          AText := RsDataItemRenderHasNoText;
          DoGetText(Index,AText);
          Canvas.TextRect(Rect, Rect.Left, Rect.Top, AText);
        end;
      end;
    end;
  finally
    Provider.Leave;
  end;
end;

procedure TJvCustomListBox.DoGetText(Index: Integer; var AText: string);
begin
  if Assigned(FOnGetText) then
    FOnGetText(Self, Index, AText);
end;

procedure TJvCustomListBox.MeasureItem(Index: Integer;
  var Height: Integer);
var
  AvailWidth: Integer;
  LSize: TSize;
begin
  if Assigned(OnMeasureItem) or (not MultiLine and not IsProviderSelected) or
    (Index < 0) or (Index >= ItemsShowing.Count) then
    inherited MeasureItem(Index, Height)
  else
  begin
    if LimitToClientWidth then
      AvailWidth := ClientWidth
    else
      AvailWidth := MaxInt;

    if IsProviderSelected then
      MeasureProviderItem(Index, AvailWidth, LSize)
    else
      MeasureString(ItemsShowing[Index], AvailWidth, LSize);

    Height := LSize.cy;
  end;
end;

procedure TJvCustomListBox.MeasureProviderItem(Index, WidthAvail: Integer; var ASize: TSize);
var
  VL: IJvDataConsumerViewList;
  Item: IJvDataItem;
  ItemsRenderer: IJvDataItemsRenderer;
  ItemRenderer: IJvDataItemRenderer;
  ItemText: IJvDataItemText;
begin
  Canvas.Font := Font;
  { Note: doing the TextHeight unconditionally makes sure the font is properly
    selected into the device context. }
  ASize.cy := CanvasMaxTextHeight(Canvas);
  ASize.cx := ClientWidth - 4;
  Provider.Enter;
  try
    if Supports(Provider as IJvDataConsumer, IJvDataConsumerViewList, VL) then
    begin
      Item := VL.Item(Index);
      if Item <> nil then
      begin
        if Supports(Item, IJvDataItemRenderer, ItemRenderer) then
          ASize := ItemRenderer.Measure(Canvas)
        else
        if DP_FindItemsRenderer(Item, ItemsRenderer) then
          ASize := ItemsRenderer.MeasureItem(Canvas, Item)
        else
        if Supports(Item, IJvDataItemText, ItemText) then
          ASize := Canvas.TextExtent(ItemText.Caption)
        else
          ASize := Canvas.TextExtent(RsDataItemRenderHasNoText);
        Inc(ASize.cx, VL.ItemLevel(Index) * VL.LevelIndent);
      end;
    end;
  finally
    Provider.Leave;
  end;
  { Note: item height in a listbox is limited to 255 pixels since Windows
    stores the height in a single byte.}
  if ASize.cy > 255 then
    ASize.cy := 255;
  if ASize.cy < ItemHeight then
    ASize.cy := ItemHeight;
end;

procedure TJvCustomListBox.MeasureString(const S: string; WidthAvail: Integer; var ASize: TSize);
var
  Flags: Longint;
  R: TRect;
begin
  Canvas.Font := Font;
  { Note: doing the TextHeight unconditionally makes sure the font is properly
    selected into the device context. }
  ASize.cx := Canvas.TextHeight(S);

  Flags := DrawTextBiDiModeFlags(
    DT_WORDBREAK or DT_NOPREFIX or DT_CALCRECT or AlignFlags[FAlignment]);
  if WidthAvail = 0 then
    WidthAvail := MaxInt
  else
    Dec(WidthAvail, 2);
  R := Rect(0, 0, WidthAvail, 1);
  DrawText(Canvas.Handle, PChar(S), Length(S), R, Flags);
  ASize.cx := R.Right + 4;
  ASize.cy := R.Bottom;

  { Note: item height in a listbox is limited to 255 pixels since Windows
    stores the height in a single byte.}
  if ASize.cy > 255 then
    ASize.cy := 255;
  if ASize.cy < ItemHeight then
    ASize.cy := ItemHeight;
end;

procedure TJvCustomListBox.MoveSelectedDown;
var
  I: Integer;
begin
  if not IsProviderSelected then
  begin
    if not MultiSelect then
    begin
      if (ItemIndex <> -1) and (ItemIndex < Items.Count - 1) then
      begin
        Items.Exchange(ItemIndex, ItemIndex + 1);
        ItemIndex := ItemIndex + 1;
      end;
      Exit;
    end;
    if (Items.Count > 0) and (SelCount > 0) and (not Selected[Items.Count - 1]) then
    begin
      I := Items.Count - 2;
      while I >= 0 do
      begin
        if Selected[I] then
        begin
          Items.Exchange(I, I + 1);
          Selected[I + 1] := True;
        end;
        Dec(I);
      end;
    end;
  end;
end;

procedure TJvCustomListBox.MoveSelectedUp;
var
  I: Integer;
begin
  if not IsProviderSelected then
  begin
    if not MultiSelect then
    begin
      if ItemIndex > 0 then
      begin
        Items.Exchange(ItemIndex, ItemIndex - 1);
        ItemIndex := ItemIndex - 1;
      end;
      Exit;
    end;
    if (Items.Count > 0) and (SelCount > 0) and not Selected[0] then
    begin
      I := 1;
      while I < Items.Count do
      begin
        if Selected[I] then
        begin
          Items.Exchange(I, I - 1);
          Selected[I - 1] := True;
        end;
        Inc(I);
      end;
    end;
  end;
end;

procedure TJvCustomListBox.RemeasureAll;
var
  I: Integer;
  LMaxWidth, cx: Integer;
  LItemSize: TSize;
begin
  LMaxWidth := 0;
  if LimitToClientWidth then
    cx := ClientWidth