Скачать: CL | DM;

ListBox и фоновый рисунок   Найти похожие ветки 

← →
tytus   (2006-04-27 15:12) [0]

Добрый день всем. Вот код моего ЛистБокса, пожалуйста подскажите, как его заставить писать строчки. Картинку он загружает, но перестал рисовать итемы.

---

← →
tytus   (2006-04-27 15:12) [1]

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;
end;

procedure TBmpListBox.WndProc(var Message:TMessage);
begin
Inherited WndProc(Message);
case Message.Msg of
 WM_PAINT:begin
       if FBitMap<>nil then Canvas.StretchDraw(ClientRect,FBitMap);
     end;
 WM_ERASEBKGND:begin
       if FBitMap<>nil then  Canvas.StretchDraw(ClientRect,FBitMap);
     end;
end;
end;

end.

---

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

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.027 c