jvglistbox.pas

East make Tray Icon in delphi

  begin
    R := ItemRect(HotTrackingItemIndex);
    InvalidateRect(Handle, @R, False);
  end;
end;

function TJvgListBox.GetDragImages: TDragImageList;
begin
  if FDragImage.Count > 0 then
    Result := FDragImage
  else
    Result := nil;
end;

procedure TJvgListBox.CreateDragImage;
var
  HotSpotX, HotSpotY: Integer;
  TranspColor: TColor;
  Bmp: TBitmap;
  Pt: TPoint;
  R: TRect;
begin
  FDragImage.Clear;
  if ItemIndex = -1 then
    Exit;
  R := ItemRect(ItemIndex);

  Bmp := TBitmap.Create;
  with Bmp do
  try
    GetCursorPos(Pt);
    with ScreenToClient(Pt) do
    begin
      HotSpotX := X - R.Left;
      HotSpotY := Y - R.Top
    end;
    if Assigned(FOnGetDragImage) then
      FOnGetDragImage(Self, Bmp, TranspColor, HotSpotX, HotSpotY)
    else
    begin
      Width := R.Right - R.Left;
      Height := R.Bottom - R.Top;
      Canvas.Font := ItemSelStyle.Font;
      Canvas.DrawFocusRect(Rect(0, 0, Width, Height));
      Canvas.Brush.Style := bsClear;
      Canvas.TextOut(1, 1, Items[ItemIndex]);
      TranspColor := clWhite;
    end;
    FDragImage.Width := Width;
    FDragImage.Height := Height;
    FDragImage.AddMasked(Bmp, TranspColor);
    FDragImage.SetDragImage(0, HotSpotX, HotSpotY);
  finally
    Bmp.Free;
  end;
end;

procedure TJvgListBox.DoStartDrag(var DragObject: TDragObject);
begin
  inherited DoStartDrag(DragObject);
  CreateDragImage;
end;

procedure TJvgListBox.SetAutoTransparentColor(Value: TglAutoTransparentColor);
begin
  if FAutoTransparentColor <> Value then
  begin
    FAutoTransparentColor := Value;
    Invalidate;
  end;
end;

function TJvgListBox.GetWallpaper: TBitmap;
begin
  if not Assigned(FWallpaper) then
    FWallpaper := TBitmap.Create;
  Result := FWallpaper;
end;

procedure TJvgListBox.SetWallpaper(Value: TBitmap);
begin
  Wallpaper.Assign(Value);
  Invalidate;
end;

procedure TJvgListBox.SetWallpaperImage(Value: TImage);
begin
  FWallpaperImage := Value;
  Invalidate;
end;

procedure TJvgListBox.SetWOpt(Value: TglLBWallpaperOption);
begin
  FWallpaperOption := Value;
  Invalidate;
end;

procedure TJvgListBox.SetNumGlyphs(Value: Word);
begin
  if Value >= 1 then
  begin
    FNumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TJvgListBox.SetGlyphs(Value: TImageList);
begin
  FGlyphs := Value;
  Invalidate;
end;

procedure TJvgListBox.SetItemHeight(Value: Word);
begin
  FItemHeight := Value;
  RecalcHeights;
end;

procedure TJvgListBox.SetAlign;
begin
  if fboWordWrap in Options then
    FTextAlign_ := DT_WORDBREAK or DT_NOPREFIX
  else
    FTextAlign_ := DT_SINGLELINE or DT_NOPREFIX;
  case FTextAlign.Horizontal of
    fhaLeft:
      FTextAlign_ := FTextAlign_ or DT_LEFT;
    fhaCenter:
      FTextAlign_ := FTextAlign_ or DT_CENTER;
  else
    FTextAlign_ := FTextAlign_ or DT_RIGHT;
  end;
  case FTextAlign.Vertical of
    fvaTop:
      FTextAlign_ := FTextAlign_ or DT_TOP;
    fvaCenter:
      FTextAlign_ := FTextAlign_ or DT_VCENTER;
  else
    FTextAlign_ := FTextAlign_ or DT_BOTTOM;
  end;
end;

procedure TJvgListBox.SetTransparentColor(Value: TColor);
begin
  FTransparentColor := Value;
  if FAutoTransparentColor <> ftcUser then
    Invalidate;
end;

procedure TJvgListBox.SetHotTrackColor(Value: TColor);
var
  R: TRect;
begin
  if FHotTrackColor = Value then
    Exit;
  FHotTrackColor := Value;
  if HotTrackingItemIndex <> -1 then //...user can program hottrack blinking effect!
  begin
    R := ItemRect(HotTrackingItemIndex);
    InvalidateRect(Handle, @R, False);
  end;
end;

procedure TJvgListBox.SetOptions(Value: TglListBoxOptions);
begin
  if FOptions = Value then
    Exit;
  if not (csLoading in ComponentState) then
    {  if (fboTransparent in Value) and not (fboTransparent in FOptions)then
      begin
        FWallpaper.Width := Width; FWallpaper.Height := Height;
        GetParentImageRect( Self, Bounds(Left,Top,Width,Height),
                     FWallpaper.Canvas.Handle );
        FWallpaperBmp := FWallpaper;
        FUseWallpaper := True;
      end;  }
    FOptions := Value;
  SetAlign;
  RecalcHeights;
  Invalidate;
end;

function TJvgListBox.GetSelectedObject: Pointer;
begin
  if ItemIndex >= 0 then
    Result := Items.Objects[ItemIndex]
  else
    Result := nil;
end;

function TJvgListBox.GetSelCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Items.Count - 1 do
    if Selected[I] then
      Inc(Result);
end;

procedure TJvgListBox.RecalcHeights;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
  begin
    if Assigned(Items.Objects[I]) then
      Items.InsertObject(I, Items.Strings[I], Items.Objects[I])
    else
      Items.Insert(I, Items.Strings[I]);
    Items.Delete(I + 1);
  end;
  Items.EndUpdate;
end;

procedure TJvgListBox.SmthChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
  begin
    RecalcHeights;
    SetAlign;
    Invalidate;
  end;
end;

//=== { TJvgCheckListBox } ===================================================

constructor TJvgCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCheckWidth := 14;
  FCheckHeight := 14;
  FLeftIndent := 22;
end;

procedure TJvgCheckListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  R: TRect;
  Index: Integer;
  State: TOwnerDrawState;
begin
  inherited;
  with Msg.DrawItemStruct^ do
  begin
    InitState(State, WordRec(LongRec(ItemState).Lo).Lo);

    Canvas.Handle := hDC;
    R := rcItem;
    Index := itemID;
  end;
  if Index < Items.Count then
  begin
    R.Right := R.Left + FCheckWidth + 5;
    DrawCheck(R, GetState(Index));
  end;
end;

function TJvgCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
  if Index > -1 then
    Result := TCheckBoxState(Items.Objects[Index])
  else
    Result := cbUnchecked;
end;

procedure TJvgCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState);
var
  DrawState: Integer;
  DrawRect: TRect;
begin
  case AState of
    cbChecked:
      DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
    cbUnchecked:
      DrawState := DFCS_BUTTONCHECK;
  else // cbGrayed
    DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
  end;
  DrawRect.Left := R.Left + (R.Right - R.Left - FCheckWidth) div 2;
  DrawRect.Top := R.Top + (R.Bottom - R.Top - FCheckWidth) div 2;
  DrawRect.Right := DrawRect.Left + FCheckWidth;
  DrawRect.Bottom := DrawRect.Top + FCheckHeight;

  DrawFrameControl(Canvas.Handle, DrawRect, DFC_BUTTON, DrawState);
end;

procedure TJvgListBox.InitState(var State: TOwnerDrawState; ByteState: Byte);
begin
  State := [];
  if ByteState and ODS_CHECKED <> 0 then
    Include(State, odChecked); //TOwnerDrawState
  if ByteState and ODS_COMBOBOXEDIT <> 0 then
    Include(State, odComboBoxEdit);
  if ByteState and ODS_DEFAULT <> 0 then
    Include(State, odDefault);
  if ByteState and ODS_DISABLED <> 0 then
    Include(State, odDisabled);
  if ByteState and ODS_FOCUS <> 0 then
    Include(State, odFocused);
  if ByteState and ODS_GRAYED <> 0 then
    Include(State, odGrayed);
  if ByteState and ODS_SELECTED <> 0 then
    Include(State, odSelected);
end;

function TJvgCheckListBox.GetChecked(Index: Integer): TCheckBoxState;
begin
  Result := TCheckBoxState(Items.Objects[Index]);
end;

procedure TJvgCheckListBox.SetChecked(Index: Integer; State: TCheckBoxState);
begin
  Items.Objects[Index] := Pointer(State);
end;

procedure TJvgCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  APoint: TPoint;
  Index: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    APoint.X := X;
    APoint.Y := Y;
    Index := ItemAtPos(APoint, True);
    case TCheckBoxState(Items.Objects[Index]) of
      cbUnchecked:
        Items.Objects[Index] := Pointer(cbChecked);
      cbChecked:
        Items.Objects[Index] := Pointer(cbUnchecked);
      cbGrayed:
       ;
    end;
    Invalidate;
  end;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.