jvcustomitemviewer.pas

East make Tray Icon in delphi

procedure TJvCustomItemViewer.DoReduceMemory;
var
  I: Integer;
begin
  if Options.ReduceMemoryUsage then
  begin
    for I := 0 to FTopLeftIndex - 1 do
      if FItems[I] <> nil then
        Items[I].ReduceMemoryUsage;
    for I := FBottomRightIndex + 1 to Count - 1 do
      if FItems[I] <> nil then
        Items[I].ReduceMemoryUsage;
  end;
end;

procedure TJvCustomItemViewer.DrawItem(Index: Integer; State: TCustomDrawState;
  Canvas: TCanvas; ItemRect, TextRect: TRect);
begin
  if Assigned(FOnDrawItem) then
    FOnDrawItem(Self, Index, State, Canvas, ItemRect, TextRect);
end;

procedure TJvCustomItemViewer.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount <= 0 then
  begin
    FUpdateCount := 0;
    UpdateAll;
    Invalidate;
  end;
end;

function TJvCustomItemViewer.FindFirstSelected: Integer;
begin
  for Result := 0 to Count - 1 do
    if cdsSelected in Items[Result].State then
      Exit;
  Result := -1;
end;

function TJvCustomItemViewer.FindLastSelected: Integer;
begin
  for Result := Count - 1 downto 0 do
    if cdsSelected in Items[Result].State then
      Exit;
  Result := -1;
end;

function TJvCustomItemViewer.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TJvCustomItemViewer.GetDragImages: TDragImageList;
var
  B: TBitmap;
  P: TPoint;
  I: Integer;
  ItemRect, TextRect: TRect;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  I := ItemAtPos(P.X, P.Y, True);
  // create an image of the currently selected item
  if I >= 0 then
  begin
    if FDragImages = nil then
      FDragImages := TViewerDrawImageList.Create(Self);
    FDragImages.Clear;
    ItemRect := Rect(0, 0, ItemSize.cx, ItemSize.cy);
    InflateRect(ItemRect, -Options.HorzSpacing, -Options.VertSpacing);
    B := TBitmap.Create;
    try
      B.Width := ItemSize.cx;
      B.Height := ItemSize.cy;
      if Options.ShowCaptions then
        TextRect := GetTextRect('Wg', ItemRect)
      else
        TextRect := Rect(0, 0, 0, 0);
      DrawItem(I, Items[I].State + [cdsSelected, cdsFocused, cdsHot], B.Canvas, ItemRect, TextRect);
      FDragImages.Width := ItemSize.cx;
      FDragImages.Height := ItemSize.cy;
      FDragImages.AddMasked(B, B.TransparentColor);
    finally
      B.Free;
    end;
    //    FDragImages.SetDragImage(0, 0, 0);
    ItemRect := Self.ItemRect(I, True);
    FDragImages.SetDragImage(0, P.X - ItemRect.Left, P.Y - ItemRect.Top);
    Result := FDragImages;
    SelectedIndex := I;
    Paint;
  end
  else
    Result := inherited GetDragImages;
end;

function TJvCustomItemViewer.GetItemClass: TJvViewerItemClass;
begin
  Result := TJvViewerItem;
end;

function TJvCustomItemViewer.GetItems(Index: Integer): TJvViewerItem;
begin
  Result := FItems[Index];
  if Result = nil then
    Result := GetItemClass.Create(Self);
  FItems[Index] := Result;
end;

function TJvCustomItemViewer.GetItemState(Index: Integer): TCustomDrawState;
begin
  // (p3) safer than calling Items[Index].State directly
  if (Index >= 0) and (Index < Count) then
    Result := Items[Index].State
  else
    Result := [];
end;

function TJvCustomItemViewer.GetOptionsClass: TJvItemViewerOptionsClass;
begin
  Result := TJvCustomItemViewerOptions;
end;

function TJvCustomItemViewer.GetSelected(Item: TJvViewerItem): Boolean;
begin
  Result := (Item <> nil) and (cdsSelected in Item.State);
end;

function TJvCustomItemViewer.GetTextHeight: Integer;
var
  R: TRect;
  S: WideString;
begin
  S := 'Wg';
  R := Rect(0, 0, 100, 100);
  Result := ViewerDrawText(Canvas, PWideChar(S), Length(S),
    R, DT_END_ELLIPSIS or DT_CALCRECT, taCenter, tlTop, False) + 4;
  //  Result := Canvas.TextHeight('Wg');
end;

function TJvCustomItemViewer.GetTextRect(const S: WideString; var ItemRect: TRect): TRect;
var
  TextHeight: Integer;
begin
  TextHeight := GetTextHeight;

  case Options.Layout of
    tlTop:
      begin
        Result := Rect(ItemRect.Left, ItemRect.Top, ItemRect.Right, ItemRect.Top + TextHeight);
        ItemRect.Top := Result.Top + TextHeight;
      end;
    tlBottom:
      begin
        Result := Rect(ItemRect.Left, ItemRect.Bottom - TextHeight,
          ItemRect.Right, ItemRect.Bottom);
        ItemRect.Bottom := Result.Top;
      end;
    tlCenter:
      begin
        Result := Rect(ItemRect.Left, ItemRect.Top + (RectHeight(ItemRect) - TextHeight) div 2 + 1,
          ItemRect.Right, 0);
        Result.Bottom := Result.Top + TextHeight;
      end;
  end;
end;

function TJvCustomItemViewer.IndexOf(Item: TJvViewerItem): Integer;
begin
  // (p3) need to do it like this because items aren't created until Items[] is called
  for Result := 0 to Count - 1 do
    if Items[Result] = Item then
      Exit;
  Result := -1;
end;

procedure TJvCustomItemViewer.IndexToColRow(Index: Integer; var ACol, ARow: Integer);
begin
  Assert(FCols > 0);
  ACol := Index mod FCols;
  ARow := Index div FCols;
end;

procedure TJvCustomItemViewer.Insert(Index: Integer; AItem: TJvViewerItem);
begin
  Assert(AItem is GetItemClass);
  FItems.Insert(Index,AItem);
  Inserted(AItem);
end;

procedure TJvCustomItemViewer.InvalidateClipRect(R: TRect);
begin
  if IsRectEmpty(R) then
    R := Canvas.ClipRect;
  InvalidateRect(Handle, @R, True);
end;

function TJvCustomItemViewer.ItemAtPos(X, Y: Integer; Existing: Boolean): Integer;
var
  ARow, ACol: Integer;
begin
  Result := -1;
  if (FItemSize.cx < 1) or (FItemSize.cy < 1) then
    Exit;
  Dec(X, FTopLeft.X);
  Dec(Y, FTopLeft.Y);
  ACol := X div FItemSize.cx;
  ARow := Y div FItemSize.cy;
  if ((ACol < 0) or (ARow < 0) or (ACol >= FCols) or (ARow >= FRows)) and Existing then
    Exit;
  Result := ColRowToIndex(ACol, ARow);
  if (Result >= Count) and Existing then
    Result := -1;
end;

procedure TJvCustomItemViewer.ItemChanged(Item: TJvViewerItem);
var
  I: Integer;
begin
  if FUpdateCount <> 0 then
    Exit;
  if (Item <> nil) then
  begin
    I := FItems.IndexOf(Item);
    if I > -1 then
    begin
      if (cdsSelected in Item.State) and not Options.MultiSelect then
        FSelectedIndex := I;
      InvalidateClipRect(ItemRect(I, True));
    end;
  end
  else
    Changed;
  if Assigned(FOnItemChanged) then
    FOnItemChanged(Self, Item);
end;

procedure TJvCustomItemViewer.ItemChanging(Item: TJvViewerItem;
  var AllowChange: Boolean);
begin
  AllowChange := True;
  if Assigned(FOnItemChanging) then
    FOnItemChanging(Self, Item, AllowChange);
end;

function TJvCustomItemViewer.ItemRect(Index: Integer; IncludeSpacing: Boolean): TRect;
var
  ACol, ARow: Integer;
begin
  IndexToColRow(Index, ACol, ARow);
  if (Index < 0) or (Index >= Count) then
  begin
    Result := Rect(0, 0, 0, 0);
    Exit;
  end;
  Result := Rect(0, 0, FItemSize.cx, FItemSize.cy);
  OffsetRect(Result, FTopLeft.X + FItemSize.cx * ACol,
    FTopLeft.Y + FItemSize.cy * ARow);
  if not IncludeSpacing then
    InflateRect(Result, -Options.HorzSpacing, -Options.VertSpacing);
end;

procedure TJvCustomItemViewer.KeyDown(var Key: Word; Shift: TShiftState);
var
  LIndex: Integer;
begin
  inherited KeyDown(Key, Shift);
  LIndex := -1;
  if Focused and (Shift * KeyboardShiftStates = []) then
    case Key of
      VK_UP:
        LIndex := SelectedIndex - FCols;
      VK_DOWN:
        LIndex := SelectedIndex + FCols;
      VK_LEFT:
        LIndex := SelectedIndex - 1;
      VK_RIGHT:
        LIndex := SelectedIndex + 1;
      VK_SPACE:
        Click;
    end;
  if (LIndex >= 0) and (LIndex < Count) then
  begin
    if Options.MultiSelect then
      DoUnSelectItems(LIndex);
    SelectedIndex := LIndex;
    ScrollIntoView(LIndex);
  end;
end;

procedure TJvCustomItemViewer.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  CheckHotTrack;
end;

procedure TJvCustomItemViewer.Paint;
var
  I: Integer;
  ItemRect, TextRect, AClientRect: TRect;

  function IsRectVisible(const R: TRect): Boolean;
  begin
    Result := (R.Top < AClientRect.Bottom) and (R.Bottom > AClientRect.Top) and
      (R.Left < AClientRect.Right) and (R.Right > AClientRect.Left)
  end;

begin
  //  inherited Paint;
  if FUpdateCount <> 0 then
    Exit;
  AClientRect := ClientRect;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := Font.Color;
  Canvas.Font := Font;
  //  Canvas.FillRect(Canvas.ClipRect);
  if (FUpdateCount <> 0) or (Count = 0) or
    (ClientWidth <= 0) or (ClientHeight <= 0) or
    (FItemSize.cx <= 0) or (FItemSize.cy <= 0) then
    Exit;
  ItemRect := Rect(0, 0, ItemSize.cx, ItemSize.cy);
  InflateRect(ItemRect, -Options.HorzSpacing, -Options.VertSpacing);
  if Options.ShowCaptions then
  begin
    TextRect := GetTextRect('Wg', ItemRect);
    OffsetRect(TextRect, FTopLeft.X, FTopLeft.Y);
  end
  else
    TextRect := Rect(0, 0, 0, 0);
  OffsetRect(ItemRect, FTopLeft.X, FTopLeft.Y);
  //  Canvas.FillRect(Rect(Left, Top, Width, Height));
  for I := 0 to Count - 1 do
    if not Items[I].Deleting then
    begin
      if not Options.LazyRead or IsRectVisible(ItemRect) then
        DrawItem(I, GetItemState(I), Canvas, ItemRect, TextRect);
      if (I + 1) mod FCols = 0 then
      begin
        OffsetRect(ItemRect, -ItemRect.Left + Options.HorzSpacing + FTopLeft.X, ItemSize.cy);
        if Options.ShowCaptions then
          OffsetRect(TextRect, -TextRect.Left + Options.HorzSpacing + FTopLeft.X, ItemSize.cy);
      end
      else
      begin
        OffsetRect(ItemRect, ItemSize.cx, 0);
        if Options.ShowCaptions then
          OffsetRect(TextRect, ItemSize.cx, 0);
      end;
    end;
end;

procedure TJvCustomItemViewer.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
    FCanvas.Handle := DC;
    try
      TControlCanvas(FCanvas).UpdateTextFlags;
      Paint;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

procedure TJvCustomItemViewer.ScrollIntoView(Index: Integer);
var
  Rect: TRect;
begin
  Rect := ItemRect(Index, True);
  Dec(Rect.Left, HorzScrollBar.Margin);
  Inc(Rect.Right, HorzScrollBar.Margin);
  Dec(Rect.Top, VertScrollBar.Margin);
  Inc(Rect.Bottom, VertScrollBar.Margin);
  if Rect.Left < 0 then
    with HorzScrollBar do
      Position := Position + Rect.Left
  else
  if Rect.Right > ClientWidth then
  begin
    if Rect.Right - Rect.Left > ClientWidth then
      Rect.Right := Rect.Left + ClientWidth;
    with HorzScrollBar do
      Position := Position + Rect.Right - ClientWidth;
  end;
  if Rect.Top < 0 then
    with VertScrollBar do
      Position := Position + Rect.Top
  else
  if Rect.Bottom > ClientHeight then
  begin
    if Rect.Bottom - Rect.Top > ClientHeight then
      Rect.Bottom := Rect.Top + ClientHeight;
    with VertScrollBar do
      Position := Position + Rect.Bottom - ClientHeight;
  end;
  UpdateAll;
  Invalidate;
end;

procedure TJvCustomItemViewer.SetBorderStyle(const Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TJvCustomItemViewer.SetCount(const Value: Integer);
var
  I: Integer;
  Obj: TJvViewerItem;
begin
  if Value <> Count then
  begin
    BeginUpdate;
    try
      if Value = 0 then
        Clear
      else
      begin
        for I := FItems.Count - 1 downto Value - 1 do
        begin
          Obj := TJvViewerItem(FItems[I]);
          FItems[I] := nil; // avoid concurrent access to a destroying item
          FreeAndNil(Obj);
        end;
        FItems.Count := Value;
        // (p3) new items are nil, but that's OK because we create them as needed
      end;
      if FSelectedIndex >= Value then
        FSelectedIndex := -1;
    finally
      EndUpdate;
      UpdateAll;
      if HandleAllocated then
        InvalidateClipRect(Canvas.ClipRect);
    end;
  end;
end;

procedure TJvCustomItemViewer.SetItems(Index: Integer;
  const Value: TJvViewerItem);
var
  Item: TJvViewerItem;
begin
  Item := FItems[Index];
  if Item <> Value then
  begin
    if Item = nil then
      Item := GetItemClass.Create(Self);
    Item.Assign(Value);
    FItems[Index] := Item;
    Changed;
  end;
end;

procedure TJvCustomItemViewer.SetOptions(const Value: TJvCustomItemViewerOptions);
begin
  FOptions.Assign(Value);
  Changed;
end;

procedure TJvCustomItemViewer.SetSelected(Item: TJvViewerItem;
  const Value: Boolean);
begin
  if (Item <> nil) and not (cdsSelected in Item.State) then
    Item.State := Item.State + [cdsSelected];
end;

procedure TJvCustomItemViewer.SetSelectedIndex(const Value: Integer);
begin
  //  if (FSelectedIndex <> Value) then
  begin
    if (FSelectedIndex >= 0) and (FSelectedIndex < Count) and (cdsSelected in Items[FSelectedIndex].State) then
      Items[FSelectedIndex].State := Items[FSelectedIndex].State - [cdsSelected];

    FSelectedIndex := Value;

    if (Value >= 0) and (Value < Count) and not (cdsSelected in Items[Value].State) then
      Items[Value].State := Items[Value].State + [cdsSelected];
  end;
end;

procedure TJvCustomItemViewer.ToggleSelection(Index: Integer;
  SetSelection: Boolean);
begin
  if cdsSelected in Items[Index].State then
  begin
    Items[Index].State := Items[Index].State - [cdsSelected];
    if Index = SelectedIndex then
      SelectedIndex := FindFirstSelected;
  end
  else
  begin
    Items[Index].State := Items[Index].State + [cdsSelected];