jvlistbox.pas

East make Tray Icon in delphi

  CLeftMargin = 15;
var
  Size: TSize;
  Bmp: TBitmap;
  SizeRect: TRect;
begin
  if not Assigned(FDragImage) then
    FDragImage := TDragImageList.Create(Self)
  else
    FDragImage.Clear;
  Canvas.Font := Font;
  if MultiLine then
  begin
    SizeRect := Rect(0, 0, MaxInt, 0);
    DrawText(Canvas.Handle, PChar(S), -1, SizeRect, DT_CALCRECT or
      DrawTextBiDiModeFlags(DT_WORDBREAK or DT_NOPREFIX or AlignFlags[FAlignment]));
    Size.cx := SizeRect.Right;
    Size.cy := SizeRect.Bottom;
  end
  else
    Size := Canvas.TextExtent(S);
  Inc(Size.cx, CLeftMargin);

  FDragImage.Width := Size.cx;
  FDragImage.Height := Size.cy;
  Bmp := TBitmap.Create;
  try
    Bmp.Width := Size.cx;
    Bmp.Height := Size.cy;
    Bmp.Canvas.Font := Font;
    Bmp.Canvas.Font.Color := clBlack;
    Bmp.Canvas.Brush.Color := clWhite;
    Bmp.Canvas.Brush.Style := bsSolid;
    if MultiLine then
    begin
      Inc(SizeRect.Right, CLeftMargin);
      Bmp.Canvas.FillRect(SizeRect);
      Inc(SizeRect.Left, CLeftMargin);
      DrawText(Bmp.Canvas.Handle, PChar(S), -1, SizeRect,
        DrawTextBiDiModeFlags(DT_WORDBREAK or DT_NOPREFIX or AlignFlags[FAlignment]));
    end
    else
      Bmp.Canvas.TextOut(CLeftMargin, 0, S);
    FDragImage.AddMasked(Bmp, clWhite);
  finally
    Bmp.Free;
  end;
  ControlStyle := ControlStyle + [csDisplayDragImage];
end;

procedure TJvCustomListBox.CreateParams(var Params: TCreateParams);
const
  ScrollBar: array [TScrollStyle] of DWORD =
    (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL);
  Sorted: array [Boolean] of DWORD =
    (0, LBS_SORT);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style and not (WS_HSCROLL or WS_VSCROLL) or ScrollBar[FScrollBars] or
      Sorted[FSorted];
  end;
  if IsProviderSelected then
  begin
    Params.Style := Params.Style and not (LBS_SORT or LBS_HASSTRINGS or LBS_NODATA);
    if Params.Style and (LBS_OWNERDRAWVARIABLE or LBS_OWNERDRAWFIXED) = 0 then
      Params.Style := Params.Style or LBS_OWNERDRAWFIXED;
  end;
end;

procedure TJvCustomListBox.CreateWnd;
begin
  if not (csLoading in ComponentState) then
  begin
    FMultiline := MultiLine and (Style = lbOwnerDrawVariable);

    if not (Style in [lbOwnerDrawVariable, lbOwnerDrawFixed]) then
      FAlignment := taLeftJustify;
  end;
  FLeftPosition := 0;
  inherited CreateWnd;
  UpdateItemCount;
  UpdateHorizontalExtent;
end;

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

procedure TJvCustomListBox.DefaultDragDrop(Source: TObject;
  X, Y: Integer);
var
  DropIndex, Ti: Integer;
  S: string;
  Obj: TObject;
begin
  if not IsProviderSelected and (Source = Self) then
  begin
    S := Items[FDragIndex];
    Obj := Items.Objects[FDragIndex];
    DropIndex := ItemAtPos(Point(X, Y), True);
    Ti := TopIndex;
    if DropIndex > FDragIndex then
      Dec(DropIndex);
    Items.Delete(FDragIndex);
    if DropIndex < 0 then
      Items.AddObject(S, Obj)
    else
      Items.InsertObject(DropIndex, S, Obj);
    TopIndex := Ti;
  end;
end;

procedure TJvCustomListBox.DefaultDragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := not IsProviderSelected and (Source = Self);
  if Accept then
  begin
    // Handle autoscroll in the "hot zone" 5 pixels from top or bottom of
    // client area
    if (Y < 5) or ((ClientHeight - Y) <= 5) then
    begin
      FDragImage.HideDragImage;
      try
        if Y < 5 then
        begin
          Perform(WM_VSCROLL, SB_LINEUP, 0);
          Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
        end
        else
        if (ClientHeight - Y) <= 5 then
        begin
          Perform(WM_VSCROLL, SB_LINEDOWN, 0);
          Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
        end
      finally
        FDragImage.ShowDragImage;
      end;
    end;
    //    i := ItemAtPos(Point(X,Y),true);
    //    if i > -1 then ItemIndex := i;
  end;
end;

{ This procedure is a slightly modified version of TCustomListbox.DrawItem! }

procedure TJvCustomListBox.DefaultDrawItem(Index: Integer; ARect: TRect;
  State: TOwnerDrawState);
const
  AlignFlags: array [TAlignment] of DWORD =
    (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Flags: Longint;
  ActualRect: TRect;
  AText: string;
begin
   if csDestroying in ComponentState then
    Exit;
 // JvBMPListBox:
  // draw text transparently
  if ScrollBars in [ssHorizontal, ssBoth] then
  begin
    if FMaxWidth < ClientWidth then
      ActualRect := Rect(0, ARect.Top, ClientWidth, ARect.Bottom)
    else
      ActualRect := Rect(0, ARect.Top, FMaxWidth, ARect.Bottom);
  end
  else
    ActualRect := ARect;

  if Background.DoDraw then
  begin
    Canvas.Brush.Style := bsClear;
    // always use font color, CNDrawItem sets it to clHighlitetext for
    // selected items.
    Canvas.Font.Color := Font.Color;

    // The listbox does not erase the background for the item before
    // sending the WM_DRAWITEM message! We have to do that here manually.
    SaveDC(Canvas.Handle);
    IntersectClipRect(Canvas.Handle, ActualRect.Left, ActualRect.Top, ActualRect.Right, ActualRect.Bottom);
    DrawBackGround(Canvas.Handle, True);
    RestoreDC(Canvas.Handle, -1);
  end;

  if Index < ItemsShowing.Count then
  begin
    if not Background.DoDraw then
      Canvas.FillRect(ActualRect);

    if FMultiline then
      Flags := DrawTextBiDiModeFlags(DT_WORDBREAK or DT_NOPREFIX or
        AlignFlags[FAlignment])
    else
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or
        AlignFlags[FAlignment]);
    if not UseRightToLeftAlignment then
      Inc(ActualRect.Left, 2)
    else
      Dec(ActualRect.Right, 2);

    if IsProviderSelected then
      DrawProviderItem(Canvas, ActualRect, Index, State)
    else
    begin
      AText := ItemsShowing[Index];
      DoGetText(Index, AText);
      DrawText(Canvas.Handle, PChar(AText), Length(AText), ActualRect, Flags);
    end;

    //if (Index >= 0) and (Index < Items.Count) then
    //  Canvas.TextOut(ActualRect.Left + 2, ActualRect.Top, Items[Index]);

    // invert the item if selected
    if Background.DoDraw and (odSelected in State) then
      InvertRect(Canvas.Handle, ActualRect);
    // no need to draw focus rect, CNDrawItem does that for us
  end;
end;

procedure TJvCustomListBox.DefaultStartDrag(var DragObject: TDragObject);
begin
  FDragIndex := ItemIndex;
  if not IsProviderSelected and (FDragIndex >= 0) then
    CreateDragImage(Items[FDragIndex])
  else
    CancelDrag;
end;

procedure TJvCustomListBox.DeleteAllButSelected;
var
  I: Integer;
begin
  if not IsProviderSelected and MultiSelect then
  begin
    I := 0;
    while I < Items.Count do
      if not Selected[I] then
        Items.Delete(I)
      else
        Inc(I);
    Changed;
  end;
end;

function TJvCustomListBox.DeleteExactString(const Value: string; All: Boolean;
  CaseSensitive: Boolean): Integer;
begin
  if not IsProviderSelected then
  begin
    Result := TJvItemsSearchs.DeleteExactString(Items, Value, CaseSensitive);
    Changed;
  end
  else
    Result := 0;
end;

procedure TJvCustomListBox.DeleteSelected;
var
  I: Integer;
begin
  if not IsProviderSelected then
  begin
    if MultiSelect then
    begin
      for I := Items.Count - 1 downto 0 do
        if Selected[I] then
          Items.Delete(I);
    end
    else
    if ItemIndex <> -1 then
    begin
      I := ItemIndex;
      Items.Delete(I);
      if I > 0 then
        Dec(I);
      if Items.Count > 0 then
        ItemIndex := I;
    end;
    Changed;
  end;
end;

procedure TJvCustomListBox.DoBackgroundChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvCustomListBox.DoStartDrag(var DragObject: TDragObject);
begin
  if Assigned(OnStartDrag) then
    inherited DoStartDrag(DragObject)
  else
    DefaultStartDrag(DragObject);
end;

procedure TJvCustomListBox.DragDrop(Source: TObject; X, Y: Integer);
begin
  if Assigned(OnDragDrop) then
    inherited DragDrop(Source, X, Y)
  else
    DefaultDragDrop(Source, X, Y);
end;

procedure TJvCustomListBox.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Assigned(OnDragOver) then
    inherited DragOver(Source, X, Y, State, Accept)
  else
    DefaultDragOver(Source, X, Y, State, Accept);
end;

procedure TJvCustomListBox.DrawBackGround(ADC: HDC; const DoOffSet: Boolean);
var
  ImageRect, ClipBox, ClientRect, Temp: TRect;
  Canvas: TCanvas;
  ClipComplexity: Integer;
begin
 if (ADC = 0) or not Background.DoDraw or (csDestroying in ComponentState) then
    Exit;
  ClientRect := Self.ClientRect;
  ClipComplexity := GetClipBox(ADC, ClipBox);
  if ClipComplexity = NULLREGION then
    Exit; // nothing to paint
  if ClipComplexity = ERROR then
    ClipBox := ClientRect;

  if DoOffSet then
    OffsetRect(ClientRect, FLeftPosition, 0);

  Canvas := TCanvas.Create;
  try
    Canvas.Handle := ADC;
    if Canvas.Handle = 0 then
      Exit;
    if Background.FillMode = bfmStretch then
      Canvas.StretchDraw(ClientRect, Background.Image)
    else
    begin
      ImageRect := Background.Image.Canvas.ClipRect;
      while ImageRect.Top < ClientRect.Bottom do
      begin
        while ImageRect.Left < ClientRect.Right do
        begin
          if IntersectRect(Temp, ClipBox, ImageRect) then
            Canvas.Draw(ImageRect.Left, ImageRect.Top, Background.Image);
          OffsetRect(ImageRect, ImageRect.Right - ImageRect.Left, 0);
        end;
        OffsetRect(ImageRect, -ImageRect.Left,
          ImageRect.Bottom - ImageRect.Top);
      end;
    end;
  finally
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

procedure TJvCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  if csDestroying in ComponentState then
    Exit;
  if Assigned(OnDrawItem) then
    inherited DrawItem(Index, Rect, State)
  else
  begin
    { Call the drawing code. This is isolated in its own public routine
      so a OnDrawItem handler can use it, too. }
    DefaultDrawItem(Index, Rect, State);
    if FShowFocusRect and (odFocused in State) then
      Canvas.DrawFocusRect(Rect);
  end;
end;

procedure TJvCustomListBox.EndRedraw;
var
  R: TRect;
begin
  SendMessage(Handle, WM_SETREDRAW, Ord(True), 0);
  R := Rect(0, 0, Width, Height);
  InvalidateRect(Handle, @R, True);
end;

procedure TJvCustomListBox.SetConsumerService(Value: TJvDataConsumer);
begin
end;

procedure TJvCustomListBox.ConsumerServiceChanging(Sender: TJvDataConsumer;
  Reason: TJvDataConsumerChangeReason);
begin
  { If we're changing providers, make sure a list box is created; this will post the saved list back
    now instead of after a provider is assigned (which will then be deselected again as the string
    list is changed). }
  if (Reason = ccrProviderSelect) and not (csDestroying in ComponentState) then
    HandleNeeded;
  if (Reason = ccrProviderSelect) and IsProviderSelected and not FProviderToggle then
  begin
    FProviderIsActive := False;
    FProviderToggle := True;
  end
  else
  if (Reason = ccrProviderSelect) and not IsProviderSelected and not FProviderToggle and
      not TJvListBoxStrings(Items).UseInternal then
    TJvListBoxStrings(Items).MakeListInternal;
end;

procedure TJvCustomListBox.ConsumerServiceChanged(Sender: TJvDataConsumer;
  Reason: TJvDataConsumerChangeReason);
begin
  if (Reason = ccrProviderSelect) and not IsProviderSelected and not FProviderToggle then
  begin
    FProviderToggle := True;
    FProviderIsActive := True;
    RecreateWnd;
{    if not TJvListBoxStrings(Items).UseInternal then
    begin
      TJvListBoxStrings(Items).MakeListInternal;
      RecreateWnd;
    end;}
  end
  else
  if (Reason = ccrProviderSelect) and not IsProviderSelected and FProviderToggle and
    TJvListBoxStrings(Items).UseInternal then
  begin
    RecreateWnd;
    TJvListBoxStrings(Items).ActivateInternal; // apply internal string list to list box
{  end