jvlistview.pas

East make Tray Icon in delphi

procedure TJvListView.SaveToCSV(FileName: string; Separator: Char);
var
  S: TStringList;
begin
  S := TStringList.Create;
  Items.BeginUpdate;
  try
    SaveToStrings(S, Separator);
    S.SaveToFile(FileName);
  finally
    Items.EndUpdate;
    S.Free;
  end;
end;

procedure TJvListView.InvertSelection;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
    Items[I].Selected := not Items[I].Selected;
  Items.EndUpdate;
end;

{$IFDEF COMPILER5}
procedure TJvListView.SelectAll;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
    Items[I].Selected := True;
  Items.EndUpdate;
end;
{$ENDIF COMPILER5}

procedure TJvListView.UnselectAll;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
    Items[I].Selected := False;
  Items.EndUpdate;
end;

procedure TJvListView.KeyUp(var Key: Word; Shift: TShiftState);
var
  st: string;
  I, J: Integer;
begin
  inherited KeyUp(Key, Shift);
  if AutoClipboardCopy then
    if (Key in [Ord('c'), Ord('C')]) and (ssCtrl in Shift) then
    begin
      for I := 0 to Columns.Count - 1 do
        st := st + Columns[I].Caption + Tab;
      if st <> '' then
        st := st + sLineBreak;
      for I := 0 to Items.Count - 1 do
        if (SelCount = 0) or Items[I].Selected then
        begin
          st := st + Items[I].Caption;
          for J := 0 to Items[I].SubItems.Count - 1 do
            st := st + Tab + Items[I].SubItems[J];
          st := st + sLineBreak;
        end;
      Clipboard.SetTextBuf(PChar(st));
    end;
end;

{$IFDEF COMPILER5}
procedure TJvListView.DeleteSelected;
var
  I: Integer;
begin
  Items.BeginUpdate;
  if SelCount = 1 then
  begin
    I := Selected.Index - 1;
    Selected.Delete;
    if I = -1 then
      I := 0;
    if Items.Count > 0 then
      Selected := Items[I];
  end
  else
    for I := Items.Count - 1 downto 0 do
      if Items[I].Selected then
        Items[I].Delete;
  Items.EndUpdate;
end;
{$ENDIF COMPILER5}

function TJvListView.GetColumnsOrder: string;
var
  Res: array [0..cColumnsHandled - 1] of Integer;
  I: Integer;
begin
  ListView_GetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
  Result := '';
  if Columns.Count > cColumnsHandled then
    raise EJvListViewError.CreateRes(@RsETooManyColumns);
  for I := 0 to Columns.Count - 1 do
  begin
    if Result <> '' then
      Result := Result + ',';
    Result := Result + IntToStr(Res[I]) + '=' + IntToStr(Columns[I].Width);
  end;
end;

procedure TJvListView.SetColumnsOrder(const Order: string);
var
  Res: array [0..cColumnsHandled - 1] of Integer;
  I, J: Integer;
  st: string;
begin
  FillChar(Res, SizeOf(Res), #0);
  with TStringList.Create do
  try
    CommaText := Order;
    I := 0;
    while Count > 0 do
    begin
      st := Strings[0];
      J := Pos('=', st);
      if (J <> 0) and (I < Columns.Count) then
      begin
        Columns[I].Width := StrToIntDef(Copy(st, J + 1, Length(st)), Columns[I].Width);
        st := Copy(st, 1, J - 1);
      end;
      Res[I] := StrToIntDef(st, 0);
      Delete(0);
      Inc(I);
    end;
    ListView_SetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
  finally
    Free;
  end;
end;

procedure TJvListView.SetHeaderImages(const Value: TCustomImageList);
begin
  if FHeaderImages <> Value then
  begin
    if FHeaderImages <> nil then
      FHeaderImages.UnRegisterChanges(FImageChangeLink);
    FHeaderImages := Value;
    if Assigned(FHeaderImages) then
    begin
      FHeaderImages.RegisterChanges(FImageChangeLink);
      FHeaderImages.FreeNotification(Self);
    end;
    UpdateHeaderImages(ListView_GetHeader(Handle));
  end;
end;

procedure TJvListView.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = HeaderImages then
      HeaderImages := nil
    else
      if not (csDestroying in ComponentState) and (AComponent is TPopupMenu) then
        for I := 0 to Items.Count - 1 do
          if TJvListItem(Items[I]).PopupMenu = AComponent then
            TJvListItem(Items[I]).PopupMenu := nil;
end;

procedure TJvListView.CreateWnd;
begin
  inherited CreateWnd;
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.UpdateHeaderImages(HeaderHandle: Integer);
//var
//  WP: TWindowPlacement;
begin
  if (HeaderHandle <> 0) and (ViewStyle = vsReport) and ShowColumnHeaders then
  begin
//    WP.length := SizeOf(WP);
//    GetWindowPlacement(HeaderHandle, @WP);
    if HeaderImages <> nil then
    begin
      Header_SetImageList(HeaderHandle, HeaderImages.Handle);
//      WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + HeaderImages.Height + 3;
    end
    else
      if ComponentState * [csLoading, csDestroying] = [] then
      begin
        Header_SetImageList(HeaderHandle, 0);
//      WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + 17;
      end;
    // the problem with resizing the header is that there doesn't seem to be an easy way of telling the listview about it...
//    SetWindowPlacement(HeaderHandle, @WP);
    UpdateColumns;
    InvalidateRect(HeaderHandle, nil, True)
  end;
end;

procedure TJvListView.DoHeaderImagesChange(Sender: TObject);
begin
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.SetSmallImages(const Value: TCustomImageList);
begin
  inherited SmallImages := Value;
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.Loaded;
begin
  inherited Loaded;
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.WMNCCalcSize(var Msg: TWMNCCalcSize);
//var
//  R: TRect;
begin
  inherited;
//  if Msg.CalcValidRects and Assigned(HeaderImages) and (ViewStyle = vsReport) and ShowColumnHeaders then
//    with Msg.CalcSize_Params^.rgrc[0] do
//      Top := Top + HeaderImages.Height + 3;
end;

procedure TJvListView.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then
    UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.InsertItem(Item: TListItem);
begin
  inherited InsertItem(Item);
  if AutoSelect and (Selected = nil) and (Items.Count < 2) then
    PostMessage(Handle, WM_AUTOSELECT, Integer(Item), 1);
end;

procedure TJvListView.WMAutoSelect(var Msg: TMessage);
var
  lv: TListItem;
begin
  with Msg do
  begin
    lv := TListItem(WParam);
    if Assigned(lv) and (Items.IndexOf(lv) >= 0) and (LParam = 1) then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
  end;
end;

function TJvListView.MoveDown(Index: Integer; Focus: Boolean = True): Integer;
var
  lv, lv2: TListItem;
  FOnInsert, FOnDeletion: TLVDeletedEvent;
begin
  Result := Index;
  if (Index >= 0) and (Index < Items.Count) then
  begin
    lv2 := Items[Index];
    FOnInsert := OnInsert;
    FOnDeletion := OnDeletion;
    try
      OnInsert := nil;
      OnDeletion := nil;
      lv := Items.Insert(Index + 2);
      lv.Assign(lv2);
      lv2.Delete;
    finally
      OnInsert := nil;
      OnDeletion := nil;
    end;
    if Focus then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
    Result := lv.Index;
  end;
end;

function TJvListView.MoveUp(Index: Integer; Focus: Boolean = True): Integer;
var
  lv, lv2: TListItem;
  FOnInsert, FOnDeletion: TLVDeletedEvent;
begin
  Result := Index;
  if (Index > 0) and (Index < Items.Count) then
  begin
    lv2 := Items[Index];
    FOnInsert := OnInsert;
    FOnDeletion := OnDeletion;
    try
      OnInsert := nil;
      OnDeletion := nil;
      lv := Items.Insert(Index - 1);
      lv.Assign(lv2);
      lv2.Delete;
    finally
      OnInsert := nil;
      OnDeletion := nil;
    end;
    if Focus then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
    Result := lv.Index;
  end;
end;

function TJvListView.SelectNextItem(Focus: Boolean = True): Integer;
begin
  Result := ItemIndex + 1;
  if Result < Items.Count then
    ItemIndex := Result;
  Result := ItemIndex;
  if Focus and (Result >= 0) and (Result < Items.Count) then
  begin
    Items[Result].Selected := True;
    Items[Result].Focused := True;
  end;
end;

function TJvListView.SelectPrevItem(Focus: Boolean = True): Integer;
begin
  Result := ItemIndex - 1;
  if Result >= 0 then
    ItemIndex := Result;
  Result := ItemIndex;
  if Focus and (Result >= 0) and (Result < Items.Count) then
  begin
    Items[Result].Selected := True;
    Items[Result].Focused := True;
  end;
end;

procedure TJvListView.SetFocus;
begin
  inherited SetFocus;
  if AutoSelect and (Selected = nil) and (Items.Count > 0) then
    PostMessage(Handle, WM_AUTOSELECT, Integer(Items[0]), 1);
end;


function TJvListView.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;
begin
  Result := inherited IsCustomDrawn(Target, Stage) or ((Stage = cdPrePaint) and (Picture.Graphic <> nil) and not Picture.Graphic.Empty)
end;


function TJvListView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean;
var
  BmpXPos, BmpYPos: Integer; // X and Y position for bitmap
  ItemRect: TRect; // List item bounds rectangle
  TopOffset: Integer; // Y pos where bmp drawing starts
  Bmp: TBitmap;
  function GetHeaderHeight: Integer;
  var
    Header: HWND; // header window handle
    Pl: TWindowPlacement; // header window placement
  begin
    // Get header window
    Header := SendMessage(Handle, LVM_GETHEADER, 0, 0);
    // Get header window placement
    FillChar(Pl, SizeOf(Pl), 0);
    Pl.length := SizeOf(Pl);
    GetWindowPlacement(Header, @Pl);
    // Calculate header window height
    Result := Pl.rcNormalPosition.Bottom - Pl.rcNormalPosition.Top;
  end;
begin
  Result := inherited CustomDraw(ARect, Stage);

  if Result and (Stage = cdPrePaint) and (FPicture <> nil) and (FPicture.Graphic <> nil) and not
    FPicture.Graphic.Empty and (FPicture.Graphic.Width > 0) and (FPicture.Graphic.Height > 0) then
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.Width := ClientWidth;
      Bmp.Height := ClientHeight;
      Bmp.Canvas.Brush.Color := Self.Color;
      Bmp.Canvas.FillRect(ClientRect);

    // Get top offset where drawing starts
      if Items.Count > 0 then
      begin
        ListView_GetItemRect(Handle, 0, ItemRect, LVIR_BOUNDS);
        TopOffset := ListView_GetTopIndex(Handle) * (ItemRect.Bottom - ItemRect.Top);
      end
      else
        TopOffset := 0;
      if ViewStyle = vsReport then
        BmpYPos := ARect.Top - TopOffset + GetHeaderHeight
      else
        BmpYPos := 0;
      // Draw the image
      while BmpYPos < ARect.Bottom do
      begin
        // draw image across width of display
        BmpXPos := ARect.Left;
        while BmpXPos < ARect.Right do
        begin
//      DrawIconEx draws alpha-blended icons better (on XP) but gives problems with selecting in the listview
//      if Picture.Graphic is TIcon then
//        DrawIconEx(Canvas.Handle, BmpXPos, BmpYPos, Picture.Icon.Handle, 0, 0, 0, 0, DI_NORMAL)
//      else
          Bmp.Canvas.Draw(BmpXPos, BmpYPos, Picture.Graphic);
          Inc(BmpXPos, Picture.Graphic.Width);
        end;
        // move to next row
        Inc(BmpYPos, Picture.Graphic.Height);
      end;
      BitBlt(Canvas, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas, 0, 0, SRCCOPY);
    // Ensure that the items are drawn transparently
      SetBkMode(Canvas.Handle, TRANSPARENT);
      ListView_SetTextBkColor(Handle, CLR_NONE);
      ListView_SetBKColor(Handle, CLR_NONE);
    finally
      Bmp.Free;
    end;
  end;
end;

procedure TJvListView.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TJvListView.DoPictureChange(Sender: TObject);
begin
//  if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
//    Picture.Graphic.Transparent := true;
  Invalidate;
end;

{$IFDEF COMPILER5}

function TJvListView.GetItemIndex: Integer;
begin
  if Selected <> nil then
    Result := Selected.Index
  else
    Result := -1;
end;

procedure TJvListView.SetItemIndex(const Value: Integer);
begin
  if (Value >= 0) and (Value < Items.Count) then
    Items[Value].Selected := True;
end;

{$ENDIF COMPILER5}

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.