Форум: "Основная";
Текущий архив: 2006.05.28;
Скачать: [xml.tar.bz2];
ВнизКак в ListBox-e нарисовать изображение? Найти похожие ветки
← →
tytus (2006-04-20 12:02) [0]Добрый день господа. Рисовать изобр. в событии OnDrawItem просто. А вот как нарисовать по всему ЛистБоксу, как в ListView у меня не получается.
← →
balepa © (2006-04-20 12:05) [1]ListBox1.Canvas.Ellipse(1,1,10,10);
← →
tytus (2006-04-20 12:12) [2]>balera
Мне нужно чтобы при активации формы УЖЕ был рисунок. Попробуй сие написать в OnCreate & OnActivate формы - что будет видно????
← →
Мефисто (2006-04-20 12:14) [3]OnShow
в OnCreate нет гарантии, что листбокс будет вовремя создан.
← →
balepa © (2006-04-20 12:17) [4]
> tytus (20.04.06 12:12) [2]
Надо сразу уточнять
← →
tytus (2006-04-20 12:25) [5]>All
Не помогает...
← →
MBo © (2006-04-20 12:41) [6]можно перекрыть WindowProc листбокса, отлавливать WM_ERASEBKGND, и рисовать картинку. Тольк придется OnDrawItem использовать и стиль lbOwnerDrawFixed для отрисовки строк, поскольку придется делать SetBkMode(ListBox1.Canvas.Handle, TRANSPARENT);
← →
tytus (2006-04-21 13:47) [7]Доброго дня всем.
Создал компонент, наследник 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.
Посмотрите пожалуйста, что здесь можно исправить.
Компонент рисует строки на белом фоне, и за собой не очищает рамки
строк.
← →
Царев Евгений (2006-04-21 17:46) [8]Вычитал у 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.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2006.05.28;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.011 c