jvlistbox.pas

East make Tray Icon in delphi

  else
    cx := 0;

  for I := 0 to ItemsShowing.Count - 1 do
  begin
    MeasureString(ItemsShowing[I], cx, LItemSize);
    if MultiLine then
      Perform(LB_SETITEMHEIGHT, I, LItemSize.cy);

    if not LimitToClientWidth and (LItemSize.cx > LMaxWidth) then
      LMaxWidth := LItemSize.cx;
  end;
  if not LimitToClientWidth then
    MaxWidth := LMaxWidth;
end;

function TJvCustomListBox.SearchExactString(const Value: string;
  CaseSensitive: Boolean; StartIndex: Integer): Integer;
begin
  Result := TJvItemsSearchs.SearchExactString(ItemsShowing, Value, CaseSensitive, StartIndex);
end;

function TJvCustomListBox.SearchPrefix(const Value: string;
  CaseSensitive: Boolean; StartIndex: Integer): Integer;
begin
  Result := TJvItemsSearchs.SearchPrefix(ItemsShowing, Value, CaseSensitive, StartIndex);
end;

function TJvCustomListBox.SearchSubString(const Value: string;
  CaseSensitive: Boolean; StartIndex: Integer): Integer;
begin
  Result := TJvItemsSearchs.SearchSubString(ItemsShowing, Value, CaseSensitive, StartIndex);
end;

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

procedure TJvCustomListBox.SelectCancel(var Msg: TMessage);
begin
  if Assigned(FOnSelectCancel) then
    FOnSelectCancel(Self);
end;

procedure TJvCustomListBox.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;

    UpdateStyle;
    Invalidate;
  end;
end;

procedure TJvCustomListBox.SetBackground(const Value: TJvListBoxBackground);
begin
  FBackground.Assign(Value);
end;

procedure TJvCustomListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Alignment <> taLeftJustify then
    Repaint;
end;

procedure TJvCustomListBox.SetDisabledTextColor(const Value: TColor);
begin
  if FDisabledTextColor <> Value then
  begin
    FDisabledTextColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomListBox.SetHotTrack(const Value: Boolean);
begin
  if FHotTrack <> Value then
  begin
    FHotTrack := Value;
    Ctl3D := not FHotTrack;
  end;
end;

procedure TJvCustomListBox.SetMaxWidth(const Value: Integer);
begin
  if not LimitToClientWidth and (FMaxWidth <> Value) then
  begin
    FMaxWidth := Value;
    Perform(LB_SETHORIZONTALEXTENT, Value, 0);
  end;
end;

procedure TJvCustomListBox.SetMultiline(const Value: Boolean);
begin
  if FMultiline <> Value then
  begin
    FMultiline := Value;

    UpdateStyle;
    if FMultiline then
    begin
      // make sure scrollbars matches
      if ScrollBars = ssBoth then
        ScrollBars := ssVertical;
      if ScrollBars = ssHorizontal then
        ScrollBars := ssNone;
      FMaxWidth := 0;
      Perform(LB_SETHORIZONTALEXTENT, 0, 0);
    end
    else
      RemeasureAll;
  end;
end;

procedure TJvCustomListBox.SetScrollBars(const Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
  end;
end;

procedure TJvCustomListBox.SetSelectedColor(const Value: TColor);
begin
  if FSelectedColor <> Value then
  begin
    FSelectedColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomListBox.SetSelectedTextColor(const Value: TColor);
begin
  if FSelectedTextColor <> Value then
  begin
    FSelectedTextColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomListBox.SetShowFocusRect(const Value: Boolean);
const
  CShowFocusRect: array [Boolean] of Integer = (0, 2);
begin
  if FShowFocusRect <> Value then
  begin
    FShowFocusRect := Value;

    ItemHeight := CanvasMaxTextHeight(Canvas) + CShowFocusRect[ShowFocusRect];
    RemeasureAll;
    if Focused then
      Invalidate;
  end;
end;

procedure TJvCustomListBox.SetSorted(const Value: Boolean);
begin
  if FSorted <> Value then
  begin
    FSorted := Value;
    RecreateWnd;
  end;
end;

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

procedure TJvCustomListBox.UpdateHorizontalExtent;
begin
  if HandleAllocated and (FScrollBars in [ssHorizontal, ssBoth]) then
    RemeasureAll;
  //    SendMessage(Handle, LB_SETHORIZONTALEXTENT, FHorizontalExtent, 0);
end;

procedure TJvCustomListBox.UpdateStyle;
const
  CShowFocusRect: array [Boolean] of Integer = (0, 2);
var
  PreviousStyle: TListBoxStyle;
begin
  if csLoading in ComponentState then
    Exit;

  PreviousStyle := Style;

  if MultiLine then
    Style := lbOwnerDrawVariable
  else
  if Alignment <> taLeftJustify then
    Style := lbOwnerDrawFixed;

  if (PreviousStyle = lbStandard) and (Style <> lbStandard) then
  begin
    ItemHeight := CanvasMaxTextHeight(Canvas) + CShowFocusRect[ShowFocusRect];
    RemeasureAll;
  end;
end;

function TJvCustomListBox.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  if not Background.DoDraw then
    Result := inherited DoEraseBackground(Canvas, Param)
  else
  begin
    Result := True;
    DrawBackGround(Canvas.Handle, False);
  end;
end;

procedure TJvCustomListBox.WMHScroll(var Msg: TWMHScroll);
var
  DontScroll: Boolean;
  DoUpdate: Boolean;
  ScrollInfo: TScrollInfo;
begin
  DoUpdate := Background.DoDraw;

  if DoUpdate then
    BeginRedraw;
  try
    if Assigned(FOnHorizontalScroll) then
    begin
      DontScroll := False;
      FOnHorizontalScroll(Self, Msg, DontScroll);
      if DontScroll then
        Exit;
    end;
    inherited;

    if DoUpdate and (FMaxWidth > 0) then
    begin
      with ScrollInfo do
      begin
        cbSize := SizeOf(ScrollInfo);
        fMask := SIF_ALL;
        if GetScrollInfo(Handle, SB_HORZ, ScrollInfo) then
          FLeftPosition := Round((FMaxWidth / nMax) * nPos);
      end;
    end
    else
      FLeftPosition := 0;

    //if DoUpdate then
    //  Invalidate;
  finally
    if DoUpdate then
      EndRedraw;
  end;
end;

procedure TJvCustomListBox.WMVScroll(var Msg: TWMVScroll);
var
  DontScroll: Boolean;
  DoUpdate: Boolean;
begin
  DoUpdate := Background.DoDraw;

  if DoUpdate then
    BeginRedraw;
  try
    if Assigned(FOnVerticalScroll) then
    begin
      DontScroll := False;
      FOnVerticalScroll(Self, Msg, DontScroll);
      if DontScroll then
        Exit;
    end;
    inherited;

    //if DoUpdate then
    //  Invalidate;
  finally
    if DoUpdate then
      EndRedraw;
  end;
end;

function TJvCustomListBox.ItemRect(Index: Integer): TRect;
var
  Count: Integer;
begin
  Count := ItemsShowing.Count;
  if (Index >= 0) and (Index < Count) then
    Perform(LB_GETITEMRECT, Index, Longint(@Result))
  else
  if Index = Count then
  begin
    Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
    OffsetRect(Result, 0, Result.Bottom - Result.Top);
  end
  else
    FillChar(Result, SizeOf(Result), 0);
end;

function TJvCustomListBox.ItemsShowing: TStrings;
begin
  if IsProviderSelected then
    Result := ConsumerStrings
  else
    Result := Items;
end;

procedure TJvCustomListBox.WndProc(var Msg: TMessage);
var
  ItemWidth: Word;
begin
  case Msg.Msg of
    LB_ADDSTRING, LB_INSERTSTRING:
      begin
        ItemWidth := Canvas.TextWidth(StrPas(PChar(Msg.LParam)) + ' ');
        if FMaxWidth < ItemWidth then
          FMaxWidth := ItemWidth;
        SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxWidth, 0);
      end;
    LB_DELETESTRING:
      begin
        if Msg.WParam < ItemsShowing.Count then
          ItemWidth := Canvas.TextWidth(ItemsShowing[Msg.WParam] + ' ')
        else
          ItemWidth := FMaxWidth;
        if ItemWidth = FMaxWidth then
        begin
          inherited WndProc(Msg);
          UpdateHorizontalExtent;
          Exit;
        end;
      end;
    LB_RESETCONTENT:
      SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
    WM_SETFONT:
      begin
        inherited WndProc(Msg);
        Canvas.Font.Assign(Font);
        UpdateHorizontalExtent;
        Exit;
      end;
  end;
  inherited WndProc(Msg);
end;

//=== { TJvListBoxBackground } ===============================================

constructor TJvListBoxBackground.Create;
begin
  inherited Create;
  FImage := TBitmap.Create;
end;

destructor TJvListBoxBackground.Destroy;
begin
  FImage.Free;
  inherited Destroy;
end;

procedure TJvListBoxBackground.Assign(Source: TPersistent);
begin
  if Source is TJvListBoxBackground then
  begin
    FImage.Assign(TJvListBoxBackground(Source).Image);
    FFillMode := TJvListBoxBackground(Source).FillMode;
    FVisible := TJvListBoxBackground(Source).Visible;
  end
  else
    inherited Assign(Source);
end;

procedure TJvListBoxBackground.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TJvListBoxBackground.GetDoDraw: Boolean;
begin
  Result := Visible and not Image.Empty;
end;

procedure TJvListBoxBackground.SetFillMode(const Value: TJvListboxFillMode);
begin
  if FFillMode <> Value then
  begin
    FFillMode := Value;
    Change;
  end;
end;

procedure TJvListBoxBackground.SetImage(const Value: TBitmap);
begin
  FImage.Assign(Value);
  Change;
end;

procedure TJvListBoxBackground.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Change;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.