jvglistbox.pas

East make Tray Icon in delphi

    if R.Bottom = 0 then
      R.Bottom := 14;
    Msg.MeasureItemStruct^.itemHeight := R.Bottom - R.Top;
    if (ItemStyle.Bevel.Inner <> bvNone) or (ItemSelStyle.Bevel.Inner <> bvNone) then
      if (ItemStyle.Bevel.Bold) or (ItemSelStyle.Bevel.Bold) then
        Inc(Shift, 2)
      else
        Inc(Shift);
    if (ItemStyle.Bevel.Outer <> bvNone) or (ItemSelStyle.Bevel.Outer <> bvNone) then
      if (ItemStyle.Bevel.Bold) or (ItemSelStyle.Bevel.Bold) then
        Inc(Shift, 2)
      else
        Inc(Shift);
    if (ItemStyle.TextStyle <> fstNone) or (ItemSelStyle.TextStyle <> fstNone) then
      Inc(Shift, 2);
    if Assigned(FGlyphs) and (FGlyphs.Height > Integer(itemHeight)) then
      itemHeight := FGlyphs.Height;
    Inc(Msg.MeasureItemStruct^.itemHeight, Shift);
    if FItemHeight > 0 then
      Msg.MeasureItemStruct^.itemHeight := FItemHeight;
  end;
  //  Msg.MeasureItemStruct^.itemHeight:=13;
end;

procedure TJvgListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  Index: Integer;
  R, TxtRect: TRect;
  State: TOwnerDrawState;
  ItemStyle: TJvgListBoxItemStyle;
  LSelected, LDrawWallpaper: Boolean;
  DC: HDC;
  Image: TBitmap;
  TargetCanvas: TCanvas;
  ItemColor, FontColor, GrFromColor, GrToColor: TColor;

  procedure DrawGlyph(R: TRect);
  var
    I, FTranspColor: Integer;
    OldRect: TRect;
  begin
    if (FGlyphs = nil) or (FGlyphs.Count = 0) then
      Exit;
    OldRect := R;
    Inc(R.Top);
    Inc(R.Left);
    case FGlyphsAlign.Horizontal of
      fhaCenter:
        OffsetRect(R, (R.Right - R.Left - Glyphs.Width) div 2, 0);
      fhaRight:
        OffsetRect(R, R.Right - R.Left - Glyphs.Width - 1, 0);
    end;
    case GlyphsAlign.Vertical of
      fvaCenter:
        OffsetRect(R, 0, (R.Bottom - R.Top - Glyphs.Height) div 2);
      fvaBottom:
        OffsetRect(R, 0, R.Bottom - R.Top - Glyphs.Height - 1);
    end;

    if fboSingleGlyph in Options then
      I := 0
    else
    if Index < NumGlyphs then
      I := Index
    else
      I := -1;

    if I >= 0 then
    begin
      FGlyphs.GetBitmap(I, FTmpBitmap);
      if LSelected and (fboChangeGlyphColor in Options) then
        ChangeBitmapColor(FTmpBitmap, FChangeGlyphColor.FromColor,
          FChangeGlyphColor.ToColor);

      if FAutoTransparentColor = ftcUser then
        FTranspColor := FTransparentColor
      else
        FTranspColor := GetTransparentColor(FTmpBitmap, FAutoTransparentColor);

      //      if LDrawWallpaper then
      CreateBitmapExt(DC, FTmpBitmap, Rect(0, 0, 100, 100), R.Left, R.Top,
        fwoNone, fdsDefault, True, FTranspColor, clBlack);
        //      else
        //      begin
 //        ChangeBitmapColor( FTmpBitmap, FTranspColor, ItemStyle.Color );
 //        BitBlt( DC, R.Left, R.Top, FTmpBitmap.Width, FTmpBitmap.Height, FTmpBitmap.Canvas.Handle,
 //                0, 0, SRCCOPY );
 //      end;
    end;
  end;

  procedure DrawWallpaper;

    procedure FillTiled(R: TRect; YOffset: Integer);
    var
      Y, X1, Y1, IWidth, IHeight: Integer;
    begin
      IWidth := Min(R.Right - R.Left + 1, FWallpaperBmp.Width);
      IHeight := Min(R.Bottom - R.Top, FWallpaperBmp.Height);
      X1 := R.Left;
      Y1 := R.Top;
      Y := Y1;
      while X1 < R.Right do
      begin
        if X1 + IWidth > R.Right then
          IWidth := R.Right - X1;
        while Y1 < R.Bottom do
        begin
          //if Y1+IHeight > R.Bottom then IHeight:=R.Bottom-Y1;
          BitBlt(DC, X1, Y1, IWidth, IHeight, FWallpaperBmp.Canvas.Handle,
            0, YOffset, SRCCOPY);
          Inc(Y1, IHeight);
          YOffset := 0;
        end;
        Inc(X1, IWidth);
        Y1 := Y;
      end;
    end;

  begin
    if Assigned(FWallpaperBmp) then
    begin
      case WallpaperOption of
        fwlStretch:
          Canvas.StretchDraw(R, FWallpaperBmp);
        fwlTile:
          FillTiled(R, 0);
        fwlGlobal:
          begin {
            if fboBufferedDraw in Options then with Msg.DrawItemStruct^ do
              Y :=  R.Top + rcItem.Top else Y := R.Top;

            Y := Y-trunc((Y div FWallpaperBmp.Height)*FWallpaperBmp.Height);
            FillTiled( R, Y );

            if Msg.DrawItemStruct^.itemID = UINT(Items.Count-1) then
            begin
              if fboBufferedDraw in Options then with Msg.DrawItemStruct^ do
                Y :=  R.Bottom + rcItem.Top else Y := R.Bottom;
              R2 := Rect ( R.Left-1, R.Bottom+2, R.Right+1, Height );
              Y := Y-trunc((Y div FWallpaperBmp.Height)*FWallpaperBmp.Height);
              FillTiled( R2, Y );
            end;}
            BitBlt(DC, R.Left + 1, R.Top, R.Right - R.Left - 1, R.Bottom -
              R.Top, FWallpaperBmp.Canvas.Handle, 0, R.Top, SRCCOPY);

            with Msg.DrawItemStruct^ do
              if itemID = UINT(Items.Count - 1) then
                BitBlt(DC, rcItem.Left, rcItem.Bottom, rcItem.Right -
                  rcItem.Left, Height, FWallpaperBmp.Canvas.Handle,
                  rcItem.Left, rcItem.Bottom, SRCCOPY);
          end;
      else
        BitBlt(DC, R.Left, R.Top, Min(FWallpaperBmp.Width, R.Right - R.Left),
          Min(FWallpaperBmp.Height, R.Bottom - R.Top),
          FWallpaperBmp.Canvas.Handle, 0, 0, SRCCOPY);
      end;
    end;
  end;

begin
  if Items.Count = 0 then
    Exit;

  if not FWallpaper.Empty then
    FWallpaperBmp := FWallpaper
  else
  if Assigned(FWallpaperImage) and Assigned(FWallpaperImage.Picture) and
    Assigned(FWallpaperImage.Picture.Bitmap) then
    FWallpaperBmp := FWallpaperImage.Picture.Bitmap
  else
    FWallpaperBmp := nil;

  FUseWallpaper := IsItAFilledBitmap(FWallpaperBmp);

  with Msg.DrawItemStruct^ do
  begin
    Index := UINT(itemID);
    if Index = -1 then
    begin
      if IsItAFilledBitmap(FWallpaperBmp) then
        BitBlt(hDC, 0, 0, Width, Height, FWallpaperBmp.Canvas.Handle, 0, 0, SRCCOPY);
      Exit;
    end;

    InitState(State, WordRec(LongRec(ItemState).Lo).Lo);

    Canvas.Handle := hDC;
    R := rcItem;
  end;
  Inc(R.Left, IndentLeft);
  Dec(R.Right, IndentRight);
  if fboBufferedDraw in Options then
  begin
    Image := TBitmap.Create;
    Image.Width := R.Right - R.Left;
    Image.Height := R.Bottom - R.Top;
    TargetCanvas := Image.Canvas;
    Dec(R.Bottom, R.Top);
    R.Top := 0;
  end
  else
  begin
    Image := nil;
    TargetCanvas := Canvas;
  end;
  DC := TargetCanvas.Handle;

  LSelected := (State = [odSelected, odFocused]) or (State = [odSelected]);
  if LSelected then
    ItemStyle := FItemSelStyle
  else
    ItemStyle := FItemStyle;

  LDrawWallpaper := (not (LSelected and (FItemStyle.Color <> FItemSelStyle.Color))) and FUseWallpaper;

  //...DrawLBItem
  Inc(R.Left);
  Dec(R.Right);
  Dec(R.Bottom);
  ItemColor := ItemStyle.Color;
  if Assigned(FOnGetItemColor) then
    FOnGetItemColor(Self, Index, ItemColor);
  if fboAutoCtl3DColors in Options then
  begin
    ThreeDColors.CreateAuto3DColors(ItemColor);
    ThreeDColors.MakeGlobal;
  end;
  R := DrawBoxEx(DC, R, ItemStyle.Bevel.Sides, ItemStyle.Bevel.Inner,
    ItemStyle.Bevel.Outer, ItemStyle.Bevel.Bold, ItemColor, LDrawWallpaper);
  if fboAutoCtl3DColors in Options then
    ThreeDColors.MakeLocal;

  Dec(R.Left);
  Inc(R.Right);
  Inc(R.Bottom);
  if ItemStyle.Gradient.Active then
    with ItemStyle do
    begin
      GrFromColor := Gradient.RGBFromColor;
      GrToColor := Gradient.RGBToColor;
      if ItemColor > 0 then
      begin
        if fboItemColorAsGradientFrom in Options then
          Gradient.RGBFromColor := ItemColor;
        if fboItemColorAsGradientTo in Options then
          Gradient.RGBToColor := ItemColor;
      end;
      GradientBox(DC, R, Gradient, Integer(psSolid), 1);
      Gradient.RGBFromColor := GrFromColor;
      Gradient.RGBToColor := GrToColor;
    end;

  if LDrawWallpaper then
    DrawWallpaper;

  if Assigned(FGlyphs) then
  begin
    DrawGlyph(R);
    if fboExcludeGlyphs in Options then
      if FGlyphsAlign.Horizontal = fhaLeft then
        R.Left := R.Left + FGlyphs.Width
      else
      if FGlyphsAlign.Horizontal = fhaRight then
        R.Right := R.Right - FGlyphs.Width
  end;
  Inc(R.Left, FLeftIndent);
  SetBkMode(DC, TRANSPARENT);
  Inc(R.Left);
  Dec(R.Right, 2);

  TxtRect := R;
  Inc(TxtRect.Left, TextIndent);
  if not (fboHideText in Options) then
  begin
    if Assigned(OnGetItemFontColor) then
    begin
      ItemColor := ItemStyle.Font.Color;
      OnGetItemFontColor(Self, Index, ItemColor);
      ItemStyle.Font.Color := ItemColor;
    end;
    FontColor := ItemStyle.Font.Color;
    if HotTrackingItemIndex = Index then
    begin
      ItemStyle.Font.Color := FHotTrackColor;
      //      if LSelected then ItemStyle.Font.Color := clWhite;
    end;
    DrawTextInRect(TargetCanvas.Handle, TxtRect, Items[Index],
      ItemStyle.TextStyle, ItemStyle.Font, FTextAlign_);
    ItemStyle.Font.Color := FontColor;
  end;
  if TargetCanvas <> Canvas then
    BitBlt(Msg.DrawItemStruct^.hDC, Msg.DrawItemStruct^.rcItem.Left,
      Msg.DrawItemStruct^.rcItem.Top,
      Image.Width, Image.Height, Image.Canvas.Handle, 0, 0, SRCCOPY);

  with Msg.DrawItemStruct^ do
    if (odFocused in State) and (fboShowFocus in Options) then
      DrawFocusRect(hDC, rcItem);

  Image.Free;
  if Assigned(FOnDrawItem) then
    FOnDrawItem(Self, Msg);
  if Assigned(FOnChange) then
  begin
    FOldSelItemIndex := FSelItemIndex;
    FSelItemIndex := ItemIndex;
    if FOldSelItemIndex <> FSelItemIndex then
      FOnChange(Self, FOldSelItemIndex, FSelItemIndex);
  end;
end;

procedure TJvgListBox.CMMouseLeave(var Msg: TMessage);
var
  R: TRect;
begin
  inherited;
  if HotTrackingItemIndex <> -1 then
  begin
    R := ItemRect(HotTrackingItemIndex);
    HotTrackingItemIndex := -1;
    InvalidateRect(Handle, @R, False);
  end;
end;

procedure TJvgListBox.WMMouseMove(var Msg: TMessage);
var
  Pt: TPoint;
  R: TRect;
  ItemIndex: Integer;
begin
  inherited;
  if not (fboHotTrack in Options) and not (fboHotTrackSelect in Options) then
    Exit;
  Pt.X := LOWORD(Msg.lParam);
  Pt.Y := HiWord(Msg.lParam);
  ItemIndex := ItemAtPos(Pt, True);

  if ItemIndex = HotTrackingItemIndex then
    Exit;

  if fboHotTrackSelect in Options then
  begin
    Self.ItemIndex := ItemIndex;
    InvalidateRect(Handle, nil, False);
    Exit;
  end;

  if HotTrackingItemIndex <> -1 then
  begin
    R := ItemRect(HotTrackingItemIndex);
    InvalidateRect(Handle, @R, False);
  end;
  HotTrackingItemIndex := ItemIndex;
  if HotTrackingItemIndex <> -1 then