jvcustomitemviewer.pas

East make Tray Icon in delphi

    if SetSelection then
      FSelectedIndex := Index;
  end;
end;

procedure TJvCustomItemViewer.ShiftSelection(Index: Integer; SetSelection: Boolean);
var
  I: Integer;
  AFromCol, AFromRow: Integer;
  AToCol, AToRow: Integer;
  ACurrCol, ACurrRow: Integer;

  function InRange(Value, Min, Max: Integer): Boolean;
  begin
    Result := (Value >= Min) and (Value <= Max);
  end;

  procedure Swap(var X, Y: Integer);
  var
    I: Integer;
  begin
    I := X;
    X := Y;
    Y := I;
  end;

begin
  BeginUpdate;
  try
    if SelectedIndex < 0 then
      SelectedIndex := 0;
    IndexToColRow(SelectedIndex, AFromCol, AFromRow);
    IndexToColRow(Index, AToCol, AToRow);
    if AFromCol > AToCol then
      Swap(AFromCol, AToCol);
    if AFromRow > AToRow then
      Swap(AFromRow, AToRow);
    for I := 0 to Count - 1 do
    begin
      IndexToColRow(I, ACurrCol, ACurrRow);
      // access private variables so we don't trigger any OnChange event(s) by accident
      if InRange(ACurrCol, AFromCol, AToCol) and InRange(ACurrRow, AFromRow, AToRow) then
        Items[I].FState := Items[I].FState + [cdsSelected]
      else
        Items[I].FState := Items[I].FState - [cdsSelected];
    end;
  finally
    EndUpdate;
  end;
end;

procedure TJvCustomItemViewer.DoUnSelectItems(ExcludeIndex: Integer);
var
  Item: TJvViewerItem;
begin
  if (ExcludeIndex >= 0) and (ExcludeIndex < Count) then
    Item := Items[ExcludeIndex]
  else
    Item := nil;
  PostMessage(Handle, CM_UNSELECTITEMS, Integer(Self), Integer(Item));
end;

procedure TJvCustomItemViewer.UpdateAll;
begin
  if (csDestroying in ComponentState) or (Parent = nil) then
    Exit;
  HandleNeeded;
  if not HandleAllocated then
    Exit;

  HorzScrollBar.Smooth := Options.Smooth;
  VertScrollBar.Smooth := Options.Smooth;
  HorzScrollBar.Tracking := Options.Tracking;
  VertScrollBar.Tracking := Options.Tracking;

  FItemSize.cx := Options.Width + Options.HorzSpacing;
  FItemSize.cy := Options.Height + Options.VertSpacing;
  if Options.ShowCaptions then
    Inc(FItemSize.cy, GetTextHeight);
  if (FItemSize.cy < 1) or (FItemSize.cx < 1) or (Count < 1) then
    Exit;
  if Options.ScrollBar = tvHorizontal then
  begin
    if Options.AutoCenter then
      FRows := ClientHeight div FItemSize.cy
    else
      FRows := (Height + FItemSize.cy div 3) div FItemSize.cy;
    if FRows > Count then
      FRows := Count;
    if FRows < 1 then
      FRows := 1;
    //    if (ClientHeight mod FItemSize.cy > FItemSize.cy div 2) then
    //      Inc(FRows);
    FCols := Count div FRows;
    if FCols < 1 then
      FCols := 1;
    while (FRows * FCols) < Count do
      Inc(FCols);
    HorzScrollBar.Visible := True;
    VertScrollBar.Visible := False;
  end
  else
  begin
    if Options.AutoCenter then
      FCols := ClientWidth div FItemSize.cx
    else
      FCols := (Width + FItemSize.cx div 3) div FItemSize.cx;
    if FCols > Count then
      FCols := Count;
    if FCols < 1 then
      FCols := 1;
    //    if (ClientWidth mod FItemSize.cx > FItemSize.cx div 2) then
    //      Inc(FCols);
    FRows := Count div FCols;
    if FRows < 1 then
      FRows := 1;
    while (FRows * FCols) < Count do
      Inc(FRows);
    HorzScrollBar.Visible := False;
    VertScrollBar.Visible := True;
  end;
  HorzScrollBar.Range := FCols * FItemSize.cx;
  VertScrollBar.Range := FRows * FItemSize.cy;
  UpdateOffset;
  CalcIndices;
  CheckHotTrack;
end;

procedure TJvCustomItemViewer.UpdateOffset;
begin
  if Options.AutoCenter then
  begin
    FTopLeft.X := (ClientWidth - FCols * FItemSize.cx) div 2;
    FTopLeft.Y := (ClientHeight - FRows * FItemSize.cy) div 2;
  end
  else
  begin
    FTopLeft.X := Options.HorzSpacing div 2;
    FTopLeft.Y := Options.VertSpacing div 2;
  end;
  if FTopLeft.X < Options.HorzSpacing div 2 then
    FTopLeft.X := Options.HorzSpacing div 2;
  if FTopLeft.Y < Options.VertSpacing div 2 then
    FTopLeft.Y := Options.VertSpacing div 2;
  if HorzScrollBar.Visible then
    Dec(FTopLeft.X, HorzScrollBar.Position);
  if VertScrollBar.Visible then
    Dec(FTopLeft.Y, VertScrollBar.Position);
end;

procedure TJvCustomItemViewer.GetDlgCode(var Code: TDlgCodes);
begin
  Code := [dcWantArrows];
end;

procedure TJvCustomItemViewer.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  UpdateAll;
  InvalidateClipRect(ClientRect);
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

procedure TJvCustomItemViewer.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FTempSelected := ItemAtPos(X, Y, True);
    if CanFocus then
      SetFocus;
  end
  else
  if Button = mbRight then
  begin
    StopScrollTimer;
    if Options.RightClickSelect then
    begin
      FTempSelected := ItemAtPos(X, Y, True);
      if CanFocus then
        SetFocus;
      SelectedIndex := FTempSelected;
      Invalidate;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TJvCustomItemViewer.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  I: Integer;
begin
  if Button = mbLeft then
  begin
    I := ItemAtPos(X, Y, True);
    if (I = FTempSelected) and (I >= 0) and (I < Count) then
    begin
      if Options.MultiSelect then
      begin
        if (Shift * KeyboardShiftStates = [ssCtrl]) then
          ToggleSelection(FTempSelected, True)
        else
        if Shift * KeyboardShiftStates = [ssShift] then
          ShiftSelection(FTempSelected, True)
        else
        begin
          DoUnSelectItems(FTempSelected);
          SelectedIndex := FTempSelected;
          Invalidate;
        end;
      end
      else
        SelectedIndex := FTempSelected;
    end
    else
    if I < 0 then
      //    begin
      DoUnSelectItems(-1);
    //      SelectedIndex := -1;
    //    end;
    FTempSelected := -1;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TJvCustomItemViewer.WMNCHitTest(var Msg: TMessage);
begin
  // enable scroll bars at design-time
  DefaultHandler(Msg);
end;

procedure TJvCustomItemViewer.WMPaint(var Msg: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

procedure TJvCustomItemViewer.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  UpdateAll;
  InvalidateClipRect(ClientRect);
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

procedure TJvCustomItemViewer.WMCancelMode(var Msg: TWMCancelMode);
begin
  inherited;
  StopScrollTimer;
end;

procedure TJvCustomItemViewer.FocusSet(Focuseded: HWND);
begin
  inherited FocusSet(Focuseded);
  if Focuseded = Handle then
  begin
    if SelectedIndex >= 0 then
      Invalidate;
  end;
end;

procedure TJvCustomItemViewer.BoundsChanged;
begin
  UpdateAll;
  if HandleAllocated then
    InvalidateClipRect(ClientRect);
  inherited BoundsChanged;
end;

procedure TJvCustomItemViewer.Changed;
begin
  inherited Changed;
  if (FUpdateCount = 0) and HandleAllocated then
  begin
    UpdateAll;
    if not Options.MultiSelect then
      DoUnSelectItems(SelectedIndex);
    InvalidateClipRect(ClientRect);
  end;
end;

procedure TJvCustomItemViewer.DoScrollTimer(Sender: TObject);
var
  DoInvalidate: Boolean;
  P: TPoint;
begin
  FScrollTimer.Enabled := False;
  FScrollTimer.Interval := cScrollIntervall;
  DoInvalidate := False;
  GetCursorPos(P);
  if FDragImages <> nil then
    FDragImages.HideDragImage;
  case TScrollEdge(ScrollEdge) of
    seLeft:
      if (Options.ScrollBar = tvHorizontal) and HorzScrollBar.Visible and (HorzScrollBar.Position > 0) then
        DoInvalidate := PostMessage(Handle, WM_HSCROLL, SB_LINELEFT, 0);
    seTop:
      if (Options.ScrollBar = tvVertical) and VertScrollBar.Visible and (VertScrollBar.Position > 0) then
        DoInvalidate := PostMessage(Handle, WM_VSCROLL, SB_LINELEFT, 0);
    seRight:
      if (Options.ScrollBar = tvHorizontal) and HorzScrollBar.Visible and (HorzScrollBar.Position < HorzScrollBar.Range)
        then
        DoInvalidate := PostMessage(Handle, WM_HSCROLL, SB_LINERIGHT, 0);
    seBottom:
      if (Options.ScrollBar = tvVertical) and VertScrollBar.Visible and (VertScrollBar.Position < VertScrollBar.Range)
        then
        DoInvalidate := PostMessage(Handle, WM_VSCROLL, SB_LINERIGHT, 0);
  end;
  if FDragImages <> nil then
    FDragImages.ShowDragImage;
  if (ScrollEdge <> Ord(seNone)) and DoInvalidate then
    Invalidate;
  //  UpdateWindow(Handle);
  FScrollTimer.Enabled := True;
end;

procedure TJvCustomItemViewer.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
const
  cEdgeSize = 4;
begin
  inherited DragOver(Source, X, Y, State, Accept);
  if Accept and Options.DragAutoScroll then
  begin
    if X <= cEdgeSize then
      ScrollEdge := Ord(seLeft)
    else
    if X >= ClientWidth - cEdgeSize then
      ScrollEdge := Ord(seRight)
    else
    if Y <= cEdgeSize then
      ScrollEdge := Ord(seTop)
    else
    if Y >= ClientHeight - cEdgeSize then
      ScrollEdge := Ord(seBottom)
    else
      ScrollEdge := Ord(seNone);
    if (ScrollEdge = Ord(seNone)) and Assigned(FScrollTimer) then
      StopScrollTimer
    else
    if (ScrollEdge <> Ord(seNone)) and not Assigned(FScrollTimer) then
    begin
      FScrollTimer := TTimer.Create(nil);
      FScrollTimer.Enabled := False;
      FScrollTimer.Interval := cScrollDelay;
      FScrollTimer.OnTimer := DoScrollTimer;
      FScrollTimer.Enabled := True;
    end;
  end
  else
    StopScrollTimer;
end;

procedure TJvCustomItemViewer.DragCanceled;
begin
  inherited DragCanceled;
  StopScrollTimer;
end;

procedure TJvCustomItemViewer.DoEndDrag(Sender: TObject; X, Y: Integer);
begin
  inherited DoEndDrag(Sender, X, Y);
  StopScrollTimer;
end;

procedure TJvCustomItemViewer.StopScrollTimer;
begin
  if FScrollTimer <> nil then
  begin
    FreeAndNil(FScrollTimer);
    UpdateWindow(Handle);
  end;
end;

procedure TJvCustomItemViewer.SelectAll;
begin
  SelectItems(0, Count - 1, True);
end;

procedure TJvCustomItemViewer.SelectItems(StartIndex, EndIndex: Integer;
  AppendSelection: Boolean);
var
  I, AIndex: Integer;
begin
  AIndex := SelectedIndex;
  BeginUpdate;
  if not AppendSelection then
    DoUnSelectItems(-1);
  try
    for I := Max(StartIndex, 0) to Min(Count - 1, EndIndex) do
      Items[I].FState := Items[I].FState + [cdsSelected];
    if (AIndex >= StartIndex) and (AIndex <= EndIndex) then
      FSelectedIndex := AIndex
    else
      FSelectedIndex := StartIndex;
  finally
    EndUpdate;
  end;
end;

procedure TJvCustomItemViewer.UnselectItems(StartIndex, EndIndex: Integer);
var
  I: Integer;
begin
  BeginUpdate;
  try
    for I := Max(0, StartIndex) to Min(EndIndex, Count - 1) do
      Items[I].FState := Items[I].FState - [cdsSelected];
    if (SelectedIndex >= StartIndex) and (SelectedIndex <= EndIndex) then
      FSelectedIndex := FindFirstSelected;
  finally
    EndUpdate;
  end;
end;

procedure TJvCustomItemViewer.WMNCPaint(var Messages: TWMNCPaint);
begin
  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
    ThemeServices.PaintBorder(TWinControl(Self), False)
  else
  {$ENDIF JVCLThemesEnabled}
    inherited;
end;

function TJvCustomItemViewer.HintShow(var HintInfo: THintInfo): Boolean;
var
  I: Integer;
begin
  with HintInfo.CursorPos do
    I := ItemAtPos(X,Y, True);
  if I >= 0 then
  begin
    HintInfo.HintStr := Items[I].Hint;
    HintInfo.CursorRect := ItemRect(I, True);
    DoItemHint(I, HintInfo);
  end;
  if HintInfo.HintStr = '' then
    HintInfo.HintStr := Hint;
  Result := False;
end;

procedure TJvCustomItemViewer.Deleted(Item: TJvViewerItem);
begin
  if Assigned(FOnDeletion) then
    FOnDeletion(Self, Item);
end;

procedure TJvCustomItemViewer.Inserted(Item: TJvViewerItem);
begin
  if Assigned(FOnInsertion) then
    FOnInsertion(Self, Item);
end;

function TJvCustomItemViewer.DoItemHint(Index: Integer;
  var HintInfo: THintInfo): Boolean;
begin
  Result := False;
  if Assigned(FOnItemHint) then
    FOnItemHint(Self, Index, HintInfo, Result);
end;

procedure TJvCustomItemViewer.ScrollBy(DeltaX, DeltaY: Integer);
begin
  if DeltaX <> 0 then
    HorzScrollBar.Position := HorzScrollBar.Position + DeltaX;
  if DeltaY <> 0 then
    VertScrollBar.Position := VertScrollBar.Position + DeltaY;
  UpdateAll;
end;

//=== { TViewerDrawImageList } ===============================================

procedure TViewerDrawImageList.Initialize;
begin
  inherited Initialize;
  DragCursor := crArrow;
end;

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

finalization
  ClearBrushPatterns;
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.