Текущий архив: 2006.01.08;
Скачать: CL | DM;

Вниз

ListBox убрать рамку в выделенной строке   Найти похожие ветки 

← →
Дмитрий_05   (2005-12-01 13:44) [0]

Как в ListBox-е убрать рамку в выделенной строке? она рисуется вокруг строки как бы пунктиром... вот как от нее можно избавиться?

---

← →
Игорь Шевченко ©   (2005-12-01 14:14) [1]

В OnwerDraw ListBox переписать метод CNDrawItem, убрав оттуда вызов DrawFocusRect, в стандартном - не знаю :)

---

← →
Дмитрий_05   (2005-12-01 20:01) [2]

Т.е. так? И все какие переменные потребуются в procedure TMyListBox.CNDrawItem мне их нужно будет объявить в своем типе TMyListBox и тогда WM_PAINT переписывать придется...? или я неправильно понял?

type
TMyListBox = class(TListBox)
 protected
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
 end;

...

procedure TMyListBox.CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
begin
.........................все скопировать из ListBox CNDrawItem, кроме вызова DrawFocusRect
end;


---

← →
Igor_thief   (2005-12-02 12:46) [3]

При прорисовке элемента просто вызови DrawFoсusRect. Все!

---

← →
Дмитрий_05   (2005-12-02 17:14) [4]

это в самом событии ListBox-а OnDrawItem? или всеже в своем компоненте унаследованно от TListBox?

---

← →
Igor_thief   (2005-12-02 17:16) [5]

Дмитрий_05   (02.12.05 17:14) [4]
В OnDrawItem.

---

← →
Дмитрий_05   (2005-12-03 01:41) [6]

Не помогло:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
begin
DrawFocusRect(ListBox1.Canvas.Handle, Rect);
end;


---

← →
Дмитрий_05   (2005-12-03 01:44) [7]

свойстро Style = lbOwnerDrawVariable, рамка рисуется на всех строках сразу...(((

---

← →
XCoder ©   (2005-12-03 02:00) [8]

Так просто рамку не убереш, так как она рисуется после вызова OnDrawItem. Я использовал TCustomListBox. Перекрыл ему обработчик WM_PAINT и написал свой. Установил новый компонент в палитру и использовал его. Вот и все.

---

← →
Джо ©   (2005-12-03 02:01) [9]

> рамка рисуется на всех строках сразу

Так ты же ее и рисуешь на ВСЕХ строках. А тебе нужно рисовать только на выделенных, т.е, как-то в таком роде:
 with TListBox(Control).Canvas do
 begin
   if odSelected in State then
   begin
     Brush.Color := clActiveCaption;
     Font.Color := clHighlightText;
   end
   else
   begin
     Brush.Color := clWindow;
     Font.Color := clWindowText;
   end;
   ListBox1.Canvas. FillRect (Rect);

   TextOut(Rect.Left,Rect.Top,TListBox(Control).Items[Index]);

   // рамку затираем только на выделенной строке
   if (odSelected in State) then
     DrawFocusRect (Rect);
 end;


---

← →
Джо ©   (2005-12-03 02:06) [10]

> [9] Джо ©   (03.12.05 02:01)

Лучше это условие записать вот так (возможно, еще пару флагов проверить, посмотри сам):

   if (odSelected in State) and (odFocused in State) then
     DrawFocusRect (Rect);


---

← →
Джо ©   (2005-12-03 02:08) [11]

> [8] XCoder ©   (03.12.05 02:00)
> Так просто рамку не убереш, так как она рисуется после вызова
> OnDrawItem.

Вот как раз потому, если мы в OnDrawItem нарисуем focused-рамку, то следующий вызов DrawFocusRect (уже после OnDrawItem) на этом же месте даст чистую картинку, там же xor используется :)

---

← →
XCoder ©   (2005-12-03 02:20) [12]

Можно и так, я против ничего не имею, просто рассказал как сам делал.

---

← →
Дмитрий_05   (2005-12-03 22:36) [13]

Мне тут посказали вот как сделать:

TXListBox = class(TListBox)
private
 procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
..............
procedure TXListBox.CNDrawItem(var Message: TWMDrawItem);
begin
 with Message.DrawItemStruct^ do
   itemState:=itemState and not 16;
 inherited;
end;


Решил всетаки свой компонент сделать... Решил туда еще добавить фон, картинку:

TXListBox = class(TListBox)
 private
   FPicture: TPicture;
   procedure SetPicture(const Value: TPicture);
   procedure PictureChanged(Sender: TObject);
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
   procedure WMPaint(var Message: TWMPAINT); Message WM_PAINT;
   procedure WMEraseBkgnd(var Message: TWMERASEBKGND); Message WM_ERASEBKGND;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property Picture: TPicture read FPicture write SetPicture;
 end;

...

constructor TXListBox.Create(AOwner: TComponent);
begin
inherited;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
end;

destructor TXListBox.Destroy;
begin
FPicture.Free;
inherited;
end;

procedure TXListBox.CNDrawItem(var Message: TWMDrawItem);
begin
 with Message.DrawItemStruct^ do
   itemState := itemState and not 16;
 inherited;
end;

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

procedure TXListBox.PictureChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TXListBox.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin
Message.Result := 1;
end;

procedure TXListBox.WMPaint(var Message: TWMPAINT);
var
 R: TRect;
begin
inherited;
with Canvas do
 begin
 Brush.Style := bsClear;
 R := ClientRect;
 if FPicture.Graphic <> nil then
   StretchDraw(R, FPicture.Graphic);
 end;
end;


Но у меня теперь картинка то рисуется, а строки исчезли... При выделении строк, часть картинки исчезает, т.е. заместо той строки какая была выделена, просто белый фон... и строки опять стали с рамкой... что делать?

---

← →
Джо ©   (2005-12-03 22:40) [14]

> что делать?

Читать посты в этой ветке и думать над ними. А потом уже писать "свой вариант".

---

← →
Дмитрий_05   (2005-12-03 23:28) [15]

Я нашел только вот что: http://delphimaster.net/view/1-1131899674/
но там тема так и не расскрыта...

---

← →
Дмитрий_05   (2005-12-04 22:00) [16]

Со строками разобрался, у меня небольшая проблема вот в чем. У меня этот компонент лежит на форме, которая создается диномически(по нажатию кнопки). Форма появляется, а мой ListBox не заполняется фоном, если эту форму перенести за пределы экрана а потом обратно, то фон рисуется. Прорисовка:


procedure TXListBox.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin                         // чтобы не мограл
 Message.Result := 1;
end;

procedure TXListBox.WMPaint(var Message: TWMPAINT);
var
 R: TRect;
begin
with Canvas do
 begin
 Brush.Style := bsClear;
 R := ClientRect;
 if FPicture.Graphic <> nil then
   StretchDraw(R, FPicture.Graphic);
 end;
inherited;
end;


Пробовал этот код и без WM_EraseBkgnd, тоже самое...
Пробовал и так:


procedure TXListBox.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin
if FPicture.Bitmap <> nil then
 begin
 BitBlt(Message.DC, 0, 0, ClientWidth, ClientHeight, FPicture.Bitmap.Canvas.Handle, 0, 0, srcCopy);
 Message.Result := 1;
 end
else
 inherited;
end;


так вообще не рисуется... помогите, что не так...

---

← →
Джо ©   (2005-12-04 23:23) [17]

> procedure TXListBox.WMPaint(var Message: TWMPAINT);
> var
>  R: TRect;
> begin
> with Canvas do
>  begin
>  Brush.Style := bsClear;
>  R := ClientRect;
>  if FPicture.Graphic <> nil then
>    StretchDraw(R, FPicture.Graphic);
>  end;
> inherited;
> end;

Перенести inherited в начало кода или убрать.

---

← →
Дмитрий_05   (2005-12-05 00:39) [18]

Переносил и уберал, еще до того как написать... Если совсем убрать, то в момент проектирования формы, при изменения свойства Picture, изображение не вставляется, само окно выбора изображения не закрывается никак, и Delphi как-бы виснет... Приходится выключать его через диспечер задачь... А если поставить в начало, то у меня строки не рисуются, только после того, если выделить их. Прорисовка строк, может там что-то не то я нахимичел:

type
 TXListBox = class(TListBox)
 private
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
 protected
   procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
.....
procedure TXListBox.CNDrawItem(var Message: TWMDrawItem);
var
 State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
 begin
 State := TOwnerDrawState(LongRec(itemState).Lo);
 Canvas.Handle := hDC;
 Canvas.Font := Font;
 Canvas.Brush := Brush;
 if (Integer(itemID) >= 0) and (odSelected in State) then
   begin
   Canvas.Font.Color := FSelectedTextColor;
   end;
 if Integer(itemID) >= 0 then
   DrawItem(itemID, rcItem, State);
 Canvas.Handle := 0;
 end;
end;

procedure TXListBox.DrawItem(Index: Integer; Rect: TRect;
 State: TOwnerDrawState);
var
 Flags: Longint;
 Data: String;
begin
if Assigned(OnDrawItem) then
 OnDrawItem(Self, Index, Rect, State)
else
 begin
 if Index < Count then
   begin
   Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
   if not UseRightToLeftAlignment then
     Inc(Rect.Left, 2)
   else
     Dec(Rect.Right, 2);
   Data := "";
   if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
     Data := DoGetData(Index)
   else
     Data := Items[Index];
   SetBKMode(Canvas.Handle, TRANSPARENT);
   DrawText(Canvas.Handle, PChar(Data), Length(Data), Rect, Flags);
   end;
 end;
end;


P.S. То что не используется FillRect, я решил выделять строки только цветом шрифта.

---

← →
Игорь Шевченко ©   (2005-12-05 12:18) [19]

http://kladovka.net.ru/download.cgi?id=193

---

← →
Дмитрий_05   (2005-12-05 19:50) [20]

Спасибо за ссылку... поразбирался... посмотрел метод перерисовки окна... в моем случае вроде все так... но блин... исчезают строки и все...((( Может само сообщение не доходит о перерисовки строк CN_DRAWITEM? просто если сделать так: вот выделить в ListBox-е по строчке, чтобы они все показались... а потом перенести форму за пределы монитора а потом назад, строки опять исчезают, а сам фон рисуется без проблем... вот в чем дело..(((

---

← →
Дмитрий_05   (2005-12-05 19:53) [21]

Сори... Ошибся... посмотрел метод перерисовки строк, а не окна...)))))

---

← →
Дмитрий_05   (2005-12-06 19:00) [22]

Подскажите пожалуйста что не так? Может действительно сообщения не доходят о перерисовке строк?

---

← →
Игорь Шевченко ©   (2005-12-07 10:18) [23]

> Подскажите пожалуйста что не так?


А где код, в котором не так ?

---

← →
Дмитрий_05   (2005-12-07 12:26) [24]

я уже разобрался ))) может кому пригодится:

unit XListBox;

interface

uses
 Windows, Messages, Classes, Controls, StdCtrls, Graphics, SysUtils;

type
 TXListBox = class(TListBox)
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 protected
   procedure CreateParams(var Params: TCreateParams); override;
   procedure RecreateBack; virtual;
 private
   procedure PictureChanged(Sender: TObject);
   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
   procedure WMEraseBkgnd(var Message: TWMERASEBKGND); Message WM_ERASEBKGND;
   procedure WMHScroll(var Message: TWMHScroll); message WM_HScroll;
   procedure WMVScroll(var Message: TWMVScroll); message WM_VScroll;
   procedure WMMOUSEWHEEL(var Message: TWMMOUSEWHEEL); message WM_MOUSEWHEEL;
 private
   FBack: TBitmap;
   FPicture: TPicture;
   FSelectedTextColor: TColor;
   procedure SetPicture(const Value: TPicture);
   procedure SetSelectedTextColor(const Value: TColor);
 published
   property Picture: TPicture read FPicture write SetPicture;
   property SelectedTextColor: TColor read FSelectedTextColor write SetSelectedTextColor default clHighlightText;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("MyComp", [TXListBox]);
end;

constructor TXListBox.Create(AOwner: TComponent);
begin
 inherited;
 FBack := TBitmap.Create;
 FPicture := TPicture.Create;
 FPicture.OnChange := PictureChanged;
 FSelectedTextColor := clRed;// clHighlightText;
end;

destructor TXListBox.Destroy;
begin
 FPicture.Free;
 FBack.Free;
 inherited;
end;

procedure TXListBox.CreateParams(var Params: TCreateParams);
begin
 inherited;
 with Params do begin
   if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
     Style := Style or LBS_OWNERDRAWFIXED;
   Style := Style or BS_OWNERDRAW{ or WS_CLIPCHILDREN};
 end;
end;

procedure TXListBox.RecreateBack;
begin
 if HandleAllocated then
   with FBack, Canvas do begin
     Width  := ClientWidth;
     Height := ClientHeight;
     Brush.Color := Self.Color;
     if FPicture.Graphic <> nil then
       StretchDraw(ClipRect, FPicture.Graphic)
     else
       FillRect(ClipRect);
   end;
end;

procedure TXListBox.PictureChanged(Sender: TObject);
begin
 RecreateBack;
 Invalidate;
end;

procedure TXListBox.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin
 if (FBack.Width <> ClientWidth) or (FBack.Height <> ClientHeight) then
   RecreateBack;
 Canvas.Draw(0, 0, FBack);
 InvalidateRect(Handle, nil, false);
 Message.Result := 1;
end;

procedure TXListBox.WMPaint(var Message: TWMPaint);
begin
 inherited;
 if Items.Count = 0 then Canvas.Draw(0, 0, FBack);
end;

procedure TXListBox.CNDrawItem(var Message: TWMDrawItem);
var
 State: TOwnerDrawState;
begin
 with Message.DrawItemStruct^ do
 begin
   State := TOwnerDrawState(LongRec(itemState).Lo);
   Canvas.Handle := hDC;
   Canvas.Font := Font;
   Canvas.Brush := Brush;
   if (Integer(itemID) >= 0) and (odFocused in State) then
     Canvas.Font.Color := SelectedTextColor;
   Canvas.Brush.Style := bsClear;
   if Integer(itemID) >= TopIndex then
     DrawItem(itemID, rcItem, State);
   Canvas.Handle := 0;
 end;
end;

procedure TXListBox.WMHScroll(var Message: TWMHScroll);
begin
 if Message.ScrollBar = 0 then
   begin
     LockWindowUpdate(Handle);
     inherited;
     LockWindowUpdate(0);
     InvalidateRect(Handle, nil, true);
   end
 else
   inherited;
end;

procedure TXListBox.WMVScroll(var Message: TWMVScroll);
begin
 if Message.ScrollBar = 0 then
   begin
     LockWindowUpdate(Handle);
     inherited;
     LockWindowUpdate(0);
     InvalidateRect(Handle, nil, true);
   end
 else
   inherited;
end;

procedure TXListBox.WMMOUSEWHEEL(var Message: TWMMOUSEWHEEL);
begin
 if GetFocus = Handle then
   begin
     LockWindowUpdate(Handle);
     inherited;
     LockWindowUpdate(0);
     InvalidateRect(Handle, nil, true);
   end
 else
   inherited;
end;

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

procedure TXListBox.SetSelectedTextColor(const Value: TColor);
begin
 if FSelectedTextColor = Value then exit;
 FSelectedTextColor := Value;
 Invalidate;
end;

end.


Если можно... подскажите пожалуйста, как сделать чтобы при потере фокуса строка в таком ListBox-е оставалась выделенной, т.е. оставалась SelectedTextColor цветом. И еще если можно, сделать так чтобы строки можно было перетаскивать мышкой...

---

← →
Игорь Шевченко ©   (2005-12-07 12:31) [25]

> Если можно... подскажите пожалуйста, как сделать чтобы при
> потере фокуса строка в таком ListBox-е оставалась выделенной


в CNDrawItem убрать проверку на odFocused, а проверять на odSelected ?

---

← →
Дмитрий_05   (2005-12-07 12:51) [26]

Игорь Шевченко, точно... что-то я не догадался, наверно из за того что не спал всю ночь, торможу уже :) Сейчас я на работе, тут нету Delphi, дома попробую :) А вот чтобы строки можно было перемещать мышкой, т.е. имеется ввиду если ее "взять и потацить", чтобы менялся ее индекс в зависимости от положения курсора, что посоветуете? :)

---

← →
Игорь Шевченко ©   (2005-12-07 14:07) [27]

Дмитрий_05   (07.12.05 12:51) [26]


> А вот чтобы строки можно было перемещать мышкой, т.е. имеется
> ввиду если ее "взять и потацить"


unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
   procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
     State: TDragState; var Accept: Boolean);
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbLeft then
   ListBox1.BeginDrag({not (Button = mbLeft)}false);
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
 if Source = ListBox1 then
   with ListBox1,ListBox1.Items do
     Move(ItemIndex, ItemAtPos(Point(X, Y), True));
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 Accept:=Source = ListBox1;
end;

end.

---

← →
Дмитрий_05   (2005-12-07 17:21) [28]

Работает ))) а можно чтобы курсор не изменялся(чтобы не рисовался квадратик снизу курсора), и чтобы перемещение строки происходило во время перемещения курсора, а не после того как отпустить клавишу... Ну, соответственно если нажать правую клавишу мышки, не отпуская левой, чтобы сбрасывалось это все, т.е. строка становилась туда, где она и была...

---

← →
Игорь Шевченко ©   (2005-12-07 17:29) [29]

Дмитрий_05   (07.12.05 17:21) [28]


> а можно


За деньги можно все. Только их много надо, денег.

---

← →
Дмитрий_05   (2005-12-07 17:30) [30]

Что за деньги то это точно...:)))

---

← →
Antonn ©   (2005-12-07 18:14) [31]

Дмитрий_05   (07.12.05 17:21) [28]
глянь тут: http://an-files.narod.ru/_works/5016.html

---

Страницы: 1 вся ветка

Текущий архив: 2006.01.08;
Скачать: CL | DM;

Наверх

Память: 0.56 MB
Время: 0.046 c