Форум: "Начинающим";
Текущий архив: 2007.08.19;
Скачать: [xml.tar.bz2];
ВнизTListView; закрасить/затереть текст в колонке. Найти похожие ветки
← →
JetAPI © (2007-07-18 00:45) [0]Привет всем.
Сразу к сути.... Вот код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
const a: array [0..2] of integer = (100,150,200);
var
i,j: Integer;
begin
ListView1.ViewStyle:=vsReport;
with ListView1 do begin
for i:=0 to 2 do begin
Columns.Add.Width:=a[i];
Column[i].Caption:="Column #"+IntToStr(i+1);
end;
for i:=0 to 3 do begin
Items.Add.Caption:="Item "+IntToStr(i+1);
for j:=0 to 1 do
Items.Item[i].SubItems.Add("Subitem "+IntToStr(j+1))
end;
end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var r: TRect;
begin
r:=Item.DisplayRect(drBounds);
r.Left:=ListView1.Column[0].Width;
ListView1.Canvas.Brush.Color:=clWindow;
ListView1.Canvas.FillRect(r);
end;
end.
Этот код стирает целиком всю колонку...
r:=Item.DisplayRect(drBounds);
r.Left:=ListView1.Column[0].Width;
Но... при этом... Текст в моем ListView делается жирным.
Что?.. Как?.. Почему? ничего не понимаю. Найдите в коде ошибку.. или помогите переписать.
За ранее спасибо.
← →
{RASkov} © (2007-07-18 13:08) [1]Перемести сей (
ListView1CustomDrawSubItem
) код в OnAdvancedCustomDrawSubItem..
← →
JetAPI © (2007-07-18 16:12) [2]Попробую... Спасибо!
← →
JetAPI © (2007-07-18 16:21) [3]Ничего не получается... Результат тот же... Все сабитемы прорисовываютс
жирным. Где еще можно посмотреть ошибку?..
procedure TForm1.FormCreate(Sender: TObject);
const a: array [0..2] of integer = (100,150,200);
var
i,j: Integer;
begin
ListView1.ViewStyle:=vsReport;
with ListView1 do begin
for i:=0 to 2 do begin
Columns.Add.Width:=a[i];
Column[i].Caption:="Column #"+IntToStr(i+1);
end;
for i:=0 to 3 do begin
Items.Add.Caption:="Item "+IntToStr(i+1);
for j:=0 to 1 do
Items.Item[i].SubItems.Add("Subitem "+IntToStr(j+1))
end;
end;
end;
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var r: TRect;
begin
r:=ListView1.Items[1].DisplayRect(drBounds);
ListView1.Canvas.Brush.Color:=clWindow;
ListView1.Canvas.FillRect(r);
end;
← →
{RASkov} © (2007-07-18 17:35) [4]> [3] JetAPI © (18.07.07 16:21)
> procedure TForm1.ListView1AdvancedCustomDrawSubItem(
> Sender: TCustomListView; Item: TListItem; SubItem: Integer;
>
> State: TCustomDrawState; Stage: TCustomDrawStage;
> var DefaultDraw: Boolean);
> var r: TRect;
> begin
> r:=ListView1.Items[1].DisplayRect(drBounds);
> ListView1.Canvas.Brush.Color:=clWindow;
> ListView1.Canvas.FillRect(r);
> end;
А так:
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var r: TRect;
begin
r:=Item.DisplayRect(drBounds);
r.Left:=ListView1.Column[0].Width;
ListView1.Canvas.Brush.Color:=clWindow;
ListView1.Canvas.FillRect(r);
end;
?? Я у себя попробывал и [0] и этот. В [0] имеет место быть описанная ситуация, а в адвансет такого эфекта нет....
Или я не верно понял суть вопроса в [0]... (
← →
JetAPI © (2007-07-18 18:05) [5]RASkov, Вы знаете... Вы все поняли правильно.
Просто я, задал такой вопрос потому, что самостоятельно, решить, более сложную задачу не сумел, и решил тогда, пойти путем, от простого, к сложному.
Задача такова:
В отдельно взятой ячейке (Subitem, к примеру {1}), нужно, используя TCanvas , с помощью FillRect и TextOut, сперва затереть, а потом вписать любую нужную мне строку.
Результаты - плачевны; у меня ничего не получается... Текст в TListView прорисовывается жирным. Почему?.. ума не дам!
Это большее, к чему я сам смог прийти. Вот код:
procedure TForm1.FormCreate(Sender: TObject);
const a: array [0..2] of integer = (100,150,200);
var
i,j: Integer;
begin
ListView1.ViewStyle:=vsReport;
with ListView1 do begin
for i:=0 to 2 do begin
Columns.Add.Width:=a[i];
Column[i].Caption:="Column #"+IntToStr(i+1);
end;
for i:=0 to 3 do begin
Items.Add.Caption:="Item "+IntToStr(i+1);
for j:=0 to 1 do
Items.Item[i].SubItems.Add("Subitem "+IntToStr(j+1))
end;
end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var r: TRect;
begin
if (Item.Index = 1) and (SubItem = 1) then begin
DefaultDraw:=false;
r:=ListView1.Items[1].DisplayRect(drBounds);
r.Left:=ListView1.Columns[1].Width;
r.Right:=r.Left+ListView1.Columns[2].Width;
ListView1.Canvas.Brush.Color:=clWindow;
ListView1.Canvas.FillRect(r);
ListView1.Canvas.TextOut(r.Left+3,r.Top+3,"Hello");
end;
end;
Если поможете мне, буду Вам очень признателен...
Увлечен Делфи, и вот споткнулся...
Очень жаль, что нельзя прикрепить для наглядности скриншот.
← →
{RASkov} © (2007-07-18 20:49) [6]> [5] JetAPI © (18.07.07 18:05)
> Очень жаль, что нельзя прикрепить для наглядности скриншот.
Его(скрин) можно куда нибудь положить, а сюда ссылку...
Сейчас попробую еще раз разобраться что нужно и что не получается...
← →
JetAPI © (2007-07-18 22:53) [7]RASkov
Ищу на форуме ящик личных сообщений, но что-то не нашел.
Я хотел спросить у Вас, ваш почтовый адрес, и тогда бы послал... Всё, что нужно.
← →
{RASkov} © (2007-07-18 23:21) [8]> [7] JetAPI © (18.07.07 22:53)
> Ищу на форуме ящик личных сообщений
нет его здесь :)
> и тогда бы послал... Всё, что нужно.
Да и так уже все есть... в твоих постах..
И я в принципе понял суть проблемы, только пока не нашел "правильного" решения...
Хотя если тебе просто затереть одну колонку, то можно очень просто сделать, а если выводить в нее самому текст.... тут грабли.)
← →
JetAPI © (2007-07-19 00:26) [9]Я, словом, тоже ничего не могу сделать.... Даже не знаю, с какой стороны подойти.
← →
{RASkov} © (2007-07-19 00:52) [10]> [9] JetAPI © (19.07.07 00:26)
Попробуй вот такой вариант:procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var Rect: TRect; N: Integer;
begin
Rect:=Item.DisplayRect(drBounds);
if Item.Selected then Sender.Canvas.Brush.Color:=clHighlight
else Sender.Canvas.Brush.Color:=clWindow;
Sender.Canvas.FillRect(Rect);
Rect:=Item.DisplayRect(drLabel);
Sender.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top, Item.Caption);
Rect:=Item.DisplayRect(drBounds);
for N:= 0 to Item.SubItems.Count-1 do begin
Rect.Left:=Rect.Left+Sender.Column[N].Width;
Rect.Right:=Rect.Left+Sender.Column[N+1].Width;
if N=0 then Sender.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top, "Hello")
else Sender.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top, Item.SubItems[N]);
end;
end;
← →
{RASkov} © (2007-07-19 01:47) [11]Вот еще вариант:
procedure TForm1.FormCreate(Sender: TObject); из [0]uses ..., CommCtrl;
...
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var Rect: TRect;
begin
ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @Rect);
if SubItem=1 then Sender.Canvas.TextRect(Rect, Rect.Left, Rect.Top, "Hello");
if Assigned(Sender.Canvas.Font.OnChange) then Sender.Canvas.Font.OnChange(Font);
end;
← →
JetAPI © (2007-07-19 12:14) [12]RASkov, спасибо, что хоть как-то пытаетесь помочь... приятно... Спасибо.
На 100% задача для маеня не решаема - дней 10 уже с ней вожусь.
Вчера мне подсказали решение, и я, не поделиться с Вами, просто не мог. По крайне мере, с моей стороны, это было бы не уважительно к Вам.
Вот код.. Посмотрите... Может Вам, тоже будет интересно.
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
r: TRect;
i: Integer;
begin
if (Item.Index = 2) and (SubItem = 1) then begin
DefaultDraw := false;
r := Item.DisplayRect(drBounds);
for i := 0 to SubItem - 1 do begin
r.Left := r.Left + TListView(sender).Column[i].Width;
end;
r.Right := R.Left + TListView(sender).Column[SubItem].Width;
TListView(sender).Canvas.Brush.Color := clWindow;
TListView(sender).Canvas.FillRect(r);
TListView(sender).Canvas.TextOut(r.Left+3, r.Top+1,"Hello");
end
else begin
DefaultDraw := true;
end;
TListView(Sender).Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
TListView(Sender).Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
end;
П.с.
Попробовал, предложенный Вами 1-ый вариант... не подошёл...
Сейчас попробую второй.
← →
{RASkov} © (2007-07-19 19:24) [13]> [12] JetAPI © (19.07.07 12:14)
> Попробовал, предложенный Вами 1-ый вариант... не подошёл...
Ну чесное слово.... может всётаки поподробнее проблему опишешь...
У меня-то вроде все нормально, хотя я фик знает, что должно в итоге быть :)
Имхо... лучше строкуTListView(Sender).Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
заменить на:if Assigned(Sender.Canvas.Font.OnChange) then Sender.Canvas.Font.OnChange(Sender.Canvas.Font);
или вариант короче:with Sender.Canvas do
if Assigned(Font.OnChange) then Font.OnChange(Font);
А вообще ответ на вопрос
> TListView; закрасить/затереть текст в колонке.
например 2 колонки в листвью, Вот:procedure TForm1.ListView3CustomDrawSubItem(Sender: TCustomListView;
:)
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
begin
if (SubItem=1) {and (Item.Index=2)} then DefaultDraw:=False;
end;
Впринципе... код в [11] делает тоже самое что и в [12] если заменить строчку:if SubItem=1 then Sender.Canvas.TextRect(Rect, Rect.Left, Rect.Top, "Hello");
наif (SubItem=1) and (Item.Index=2) then Sender.Canvas.TextRect(Rect, Rect.Left, Rect.Top, "Hello");
Или опять это только у меня так? ;)
← →
Loginov Dmitry © (2007-07-19 20:02) [14]Универсальный подход:
создавай временный битмап, рисуй на нем, а в конце копируй на канву TListView.
← →
JetAPI © (2007-07-19 22:57) [15]to Raskov
> Ну чесное слово.... может всётаки поподробнее проблему опишешь.
> ..
В общем так... Буду лаконичен, чтобы не утомлять.
На форме лежит TListView - режим ListView1.ViewStyle:=vsReport;
Есть Items и SubItems - суть не важно сколько их, главное есть.
Теперь, нам нужно, в отдельно взятом SubItems, например в SubItems[2],
переписать текст, но сделав это, только с помощью TextOut.
К примеру...
Колонка 1 Колонка 2 Колонка 3 Колонка 4
Итем 1 Сабитем 1 Сабитем 2 Сабитем 3
Итем 2 Сабитем 1 Хелло Сабитем 3
Итем 3 Сабитем 1 Сабитем 2 Сабитем 3
Итем 4 Сабитем 1 Сабитем 2 Сабитем 3
Теперь, нам нужно заменить SubItems[2], в Итем 2 и Колонка 3, на текст
Хелло.
Т.е., получается, как бы стереть ячейку с помощью FillRect, а потом, с помощью TextOut вписать. И вот, у меня.... ничего не получается....
Код мне подсказали потом... Но он очень громоздким, мне кажется, получился. Хотя и выполняет нужную задачу.
procedure TForm1.FormCreate(Sender: TObject);
const a: array [0..2] of integer = (100,150,200);
var
i,j: Integer;
begin
ListView1.ViewStyle:=vsReport;
with ListView1 do begin
for i:=0 to 2 do begin
Columns.Add.Width:=a[i];
Column[i].Caption:="Column #"+IntToStr(i+1);
end;
for i:=0 to 3 do begin
Items.Add.Caption:="Item "+IntToStr(i+1);
for j:=0 to 1 do
Items.Item[i].SubItems.Add("Subitem "+IntToStr(j+1))
end;
end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
r: TRect;
i: Integer;
begin
if (Item.Index = 2) and (SubItem = 1) then begin
DefaultDraw := false;
r := Item.DisplayRect(drBounds);
for i := 0 to SubItem - 1 do begin
r.Left := r.Left + TListView(sender).Column[i].Width;
end;
r.Right := R.Left + TListView(sender).Column[SubItem].Width;
TListView(sender).Canvas.Brush.Color := clWindow;
TListView(sender).Canvas.FillRect(r);
TListView(sender).Canvas.TextOut(r.Left+3, r.Top+1,"Hello");
end
else begin
DefaultDraw := true;
end;
TListView(Sender).Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
TListView(Sender).Canvas.Font.Color := GetSysColor(COLOR_WINDOWTEXT);
end;
Можно упростить код?...
п.с. Сейчас попробую новые Ваши предложения.
to Loginov Dmitry
Я Делфи только осваиваю... Очень! Очень нравится... Но похвастать пока мне нечем. Нужна практика и живые примеры.
← →
JetAPI © (2007-07-19 23:09) [16]to Raskov
Воооооот!...... То что нужно!. Работает! Затирает... Ура! Ура!..
Только, как вот теперь, с помощью TextOut, вписать нужный мне текст; например, Хелло.
Как?..
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
begin
if (Item.Index = 1) фтв (SubItem = 1) then DefaultDraw:=False;
end;
← →
JetAPI © (2007-07-19 23:46) [17]
> Только, как вот теперь, с помощью TextOut, вписать нужный
> мне текст; например, Хелло.
> Как?..
То есть, сделать это не громоздко и попроще...
← →
{RASkov} © (2007-07-20 04:33) [18]> [16] JetAPI © (19.07.07 23:09)
> [17] JetAPI © (19.07.07 23:46)
Ну а пробывал, например, код из [11] с поправками в [13]?
Делает именно то, о чем в [15] и не "громоздко" :)
TextRect от TextOut знаешь чем отличается? так вот тут как раз наверное всетаки нужен TextRect, а не TextOut - так как есть область колонки и не нужно текст выводить "лишнего"... хотя это зависит от задачи, но....
Есть еще АПИшная "штука" DrawText, тоже может пригодиться в данном случае... но я пока не вижу в ней смысла, скажу только то, что с ее помощью можно выводить текст по центру или от правого края колонки, что конечно можно сделать и другими способами, но сложнее....
Вот подправленный пример (последний раз) :) и с DrawText (вывод по центру колонки):uses ..., CommCtrl;
...
procedure TForm1.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var Rect: TRect;
begin
ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @Rect);
if (Item.Index=2) and (SubItem=1) then DrawText(Sender.Canvas.Handle, "Hello", -1, Rect, DT_CENTER);
if Assigned(Sender.Canvas.Font.OnChange) then Sender.Canvas.Font.OnChange(Sender.Canvas.Font);
end;
Можно без CommCtrl (ListView_GetSubItemRect
), но Рект нужно будет высчитывать примерно так как ты и получал его....
Всего-лишь один вот этот обработчик нужен листвью, и проблема решена ;)
Но если уж так надо с TextOut, то используй его:if (Item.Index=2) and (SubItem=1) then Sender.Canvas.TextOut(Rect.Left+3, Rect.Top+1, "Hello");
Ладно.... удачи.
← →
JetAPI © (2007-07-20 11:27) [19]to Raskov
Вот этот вариант лучше... нежели тот... что был предложен выше!
На мой взгляд он проще... Верно ж ведь?
Оставлю его:
procedure TForm1.FormCreate(Sender: TObject);
const a: array [0..2] of integer = (100,150,200);
var
i,j: Integer;
begin
ListView1.ViewStyle:=vsReport;
with ListView1 do begin
for i:=0 to 2 do begin
Columns.Add.Width:=a[i];
Column[i].Caption:="Column #"+IntToStr(i+1);
end;
for i:=0 to 3 do begin
Items.Add.Caption:="Item "+IntToStr(i+1);
for j:=0 to 1 do
Items.Item[i].SubItems.Add("Subitem "+IntToStr(j+1))
end;
end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
begin
if (Item.Index = 1) and (SubItem = 1) then DefaultDraw:=False;
end;
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var rect: TRect;
begin
ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @Rect);
if (Item.Index = 1) and (SubItem=1) then Sender.Canvas.TextOut(Rect.Left+3, Rect.Top+1, "Hello");
if Assigned(Sender.Canvas.Font.OnChange) then Sender.Canvas.Font.OnChange(Sender.Canvas.Font);
end;
Спасибо! Спасибо! Спасибо!
Сейчас, по-пунктно разбираю весь код... Хотелось бы поднятся в программировании до такого же уровня.
п.с.
Если будут вопросы, можно еще раз обратиться?
← →
JetAPI © (2007-07-20 11:41) [20]to Raskov
А можно все это в одном обработчике сделать?..
Вот так например... Попробовал уже... Все получается...
procedure TForm1.ListView1AdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var rect: TRect;
begin
ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @Rect);
if (Item.Index = 1) and (SubItem = 1) then begin
DefaultDraw:=False;
Sender.Canvas.TextOut(Rect.Left+3, Rect.Top+1, "Hello");
end;
if Assigned(Sender.Canvas.Font.OnChange) then
Sender.Canvas.Font.OnChange(Sender.Canvas.Font);
end;
Нет ли какой "скрытой" ошибки?.. Посмотрите пожалуйста...
← →
{RASkov} © (2007-07-20 15:14) [21]> [20] JetAPI © (20.07.07 11:41)
> А можно все это в одном обработчике сделать
Именно так я и предлогал :) Вопрос: А почему всеж TextOut??
function ListView_GetSubItemRect(hwndLV: HWND; iItem, iSubItem: Integer; code: DWORD; prc: PRect): BOOL;
ListView_GetSubItemRect - возвращает прямоугольник (Rect), указатель на который переданный последним параметром и
hwndLV - Hendle ListView;
iItem - Индекс итема
iSubItem - номер сабитема
code - указывает, какую именно область брать.
Возвращаемый результат... как обычно True - Ok и False при "косяке"...
> Если будут вопросы, можно еще раз обратиться?
Можно.... только сначала поищи ответы в Ф1, SDK, MSDN, RSDN, gogle, Ya.ru ну и наконец на форуме в уже имеющихся ветках.....
← →
JetAPI © (2007-07-20 18:28) [22]to Raskov
Еще один вопрос... ладно?
А более правильней как?.. эту функцию написать: до условия, или после?
...
{ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @r);}
if (Item.Index = 1) and (SubItem = 1) then begin
DefaultDraw:=false;
ListView_GetSubItemRect(ListView1.Handle, Item.Index, SubItem, LVIR_BOUNDS, @r);
...
← →
{RASkov} © (2007-07-20 18:31) [23]> [22] JetAPI © (20.07.07 18:28)
Если тебе Рект не нужен "вне условия" то пиши в ее(функцию получения Рект) "в условии"...
← →
JetAPI © (2007-07-20 18:35) [24]to Raskov
Да... TxtRect подходит больше... Буду использовать его.
> TextRect от TextOut знаешь чем отличается? так вот тут как
> раз наверное всетаки нужен TextRect, а не TextOut - так
> как есть область колонки и не нужно текст выводить "лишнего".
> .. хотя это зависит от задачи, но....
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2007.08.19;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.046 c