| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как в ListBox-e нарисовать изображение? [D7, WinXP]

tytus ©   (2006-04-20 12:02:00) 

Добрый день господа. Рисовать изобр. в событии OnDrawItem просто. А вот как нарисовать по всему ЛистБоксу, как в ListView у меня не получается.

---

Царев Евгений   (2006-04-21 17:46:00) [1]

Вычитал у Peter Below
сдесь не Bitmap но , то очем ты говорил >Компонент рисует строки на белом фоне, и за собой не очищает рамки
и как сказал MBO >Тольк придется OnDrawItem использовать и стиль lbOwnerDrawFixed

unit Unit1;

interface

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

type
 TListbox = class( Stdctrls.TListbox )
 private
   procedure wmEraseBkGnd( var msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
 end;
 TForm1 = class(TForm)
   ListBox1: TListBox;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
     Rect: TRect; State: TOwnerDrawState);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
 i: Integer;
begin
 for i:= listbox1.items.count to listbox1.items.count + 5 do
   listbox1.items.add( format('Item %d',[i] ));
end;

{ TListbox }
const
 colors: Array [Boolean] of TColor = ($FFFFC0, $C0FFFF);

procedure TListbox.wmEraseBkGnd(var msg: TWMEraseBkGnd);
var
 cv: TCanvas;
 h, max: Integer;
 r: TRect;
 b: Boolean;
begin
 msg.result := 1;
 h:=Perform( LB_GETITEMHEIGHT, 0, 0 );
 If h = LB_ERR Then h := ItemHeight;
 cv:= TCanvas.Create;
 try
   cv.Handle := msg.DC;
   r:= Rect( 0, 0, ClientWidth, h );
   b:= Odd(TopIndex) and (TopIndex >= 0);
   max:= ClientHeight;
   cv.Brush.Style := bsSolid;
   while r.Top < max do begin
     cv.Brush.Color := colors[b];
     b:= not b;
     cv.FillRect( r );
     OffsetRect( r, 0, h );
   end;
 finally
   cv.Handle:= 0;
   cv.free;
 end;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 cb, ct: TColor;
begin
 If not (odSelected in State) Then
   With Control As TListbox Do Begin
     canvas.Brush.Color := colors[Odd(index)];
     canvas.Brush.Style := bsSolid;
   End;
 Rect.Right := Control.ClientWidth;
 With Control As TListbox Do Begin
   canvas.FillRect( Rect );
   canvas.Brush.Style := bsClear;
   canvas.TextRect( Rect, Rect.Left+2, Rect.Top, Items[index] );
 End;
end;

end.



---

tytus   (2006-04-21 13:47:00) [2]

Доброго дня всем.
Создал компонент, наследник TListBox.
unit BmpListBox;
{$R-,T-,H+,X+}
interface

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

type
 TBmpListBox = class(TListBox)
 private
   { Private declarations }
   FBitMap:TBitMap;
   function GetBitMap:TBitMap;
   procedure SetBitMap(Value:TBitMap);
 protected
   { Protected declarations }
  procedure WndProc(var Message: TMessage);override;

 public
  {  Public declarations }
   constructor Create(AOwner:TComponent);override;
   destructor Destroy;override;
 published
   { Published declarations }
   property BitMap:TBitMap read GetBitMap write SetBitMap;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('MaPage', [TBmpListBox]);
end;

constructor TBmpListBox.Create(AOwner:TComponent);
begin
Inherited Create(AOwner);
FBitMap:=TBitMap.Create;
end;

Destructor TBmpListBox.Destroy;
begin
FBitMap.Dormant;
FBitMap.FreeImage;
FBitMap.Free;
Inherited Destroy;
end;

function TBmpListBox.GetBitMap:TBitMap;
begin
if FBitMap<>nil then Result:=FBitMap
 else
   Result:=nil;
end;

procedure TBmpListBox.SetBitMap(Value:TBitMap);
begin
if Value<>nil then
 FBitMap.Assign(Value)
else if Value<>nil then
begin
 FBitMap.Dormant;
 FBitMap.FreeImage;
 FBitMap.ReleaseHandle;
end;
//Repaint;
end;

procedure TBmpListBox.WndProc(var Message:TMessage);
begin
Inherited WndProc(Message);
if Message.Msg=WM_PAINT then
begin
 if (FBitMap<>nil)and(csDesigning in ComponentState) then
   Canvas.StretchDraw(ClientRect,FBitMap);
end else
if Message.Msg=WM_ERASEBKGND then
begin
 if FBitMap<>nil then
   Canvas.StretchDraw(ClientRect,FBitMap);
end;
end;

end.
Посмотрите пожалуйста, что здесь можно исправить.
Компонент рисует строки на белом фоне, и за собой не очищает рамки
строк.

---

MBo   (2006-04-20 12:41:00) [3]

можно перекрыть WindowProc листбокса, отлавливать WM_ERASEBKGND, и рисовать картинку. Тольк придется OnDrawItem использовать и стиль lbOwnerDrawFixed для отрисовки строк, поскольку придется делать SetBkMode(ListBox1.Canvas.Handle, TRANSPARENT);

---

tytus   (2006-04-20 12:25:00) [4]

>All
Не помогает...

---

balepa   (2006-04-20 12:17:00) [5]

> tytus   (20.04.06 12:12) [2]

Надо сразу уточнять

---

Мефисто   (2006-04-20 12:14:00) [6]

OnShow

в OnCreate нет гарантии, что листбокс будет вовремя создан.

---

tytus   (2006-04-20 12:12:00) [7]

>balera
Мне нужно чтобы при активации формы УЖЕ был рисунок. Попробуй сие написать в OnCreate & OnActivate формы - что будет видно????

---

balepa   (2006-04-20 12:05:00) [8]

ListBox1.Canvas.Ellipse(1,1,10,10);

---

Наверх