[VahaC]

Понадобилось в OnGetGroupCount организовать вывод текста в Footer а не в Caption групи как по умолчанию подразумевалось. Но увы обнаружилась засада, если даже ничего не присвоить к CountString то в Caption все равно добавлялось '()' потому пришлось внести маленькое изменение в код компонента

Code:

// Исправлен баг когда в OnGetGroupCount не присваиваем никакого значения CountString но к Caption-у добавляются '()'
// Ситуация возникает когда например OnGetGroupCount хочешь изменить Footer а не Caption текущей групи
//

//aceListView.pas

function TacListGroup.GetDisplayCaption(Canvas: TCanvas): string;
var
CountString: String;
begin
Result := FCaption;

if acListView.ShowGroupItemsCount then begin
if Assigned(acListView.FGetCountEvent) then
begin
CountString := '';
acListView.FGetCountEvent(Self, CountString);
if CountString '' then //Добавил эту строку для того чтобы можно было изменять не только Group.Caption
Result := Result + ' (' + CountString + ')'
end
else
Result := Result + ' (' + IntToStr(Count) + ')';
end;

FNeedCaptionWidth := Canvas.TextWidth(Result);
Result := CutText(Canvas, Result, acListView.ClientWidth-10);
end;

ПС

2 KSS кстати вы не имеете ничего против того что я взялся за правку вашего компонента и выкладываю код поправок здесь? :blush: Если да то достаточно написать мне и я прекращу это дело.

[VahaC]

Обнаружил что не работает флаг AllowRename

Вот исправление

Code:

//Исправление не рабочего флага AllowRename

//aceListView.pas

procedure TacListItem.Click(MousePos: TPoint);
var
OldFocusedItem: TacListItem;
begin
OldFocusedItem := acListView.FocusedItem;
acListView.FFocusedElement := Self;

if PtInRect(FCheckBounds, MousePos) then
Checked := not Checked
else
if PtInRect(FCaptionBounds, MousePos) and Selected then
begin
if acListView.FAllowRename then // добавил для того чтобы заработал флаг AllowRename
acListView.RenameStart(Self)
end
else
if ssShift in acListView.FDragStartShift then
acListView.SelectItems(OldFocusedItem, Self)
else
if ssCtrl in acListView.FDragStartShift then
DoAction(acListView.FOnItemClickActions – [iaDeselectUnfocused])
else
DoAction(acListView.FOnItemClickActions);
end;

[VahaC]

во время работы с компонентом заметил что всегда отображается фокус ввода если честно то меня это немного напрягало и поэтому наваял вот такие изменения

Code:

// Добавлено возможность выбирать подсветку груп и итемов в зависимости от их состояния
// Selected, Focused, Hot
// За это отвечает свойство Highlight и в нем значения
// hlItemFocused, hlItemSelected, hlItemHot, hlGroupFocused, hlGroupSelected, hlGroupHot

//aceListView.pas

TacListColumn = class(TacListElement)
private
….
// Highlight
FHighlight: THighlights;
….
// Highlight
procedure SetHighlight(const Value: THighlights);
protected
….
public
….
published
….
// Highlight
property Highligth: TOnItemActions read FOnItemClickActions write SetOnItemClickActions default [iaSelectFocused, iaDeselectUnfocused];
….
end;

….

procedure TacListView.SetHighlight(const Value: THighlights);
begin
if FHighlight Value then
FHighlight := Value;
end;

constructor TacListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
….
//Highlight
FHighlight := [hlItemSelected, hlItemHot, hlGroupSelected, hlGroupHot];
end;

procedure TacListGroup.Paint(Canvas: TCanvas; BgErase, PaintSelectionFrame: Boolean);
….
if SkinIndex < 0 then begin
OutCanvas.Rectangle(BitmapRect);
PaintGridLines(OutCanvas, Canvas, FBounds);
OutCanvas.Font := acListView.GroupFont;
OutCanvas.TextOut(TxtRec.Left, TxtRec.Top, OutText);
OutCanvas.Font := acListView.ItemFont;
OutCanvas.TextOut(DesRec.Left, DesRec.Top, OutDesText);
// Line
OutCanvas.Pen.Color := GetShadowColor(OutCanvas.Pen.Color, -45);
OutCanvas.MoveTo(LineRect.Left, LineRect.Top);
OutCanvas.LineTo(LineRect.Right, LineRect.Top);
end
else begin
ci.Bmp := OutBitmap;
ci.X := 0;
ci.Y := 0;
// начало изменеий
if (Selected) and (hlGroupSelected in acListView.FHighlight) then
PaintItem(SkinIndex, acListView.GroupSkin, ci, True, State, BitmapRect, Point(1, 1), OutCanvas.Handle);

if (Self = acListView.FHotElement) and (hlGroupHot in acListView.FHighlight) then begin
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
PaintItem(SkinIndex, acListView.GroupSkin, ci, True, State, BitmapRect, Point(1, 1), BackBitmap.Canvas.Handle);
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5);
BackBitmap.Free;
end;

if (Self = acListView.FFocusedElement) and (hlGroupFocused in acListView.FHighlight) then begin
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
ci.Bmp := OutBitmap;
ci.X := 0;
ci.Y := 0;
PaintItem(FocusedSkin, s_SPEEDBUTTON, ci, True, State, BitmapRect, Point(1, 1), BackBitmap.Canvas.Handle);
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5);
BackBitmap.Free;
end;
// конец изменеий

PaintGridLines(OutCanvas, Canvas, FBounds);
OutCanvas.Font := acListView.GroupFont;
WriteTextEx(OutCanvas, PChar(OutText), True, TxtRec, DT_LEFT, SkinIndex, Boolean(State > 0));
OutCanvas.Font := acListView.ItemFont;
WriteTextEx(OutCanvas, PChar(OutDesText), True, DesRec, DT_LEFT, ItemIndex, Boolean(State > 0));
// Line
PaintItem(DividerSkinIndex, s_DIVIDERV, ci, True, State, LineRect, Point(LineRect.Left, 0), OutCanvas.Handle);
end;

// Expand button
if acListView.FShowGroupButtons then begin
….
end;

procedure TacListItem.Paint(Canvas: TCanvas; BgErase, PaintSelectionFrame: Boolean);
….
if ItemSkinIndex < 0 then begin
OutCanvas.Rectangle(BitmapRect);
if FShowProgress then begin
OutCanvas.Brush.Color := AverageColor(OutCanvas.Brush.Color, acListView.FProgressItemColor);
OutCanvas.Pen.Color := GetShadowColor(OutCanvas.Brush.Color, -25);
ClearRect := BitmapRect;
ClearRect.Right := (WidthOf(FBounds) * FProgressPosition) div 100;
OutCanvas.FillRect(ClearRect);
OutCanvas.Brush.Style := bsClear;
OutCanvas.Rectangle(BitmapRect);
end;
end
else
begin
// начало изменений
if (Selected) and (hlItemSelected in acListView.FHighlight) then begin
BackBitmap := CreateBmp32(WidthOf(BitmapRect), BitmapRect.Bottom);
ci := MakeCacheInfo(OutBitmap);

PaintItem(ItemSkinIndex, ItemSkin, ci, True, State, BitmapRect, Point(0, 0), BackBitmap.Canvas.Handle);
if not acListView.Focused then
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5)
else
OutCanvas.Draw(0, 0, BackBitmap);

BackBitmap.Free;
end;

// Item progress
if FShowProgress then begin
ClearRect := BitmapRect;
ClearRect.Right := (WidthOf(FBounds) * FProgressPosition) div 100;
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
ci.Bmp := BackBitmap;
ci.X := 0;
ci.Y := 0;
PaintItem(ProgressSkinIndex, ProgressSkin, ci, True, State, ClearRect, Point(0, 0), OutCanvas.Handle);
BackBitmap.Free;
end;

// подсветка итема над которым находится мыш
if (Self = acListView.FHotElement) and (hlItemHot in acListView.FHighlight) then begin
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
ci.Bmp := OutBitmap;
ci.X := 0;
ci.Y := 0;
PaintItem(ItemSkinIndex, ItemSkin, ci, True, State, BitmapRect, Point(1, 1), BackBitmap.Canvas.Handle);
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5);
BackBitmap.Free;
end;

// подсветка итема на котором установлен фокус
if (Self = acListView.FFocusedElement) and (hlItemFocused in acListView.FHighlight) then begin
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
ci.Bmp := OutBitmap;
ci.X := 0;
ci.Y := 0;
PaintItem(FocusedSkinIndex, FocusedSkin, ci, True, State, BitmapRect, Point(1, 1), BackBitmap.Canvas.Handle);
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5);
BackBitmap.Free;
end;
// конец изменений
end;

// Draw caption
if (acListView.ViewStyle vsReport) and (Self acListView.FRenamedItem) then
TextRect(OutCanvas, OutText, CustomFont, True, Boolean(State > 0), FCaptionBounds, DT_LEFT, ItemSkinIndex, FOwner.SkinData);

….
end;

[VahaC]

вот кое чего сочинил

Code:

// Добавлено возможность отображать свои иконки сортировки по центру, слева и справа
// Если выбрать отображение по центру то иконка может накладыватся на текст, это не глюк
// а решыл оставить специально чтобы была возможность использовать свою маленькую иконку
// и отображать ее по центру

//aceCommon.pas

function TacCollectionElement.GetDisplayCaption(Canvas: TCanvas): string;
begin
FNeedCaptionWidth := Canvas.TextWidth(FCaption);
Result := CutText(Canvas, FCaption, WidthOf(FBounds) – 2); //Чтобы выводилось 3 точки а не две как раньше
end;

//aceListView.pas

TacListColumn = class(TacListElement)
private
….
FSortImageAligment: TAlignment;
….
procedure SetSortImageAligment(const Value: TAlignment);
….
public
constructor Create(Collection: TCollection); override;
….
published
….
property SortImageAligment: TAlignment read FSortImageAligment write SetSortImageAligment default taRightJustify;
….
end;

constructor TacListColumn.Create(Collection: TCollection);
begin
inherited Create(Collection);
FWidth := 100;
FCaption := 'Column ' + IntToStr(FOrderTag + 1);
FImageIndex := -1;
FSortMode := smAutomatic;
FSortKind := skNone;
FSortImageAligment := taRightJustify;
FAllowReorder := True;
FDataPresentation := dpPlainText;
end;

….

procedure TacListColumn.SetSortImageAligment(const Value: TAlignment);
begin
if FSortImageAligment Value then begin
FSortImageAligment := Value;
DoChange;
end;
end;

procedure TacListColumn.Paint(Canvas: TCanvas; BgErase, PaintSelectionFrame: Boolean);
var
OutBitmap,
BackBitmap: TBitmap;
ci: TCacheInfo;
TxtRec,
ImgRec,
BitmapRect: TRect;
OutText: string;
OutCanvas: TCanvas;
SkinSections: TStringList;
OffsetX,
SkinIndex,
State,
FontHeightDif: Integer;
GradArray: TsGradArray;
SortImgInd: Integer;
begin
if not Visible then Exit;
if not Assigned(acListView) then Exit;

OutBitmap := CreateBmp32(WidthOf(FBounds, True), HeightOf(FBounds, True));
BitmapRect := Rect(0, 0, OutBitmap.Width, OutBitmap.Height);
OutCanvas := OutBitmap.Canvas;
OutCanvas.Font := acListView.ColumnFont;
FontHeightDif := Abs(OutCanvas.Font.Height) – OutCanvas.Font.Size;

if acListView.SkinData.SkinIndex >= 0 then begin
SkinSections := TStringList.Create;
acListView.SkinData.SkinManager.GetSkinSections(SkinSections);
SkinIndex := SkinSections.IndexOf(acListView.ColumnSkin);
if SkinIndex < 0 then
SkinIndex := SkinSections.IndexOf(s_BUTTON);
FreeAndNil(SkinSections);
end
else
SkinIndex := -1;

if BgErase then
if SkinIndex < 0 then begin
FillDC(OutCanvas.Handle, FBounds, acListView.Color);
end;

OffsetX := 5;

if Assigned(acListView.StateImages) and (acListView.StateImages.Count > 3) then begin
if (FSortImageAligment = taLeftJustify) and (FSortKind skNone) then
OffsetX := OffsetX + acListView.StateImages.Width + 3;
end;

// Image rect
ImgRec := Rect(OffsetX, 0, OffsetX, 0);
if (FImageIndex >= 0) and Assigned(acListView.SmallImages) and (acListView.SmallImages.Count > 0) then begin
ImgRec := RectCV(OffsetX, OffsetX + acListView.SmallImages.Width, acListView.SmallImages.Height, BitmapRect);
OffsetX := ImgRec.Right + 3;
end;

// Начало изменений
// OutText := GetDisplayCaption(OutCanvas);

// Text rect
TxtRec := Rect(OffsetX, BitmapRect.Top – FontHeightDif + (acListView.ColumnHeight – OutCanvas.Font.Size) div 2, acListView.ClientWidth, BitmapRect.Top + acListView.ColumnHeight – (acListView.ColumnHeight – Abs(OutCanvas.Font.Height)) div 2);

case FSortImageAligment of
taLeftJustify: OutText := CutText(Canvas, FCaption, WidthOf(FBounds) – OffSetX – 5);
taRightJustify: begin
if Assigned(acListView.StateImages) and (acListView.StateImages.Count > 2) then begin
if (FSortKind skNone) then
OutText := CutText(Canvas, FCaption, WidthOf(FBounds) – OffSetX – acListView.StateImages.Width – 3)
else
OutText := CutText(Canvas, FCaption, WidthOf(FBounds) – OffSetX);
end;
end;
taCenter: OutText := CutText(Canvas, FCaption, WidthOf(FBounds) – OffSetX);
end;
// Конец изменений

// Hot item
if Self = acListView.FHotElement then begin
if SkinIndex < 0 then begin
OutCanvas.Brush.Color := acListView.SelectItemColor;
OutCanvas.Pen.Color := acListView.SelectItemColor;
// OutCanvas.Font.Color := clBtnText;
end
else begin
State := 1;
end;
end
// Normal item
else begin
if SkinIndex < 0 then begin
OutCanvas.Pen.Color := clBtnFace;
OutCanvas.Brush.Color := ColorToRGB(clBtnFace);
// OutCanvas.Font.Color := clBtnText;
end
else begin
State := 0;
end;
end;

if SkinIndex < 0 then begin
// Canvas.Rectangle(FBounds);
SetLength(GradArray, 2);

GradArray[0].Color1 := ColorToRGB(OutCanvas.Brush.Color);
GradArray[0].Color2 := ColorToRGB(acListView.Color);
GradArray[0].Mode1 := 0;
GradArray[0].Mode2 := 0;
GradArray[0].Percent := 97;

GradArray[1].Color1 := ColorToRGB(acListView.Color);
GradArray[1].Color2 := ColorToRGB(acListView.Color);
GradArray[1].Mode1 := 0;
GradArray[1].Mode2 := 0;
GradArray[1].Percent := 0;

PaintGrad(OutBitmap, BitmapRect, GradArray);
// GradientFillCanvas(OutCanvas, OutCanvas.Brush.Color, acListView.Color, BitmapRect, gdVertical); v7 GradientFillCanvas exists only in RAD Studio
OutCanvas.Brush.Style := bsClear;
OutCanvas.Rectangle(BitmapRect);
OutCanvas.TextRect(BitmapRect, TxtRec.Left, TxtRec.Top, OutText);
end
else begin
// ci.Bmp := acListView.FSkinData.FCacheBmp;
// ci.X := FBounds.Left;
// ci.Y := FBounds.Top;
// ci.Ready := True; v7
ci := MakeCacheInfo(acListView.FSkinData.FCacheBmp, FBounds.Left, FBounds.Top);
PaintItem(SkinIndex, acListView.ColumnSkin, ci, True, State, BitmapRect, Point(1, 1), OutBitmap); // v7 (Bitmap as parameter is faster) OutCanvas.Handle);
WriteTextEx(OutCanvas, PChar(OutText), True, TxtRec, DT_LEFT, SkinIndex, Boolean(State > 0));
//if State = 1 then
// PaintItem(SkinIndex, acListView.ColumnSkin, ci, True, State, Rect(FBounds.Right-16, FBounds.Top, FBounds.Right, FBounds.Bottom), Point(1, 1), GetDC(acListView.Handle));
end;

// Draw image
if Assigned(acListView.SmallImages) and (ImageIndex > -1) then begin
if (acListView.SmallImages.Count >= ImageIndex) then
acListView.SmallImages.Draw(OutCanvas, ImgRec.Left, ImgRec.Top, ImageIndex, True)
end;

// Начало изменений
// Sort button
if Assigned(acListView.StateImages) and (acListView.StateImages.Count > 2) then begin
// if Assigned(acListView.StateImages) and (acListView.StateImages.Count > 2) then begin
// if (FSortKind = skASC) then
// acListView.StateImages.Draw(OutCanvas, BitmapRect.Left + (FWidth – acListView.StateImages.Width) div 2, 0, 2, True)
// else if (FSortKind = skDESC) then
// acListView.StateImages.Draw(OutCanvas, BitmapRect.Left + (FWidth – acListView.StateImages.Width) div 2, 0, 3, True)
case FSortKind of
skASC: SortImgInd := 2;
skDESC: SortImgInd := 3;
end;
if FSortKind skNone then
case FSortImageAligment of
taLeftJustify: acListView.StateImages.Draw(OutCanvas, BitmapRect.Left + 4, 0, SortImgInd, True);
taRightJustify: acListView.StateImages.Draw(OutCanvas, BitmapRect.Left + (FWidth – acListView.StateImages.Width – 4), 0, SortImgInd, True);
taCenter: acListView.StateImages.Draw(OutCanvas, BitmapRect.Left + (FWidth – acListView.StateImages.Width) div 2, 0, SortImgInd, True);
end;
end
else begin
OutCanvas.Pen.Color := OutCanvas.Font.Color;
DrawArrow(OutCanvas, Rect(BitmapRect.Left + (FWidth – 6) div 2, 0, BitmapRect.Left + 6 + (FWidth – 6) div 2, 3), FSortKind);
end;
// Конец изменений

if Self = acListView.FDragElement then begin
BackBitmap := TBitmap.Create;
BackBitmap.Assign(OutBitmap);
BackBitmap.Canvas.CopyRect(BitmapRect, Canvas, FDragBounds);
BlendTransRectangle(OutBitmap, 0, 0, BackBitmap, BitmapRect, 0.5);
BackBitmap.Free;
Canvas.Draw(FDragBounds.Left, FDragBounds.Top, OutBitmap);
end
else
if Assigned(acListView.FDragElement) and (acListView.FDragElement is TacListColumn) then
Canvas.Draw(FAnimBounds.Left, FAnimBounds.Top, OutBitmap)
else
Canvas.Draw(FBounds.Left, FBounds.Top, OutBitmap);

OutBitmap.Free;
end;

[VahaC]

попробовал заюзать свои картинки сортировки в результате получил картину маслом

[attachment=4665:column_sort_bug.PNG]

так что нужно делать визуальное свойство и если задействованы внешние иконки то выводить их слева (ну или справа) от названия колонки

[VahaC]

'KSS' wrote:

Это и сейчас можно сделать, присвоив нужные иконки 2-му и 3-му элементам StateImages.

но ведь это нигде не документировано, или я ошибаюсь?

для этих целей лучше сделать визуальное свойство там же где и AllowItemsReorder

и не могли бы вы выложить здесь информацию чему соответствует каждая иконка из StateImages

[VahaC]

имхо лучше и то и то, каждый сможет решить что ему лучше подходит.

так как возможно например такое

В колонке отображается 100Кб и 100Кб но в действительности в наборе данных есть 102900 и 101900

ПС

Но для нормальной организации своей сортировки нужно добавить еще и OnColumnClick.

И не плохо бы было иметь возможность заменить отображение стандартных иконок направления сортировки на свои

[VahaC]

Вот чего еще действительно не хватает так это возможность прикрутить свою сортировку как например у sListView и ListView.

Я имею ввиду OnCompare.

Говорю так потому что в текущем проекте (в котором уже использую ваш компонент) понадобилось организовать сортировку по колонкам в которых содержать данные такого вида 23,3% 0,5% 10,5% или же 10Мб 1Гб 100Кб 500б как вы понимаете ни один из предложенных компонентом способов не подходит, а вот при наличии OnCompare можно бы было брать данные прямо от источника используя Itrems.Data и сортировать как надо.

[VahaC]

Да и еще надо добавить скрытие/отображение пункта меню в которое интегрируется меню видимости колонок если ColumnHeaders видимые или не видимые.

Нужно поправить procedure TacListView.SetShowColumnHeaders(const Value: Boolean) код приведен ниже

Code:

procedure TacListView.SetShowColumnHeaders(const Value: Boolean);

begin
if FShowColumnHeaders Value then
begin
if Assigned(FColumnMenuItem) then
FColumnMenuItem.Visible := Value;

FShowColumnHeaders := Value;
UpdateColumns;
end;
end;

[VahaC]

вот изменения для того чтоб

Quote:

Было бы здорово если бы была возможность включать/отключать показ подсказки для итемов которые не полностью видимы

Code:

TacListView = class(TacSkinedControl)
private
….
function GetInfoTip: string; override; // ВНИМАНИЕ!!! Код этой процедуры изменен.
….

TacListView = class(TacSkinedControl)
private
….
FShowSummaryItemHint: Boolean;
….
protected
….
public
….
constructor Create(AOwner: TComponent); override;// ВНИМАНИЕ!!! Код конструктора процедуры изменен.
….
published
….
property ShowSummaryItemHint: Boolean read FShowSummaryItemHint write FShowSummaryItemHint default True;

………………………………..

function TacListItem.GetInfoTip: string;
var
Column: TacListColumn;
begin
Result := '';
if ((acListView.ViewStyle = vsReport) and (acListView.Columns.Count > 0)
and (GetCaptionWidth > acListView.Columns[0].Width)) or (FNeedCaptionWidth > WidthOf(FBounds)) then
if acListView.FShowSummaryItemHint then
Result := Caption;

if FShowHint then
begin
if Result '' then
Result := Result + #13#10;
Result := Result + FHint;
end;
end;

constructor TacListView.Create(AOwner: TComponent);
begin
….
//Hint
FShowSummaryItemHint := True;
end;

[VahaC]

не сочтите за наглость вот изменения какие надо внести в код компонента чтобы добавить “интеграцию меню видимости колонок в какой угодно пункт меню”.

Если Вас не затруднит не могли бы ВЫ добавить этот код к своему компоненту чтобы при выходе новых версий не приходилось их править?

Code:

TacListView = class(TacSkinedControl)
private
….
// Menus
FColumnMenuItem: TMenuItem;
….
procedure SetColumnMenuItem(const Value: TMenuItem);
function FindOrCreateMI_Add(Menu: TMenuItem; Name, NewCaption: string; Index: Integer = 0): TMenuItem;
function FindAndDeleteMI_Add(Menu: TMenuItem; Name: string): Integer;
procedure ColMIClick(Sender: TObject); // ВНИМАНИЕ!!! код этой процедуры был изменен
….
protected
….
public
….
procedure IntegrateColumnMenu(Column: TacListColumn; parentMI: TMenuItem);
….
published
….
property ColumnMenuItem: TMenuItem read FColumnMenuItem write SetColumnMenuItem;

………………………………..

procedure TacListView.SetColumnMenuItem(const Value: TMenuItem);
begin
FColumnMenuItem := Value;
if Value nil then
begin
Value.FreeNotification(Self);
IntegrateColumnMenu(nil, value);
end;
end;

function TacListView.FindOrCreateMI_Add(Menu: TMenuItem; Name,
NewCaption: string; Index: Integer): TMenuItem;
var
i: Integer;
begin
Result := nil;

for i := 0 to Menu.Count – 1 do
if Menu.Items.Name = Name then
begin
Result := Menu.Items;
Break;
end;

if not Assigned(Result) then
begin
Result := TMenuItem.Create(Self);
Result.Name := Name;
Result.Caption := NewCaption;
Menu.Insert(Index, Result);
end;
end;

function TacListView.FindAndDeleteMI_Add(Menu: TMenuItem;
Name: string): Integer;
var
i: Integer;
begin
Result := -1;

for i := 0 to Menu.Count – 1 do
if Menu.Items.Name = Name then
begin
Menu.Delete(i);
Result := i;
Break;
end;
end;

procedure TacListView.IntegrateColumnMenu(Column: TacListColumn; parentMI: TMenuItem);
var
FitColSizeMI, FitAllColSizeMI, ColMI, DivMI: TMenuItem;
i, PrevIndex: Integer;
begin
if Assigned(parentMI) then
begin
FitColSizeMI := FindOrCreateMI_Add(parentMI, 'FitColSizeMI_Add',
'Fit column size', 0);
FitColSizeMI.OnClick := FitColumnSizeMIClick;

FitAllColSizeMI := FindOrCreateMI_Add(parentMI, 'FitAllColSizeMI_Add',
'Fit all columns size', parentMI.IndexOf(FitColSizeMI) + 1);
FitAllColSizeMI.OnClick := FitAllColSizeMIClick;

DivMI := FindOrCreateMI_Add(parentMI, 'DivCMMI_Add',
'-', parentMI.IndexOf(FitAllColSizeMI) + 1);
PrevIndex := parentMI.IndexOf(DivMI) + 1; // сделал + 1 так как иначе разделитель оказывается внизу

for i := 0 to Columns.Count – 1 do
begin
ColMI := FindOrCreateMI_Add(parentMI, Format('ColMI_Add%d', ), '', PrevIndex);
Inc(PrevIndex);

ColMI.Tag := i;
ColMI.Caption := Columns.Caption;
if i = 0 then ColMI.Enabled := False;
ColMI.Checked := Columns.Visible;
ColMI.OnClick := ColMIClick;
end;

Inc(i);
while FindAndDeleteMI_Add(parentMI, Format('ColMI_Add%d', )) > 0 do Inc(i);
end;
end;

procedure TacListView.ColMIClick(Sender: TObject);
var
MenuItem: TMenuItem;
begin
if Assigned(FColumnMenuItem) then
begin
MenuItem := FColumnMenuItem.Find(TMenuItem(Sender).Caption);
if MenuItem nil then
begin
MenuItem.Checked := not MenuItem.Checked;
Columns[MenuItem.Tag].Visible := MenuItem.Checked;
end;
end;
if Assigned(FColumnMenu) then
begin
MenuItem := FColumnMenu.Items.Find(TMenuItem(Sender).Caption);
if MenuItem nil then
begin
MenuItem.Checked := not MenuItem.Checked;
Columns[MenuItem.Tag].Visible := MenuItem.Checked;
end;
end;

// MenuItem := TMenuItem(Sender);
// MenuItem.Checked := not MenuItem.Checked;
// Columns[MenuItem.Tag].Visible := MenuItem.Checked;
end;

[VahaC]

не могли бы вы также организовать возможность интеграции ColumnMenu с каким либо пунктом меню

вот набросал код у меня работает только почему то не добавляет разделитель

Code:

TacListView = class(TacSkinedControl)
private
…
function FindOrCreateMI_Add(Menu: TMenuItem; Name, NewCaption: string; Index: Integer = 0): TMenuItem;
function FindAndDeleteMI_Add(Menu: TMenuItem; Name: string): Integer;
…
public

…

procedure IntegrateColumnMenu(Column: TacListColumn; parentMI: TMenuItem);

….

function TacListView.FindOrCreateMI_Add(Menu: TMenuItem; Name,
NewCaption: string; Index: Integer): TMenuItem;
var
i: Integer;
begin
Result := nil;

for i := 0 to Menu.Count – 1 do
if Menu.Items.Name = Name then
begin
Result := Menu.Items;
Break;
end;

if not Assigned(Result) then
begin
Result := TMenuItem.Create(Self);
Result.Name := Name;
Result.Caption := NewCaption;
Menu.Insert(Index, Result);
end;
end;

function TacListView.FindAndDeleteMI_Add(Menu: TMenuItem;
Name: string): Integer;
var
i: Integer;
begin
Result := -1;

for i := 0 to Menu.Count – 1 do
if Menu.Items.Name = Name then
begin
Menu.Delete(i);
Result := i;
Break;
end;
end;

procedure TacListView.IntegrateColumnMenu(Column: TacListColumn; parentMI: TMenuItem);
var
FitColSizeMI, FitAllColSizeMI, ColMI, DivMI: TMenuItem;
i, PrevIndex: Integer;
begin
if Assigned(parentMI) then
begin
FitColSizeMI := FindOrCreateMI_Add(parentMI, 'FitColSizeMI',
'Fit column size', 0);
FitColSizeMI.OnClick := FitColumnSizeMIClick;

FitAllColSizeMI := FindOrCreateMI_Add(parentMI, 'FitAllColSizeMI',
'Fit all columns size', parentMI.IndexOf(FitColSizeMI) + 1);
FitAllColSizeMI.OnClick := FitAllColSizeMIClick;

DivMI := FindOrCreateMI_Add(parentMI, 'DivCMMI',
'-', parentMI.IndexOf(FitAllColSizeMI) + 1);
PrevIndex := parentMI.IndexOf(DivMI);

for i := 0 to Columns.Count – 1 do
begin
ColMI := FindOrCreateMI_Add(parentMI, Format('ColMI%d', ), '', PrevIndex);
Inc(PrevIndex);

ColMI.Tag := i;
ColMI.Caption := Columns.Caption;
if i = 0 then ColMI.Enabled := False;
ColMI.Checked := Columns.Visible;
ColMI.OnClick := ColMIClick;
end;

Inc(i);
while FindAndDeleteMI_Add(parentMI, Format('ColMI%d', )) > 0 do Inc(i);
end;
end;

ПС

Кстати подобное можно и для GroupMenu сделать

[VahaC]

А когда планируется если не секрет?

[VahaC]

'KSS' wrote:

Да, в этой функции может довольно много всего меняться 🙂 Пробовали acListView.BeginUpdate … acListView.EndUpdate?

Спасибо уже сам до этого дошел просто написать не успел. Только не пойму почему без них нормально не работает?

'KSS' wrote:

Вам совсем нужно убрать Caption из Hint или нужно чтобы он появлялся только при наведении указателя на область названия элемента списка?

Было бы здорово если бы была возможность включать/отключать показ подсказки для итемов которые не полностью видимы

[VahaC]

Да и еще забавная штука с подсказками

как их заполняю видно в предыдущем посте

так вот если свойство Caption (а оно у меня равно ilst.Items.iiDescr ) не влазит в колонку то в подсказке дублируется ilst.Items.iiDescr

не плохо было бы сделать опцию которая определяла бы нужно или нет показывать подсказку если свойство Caption не влазит в колонку

[VahaC]

вот процедура которая обновляет данные в ЛВ

Code:

procedure TmainF.ShowInteracList(var ilst: TRecordList; var lv: TacListView);
var
I, ind: Integer;
acLI: TacListItem;
begin
for I := LV.Items.Count – 1 downto 0 do
begin
if GetIIVisible(ilst, TRecordList.PT(lv.Items.Items.Data).iiName) = -1 then
lv.Items.Delete(I);
end;
for I := 0 to ilst.Count – 1 do
begin
if ilst.Items.iiVisible and ilst.Items.iiMainInterface then
begin
acLI := lv.ItemByCaption(ilst.Items.iiDescr, False);
if acLI nil then
ind := acLI.Index
else
ind := -1;
if ind = -1 then
begin
With iiLV.Items.Add(ilst.Items.iiDescr, GetImageIndex(ilst.Items.iiType), ilst.Items) do
begin
ShowHint := True;
ShowProgress := True;
ProgressPosition := Trunc(ilst.Items.iiUsage);
Hint := ilst.Items.iiDescr + sLineBreak +
'MAC: ' + ilst.Items.iiMAC + sLineBreak +
'Usage: ' + FloatToStrF(ilst.Items.iiUsage, ffNumber, 5, 2) + ' %';
SubItems.Add(GetInterfaceType(ilst.Items.iiType));
SubItems.Add(ilst.Items.iiMAC);
SubItems.Add(SpeedToStr(ilst.Items.iiSpeed));
SubItems.Add(FloatToStrF(ilst.Items.iiUsage, ffNumber, 5, 2) + ' %');
SubItems.Add(Traff(ilst.Items.iiOutOctets));
SubItems.Add(Traff(ilst.Items.iiInOctets));
SubItems.Add(FloatToStrF(ilst.Items.iiOutErrors, ffNumber, 18, 0));
SubItems.Add(FloatToStrF(ilst.Items.iiInErrors, ffNumber, 18, 0));
end;
end
else
begin
With iiLV.Items.Items[ind] do
begin
Hint := ilst.Items.iiDescr + sLineBreak +
'MAC: ' + ilst.Items.iiMAC + sLineBreak +
'Usage: ' + FloatToStrF(ilst.Items.iiUsage, ffNumber, 5, 2) + ' %';
SubItems[3] := FloatToStrF(ilst.Items.iiUsage, ffNumber, 5, 2) + ' %';
SubItems[4] := Traff(ilst.Items.iiOutOctets);
SubItems[5] := Traff(ilst.Items.iiInOctets);
SubItems[6] := FloatToStrF(ilst.Items.iiOutErrors, ffNumber, 18, 0);
SubItems[7] := FloatToStrF(ilst.Items.iiInErrors, ffNumber, 18, 0);
ProgressPosition := Trunc(ilst.Items.iiUsage);
end;
end;
end;
end;
end;

[VahaC]

Решил попробовать этот компонент но сразу натолкнулся на следующую проблему

У меня данные в ЛВ обновляются по таймеру так вот при использовании TsListView все обновляется нормально, а вот в вашем компоненте данные обновляются с рендомной задержкой (то есть возможен пропуск отображения изменненных данных)

В событии OnTimer пробовал делать и Refresh и Repaint и Invalidate ничего не помогло.

Скажите пожалуйста, как с этим бороться?

[VahaC]

Я это обращение к Support-у писал.

[VahaC]

'Navern' wrote:

Не хотелось бы плодить темы, поэтому отпишусь прям здесь. Реквест такой:

Если в sListView у какой-то из колонок задать свойство AutoSize := true, то она займёт всё свободное оставшееся пространство ЛистВью. Это замечательно и красиво, но есть проблема: при внезапном появлении вертикального скроллбара (когда в ЛистВью добавляется много элементов) ширина колонок со свойством AutoSize не корректируется в соответствие с новыми размерами. То есть скроллбар располагается прям поверх последней колонки, что в свою очередь вызывает появление уже горизонтального скролла. Проблема сейчас решается sListView.Width := sListView.Width (+/-) 1, но это очень некрасиво и с точки зрения грамотности, и с точки зрения наблюдения, ведь контрол дважды лишний раз полностью перерисовывается. В интернете не нашёл ни одного упоминания как заставить колонки автоматически скорректировать свою ширину, поэтому прошу добавить такую фичу в АС.

Если описанное выше сделать невозможно, то как вариант добавить в sListView свойство, всегда отображающее скроллбары (вертикальный, горизонтальный или оба сразу) вне зависимости от количества элементов в нём. Это тоже было бы весьма кстати.

Было бы очень даже здорово если бы Вы это реализовали.

[VahaC]

Ах да и если при выключенных скинах кликнуть по какому либо итэму главного меню то выпавшее меню будет хоть и частично но скинированым

или в design time у sSkinManager1.Active установить в False то меню также скинируется

[attachment=4653:menu.png]

[Author]

Posts