Компонент типа CheckListBox

← →
Washington © (2008-01-16 12:59) [0]

Мне бы найти компонент типа CheckListBox"а, чтобы в нём можно было поддерживать несколько строк - один итем - несколько строк, так как строки могут быть очень длинными, что экрана не хватит )

← →
{RASkov} © (2008-01-16 13:31) [1]

> [0] Washington © (16.01.08 12:59)
> Мне бы найти компонент

И "обычный" с твоей задачей справится...
См Style = lbOwnerDrawVariable
и OnMeasureItem, OnDrawItem

← →
DiamondShark © (2008-01-16 13:46) [2]

Где-то примерно так:

var
FCheckWidth,
FCheckHeight: Integer;

procedure GetCheckSize;
begin
with TBitmap.Create do
try
Handle := LoadBitmap(0, PChar(32759));
FCheckWidth := Width div 4;
FCheckHeight := Height div 3;
finally
Free;
end;
end;

procedure TForm1.CheckListBox1MeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
var
rect: TREct;
begin
rect := CheckListBox1.ClientRect;
Inc(rect.Left, FCheckWidth + 2);
DrawText(CheckListBox1.Canvas.Handle, PChar(CheckListBox1.Items[Index]), -1, rect, DT_CALCRECT or DT_WORDBREAK);
Height := Succ(rect.Bottom - rect.Top);
end;

procedure TForm1.CheckListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
CheckListBox1.Canvas.FillRect(Rect);
DrawText(CheckListBox1.Canvas.Handle, PChar(CheckListBox1.Items[Index]), -1, Rect, DT_WORDBREAK);
end;

initialization
GetCheckSize;
end.

GetCheckSize нагло попёрта из CheckLst.pas

← →
{RASkov} © (2008-01-16 13:46) [3]

procedure TForm1.CheckListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); var R: Trect; begin if Control is TCheckListBox then begin R:=TCheckListBox(Control).ItemRect(Index); Height:=DrawText(TCheckListBox(Control).Canvas.Handle, PChar(TCheckListBox(Control).Items[Index]), -1, R, DT_CALCRECT or DT_WORDBREAK); end; end; procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin if Control is TCheckListBox then with TCheckListBox(Control) do begin Canvas.FillRect(Rect); DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect, DT_WORDBREAK); end; end;

И почему в MeasureItem параметр обозвали Height? Почему не AHeight??
Не красиво получается :)

← →
DiamondShark © (2008-01-16 13:50) [4]

> {RASkov} © (16.01.08 13:46) [3]

Ширину пипочки забыл ;)

← →
{RASkov} © (2008-01-16 13:51) [5]

> И почему в MeasureItem параметр обозвали Height? Почему не AHeight??

Хм....Вот так можно "обмануть":
procedure TForm1.CheckListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); var R: Trect; AHeight: Integer absolute Height; begin if Control is TCheckListBox then with TCheckListBox(Control) do begin R:=ItemRect(Index); AHeight:=DrawText(Canvas.Handle, PChar(Items[Index]), -1, R, DT_CALCRECT or DT_WORDBREAK); end; end;
:)

← →
{RASkov} © (2008-01-16 13:52) [6]

> [4] DiamondShark © (16.01.08 13:50)
> Ширину пипочки забыл ;)

? Какую "пипочку"? :)

← →
DiamondShark © (2008-01-16 13:53) [7]

> ? Какую "пипочку"? :)

чекбокс

← →
DiamondShark © (2008-01-16 13:55) [8]

Или ItemRect это уже учитывает?

← →
{RASkov} © (2008-01-16 13:57) [9]

> [8] DiamondShark © (16.01.08 13:55)
> Или ItemRect это уже учитывает?

Да нет.... вроде бы нет :(
Сейчас разберемся :)

← →
{RASkov} © (2008-01-16 14:27) [10]

Таки да... в свой код добавил ширину "пипки"... Стало "лучше" ) - т.е. правильнее...
Вот [3] исправленный:

var FCheckWidth, FCheckHeight: Integer; procedure GetCheckSize; begin with TBitmap.Create do try Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES)); FCheckWidth := Width div 4; FCheckHeight := Height div 3; finally Free; end; end; procedure TForm1.CheckListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); var R: Trect; AHeight: Integer absolute Height; begin if Control is TCheckListBox then with TCheckListBox(Control) do begin R:=ItemRect(Index); Inc(R.Left, FCheckWidth+2); AHeight:=DrawText(Canvas.Handle, PChar(Items[Index]), -1, R, DT_CALCRECT or DT_WORDBREAK); end; end; procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin if Control is TCheckListBox then with TCheckListBox(Control) do begin Canvas.FillRect(Rect); DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect, DT_WORDBREAK); end; end; initialization GetCheckSize; end.

Но для "последней записи" оба варианта([2] и [3]) криво работают.... может я чего и не углядел(
Последняя запись - последний(яя) элемент(строка) в ЧекЛистБоксе...

← →
DiamondShark © (2008-01-16 15:11) [11]

Сойдёт для сельской местности.
У меня ничего кривого не обнаруживается.

← →
Игорь Шевченко © (2008-01-16 15:53) [12]

> AHeight: Integer absolute Height;

За это эцих с гвоздями

← →
{RASkov} © (2008-01-16 16:03) [13]

> [11] DiamondShark © (16.01.08 15:11)
> У меня ничего кривого не обнаруживается.

Добавь последний Item из двух слов, типа такого: "Первоеслово второеслово".
Ширину чеклистбокса сделай так, чтоб второе слово не умещалось, т.е. должно было бы перенестись и увеличтся размер самого итема....
У меня при тестах вроде бы не переносилось... и не рисовалось вообще второе слово...

> [12] Игорь Шевченко © (16.01.08 15:53)
> > AHeight: Integer absolute Height;
>
> За это эцих с гвоздями

А за то что параметр "обозвали" чуть ли не общим, для всех объектов, свойством Height - Это нормально? За это с гвоздями не нужно?)

← →
Игорь Шевченко © (2008-01-16 16:09) [14]

{RASkov} © (16.01.08 16:03) [13]

Вот в посте [2] нету изврата absolute

← →
DiamondShark © (2008-01-16 16:10) [15]

> У меня при тестах вроде бы не переносилось... и не рисовалось
> вообще второе слово...

переносится и рисуется. естественно, обрезается концовка последнего слова.
D5 W2k

← →
ketmar © (2008-01-16 16:11) [16]

>[12] Игорь Шевченко ©(16.01.08 15:53)
а что делать, если в Delphi забыли вмонтировать alias"ы?

← →
{RASkov} © (2008-01-16 16:19) [17]

> [14] Игорь Шевченко © (16.01.08 16:09)
> Вот в посте [2] нету изврата absolute

:)
Согласен. Там есть другой "изврат"
DrawText(CheckListBox1.Canvas.Handle, PChar(CheckListBox1.Items[Index]), -1, rect, DT_CALCRECT or DT_WORDBREAK); или DrawText(TCheckListBox(Control).Canvas.Handle, PChar(TCheckListBox(Control).Items[Index]), -1, rect, DT_CALCRECT or DT_WORDBREAK);
vs
with TCheckListBox(Control) do begin .... AHeight:=DrawText(Canvas.Handle, PChar(Items[Index]), -1, R, DT_CALCRECT or DT_WORDBREAK); end;

Есть конечно и третий вариант:
var R: Trect; AHeight: Integer; begin if Control is TCheckListBox then begin with TCheckListBox(Control) do begin R:=ItemRect(Index); Inc(R.Left, FCheckWidth+2); AHeight:=DrawText(Canvas.Handle, PChar(Items[Index]), -1, R, DT_CALCRECT or DT_WORDBREAK); end; Height:=AHeight; end; end;
Имхо конечно всё... )

> [15] DiamondShark © (16.01.08 16:10)

Попозже еще раз гляну..... может я чего не так делал....

ЗЫ: Развели тут спор.... нет чтоб компонент кинулись искать.... :)

← →
Игорь Шевченко © (2008-01-16 16:20) [18]

ketmar © (16.01.08 16:11) [16]

> а что делать, если в Delphi забыли вмонтировать alias"ы?

А что это ?

{RASkov} © (16.01.08 16:03) [13]

> А за то что параметр "обозвали" чуть ли не общим, для всех
> объектов, свойством Height - Это нормально? За это с гвоздями
> не нужно?)

А в описание функции буковку A перед словом Height религия поставить не позволяет ? То, что сгенерировала среда - это незыблемо ? :)

unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormClose(ASender: TObject; var AAction: TCloseAction); end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormClose(ASender: TObject; var AAction: TCloseAction); begin ShowMessage("Close"); end; end.

← →
{RASkov} © (2008-01-16 16:23) [19]

> [18] Игорь Шевченко © (16.01.08 16:20)
> А в описание функции буковку A перед словом Height религия
> поставить не позволяет ?

Опа.... Вот с этого и надо было начинать.... :) +1

> Согласен. Там есть другой "изврат"

Это не изврат. Это защита от копипастеров.

>[18] Игорь Шевченко ©(16.01.08 16:20)
>ketmar © (16.01.08 16:11) [16]
>>а что делать, если в Delphi забыли вмонтировать alias"ы?
>А что это ?
var a: integer; b: alias for a; c: record d: integer; e: Single; end; f: alias for c.e;
что-то типа такого.

> а что делать, если в Delphi забыли вмонтировать alias"ы?

вообще непонятно: как жить теперь? )

>[23] clickmaker ©(16.01.08 17:05)
>>а что делать, если в Delphi забыли вмонтировать alias"ы?
>вообще непонятно: как жить теперь? )
не писать на Delphi. я не пишу. %-)

> не писать на Delphi

из-за такой-то мелочи? фи...

> не писать на Delphi. я не пишу. %-)

слава богу, SQL есть... )

Компонент типа CheckListBox Найти похожие ветки