Компонент, одновременно выводящий текст и изображение

var
  bmp:TBitmap;
 
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var cc:TCanvas;
begin
  cc:=(Control as TListBox).Canvas cc.FillRect(rect);
  cc.Draw(Rect.Left+100,Rect.Top, bmp);
  cc.TextOut(Rect.Left, Rect.Top, 'разум');
end;
 
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
  if index=1 then Height:= 24 
   else Height:= 16
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp:=TBitmap.Create;
  bmp.LoadFromFile('test.bmp')
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Destroy
end;

var   First:Boolean=true;
  BmpText:TBitmap;
 
procedure Tlgs.CreateText;
var i,W,tmp:integer;
 DW:array of Integer;
 bck:TBitmap;
 r:trect;
begin
 
 bck:=TBitmap.Create;
 bck.LoadFromResourceName(HInstance,'BACKGROUND');
 //bck.SaveToFile('2.bmp');
 
 MemoCopyright.Text:= MemoCopyright.Text + GetSysInfo;
 
 BmpText:=TBitmap.Create;
 BmpText.PixelFormat:=pf24bit;
 BmpText.Canvas.Brush.Color:=Im.Picture.Bitmap.Canvas.Pixels[3,Im.Picture.Bitmap.Height-4];
 
 BmpText.Canvas.Font.Assign(MemoCopyright.Font);
 BmpText.Height:=BmpText.Canvas.TextHeight('F')*MemoCopyright.Lines.Count;
 
 W:=0;SetLength(DW,MemoCopyright.Lines.Count);
 for i:=0  to MemoCopyright.Lines.Count-1 do
 begin
  DW[i]:=BmpText.Canvas.TextWidth(MemoCopyright.Lines.Strings[i]);
  if DW[i]>W then W:=DW[i];
 end;
 
 
 if W<bck.Width then w:=bck.Width;
 BmpText.Width:=W;
 BmpText.Height:=BmpText.Height+bck.Height+10;
 
 r.Left:=0;r.Top:=0;r.Right:=BmpText.Width;r.Bottom:=BmpText.Height;
 BmpText.Canvas.Brush.Color:=Im.Picture.Bitmap.Canvas.Pixels[3,Im.Picture.Bitmap.Height-4];
 //BmpText.Canvas.Brush.Bitmap:=bck;
 BmpText.Canvas.FillRect(r);
 BmpText.Canvas.Draw(BmpText.Width div 2- bck.Width div 2,
                     BmpText.Height-bck.Height,bck);
 
 BmpText.Canvas.Brush.Style:=bsClear;
 
 for i:=0  to MemoCopyright.Lines.Count-1 do
  BmpText.Canvas.TextOut((W div 2)-(DW[i] div 2),i*BmpText.Canvas.TextHeight('F'),
   MemoCopyright.Lines.Strings[i]);
 
 bck.free;
 LinePos:=0
end;
 
 
procedure Tlgs.FormCreate(Sender: TObject);
var HRG,HRGSh: HRGN;
begin
 Im.Picture.Bitmap:=TBitmap.Create;
 Im.Picture.Bitmap.LoadFromResourceName(HInstance,'IDE');
 Im.Picture.Bitmap.PixelFormat:=pf24bit;
 Im.Picture.Bitmap.Assign(Im.Picture.Bitmap);
 
 CreateText;
 //Im.Picture.Bitmap.SaveToFile('1.bmp');
 
 HRG:=CreateRectRgn(0,0,Im.Picture.Bitmap.Width,Im.Picture.Bitmap.Height);
 HRGSh:=CreateRectRgn(1,1,Im.Picture.Bitmap.Width+1,Im.Picture.Bitmap.Height+1);
 
 Width:=Im.Picture.Bitmap.Width;
 Height:=Im.Picture.Bitmap.Height;
 Im.Width:=Im.Picture.Bitmap.Width;
 Im.Height:=Im.Picture.Bitmap.Height;
 Im.Left:=0;Im.Top:=0;
 
 CombineRgn(HRG,HRG,HRGSh,RGN_OR);
 Show;
 Application.ProcessMessages;
 
 LinePos:=160;
 
 Application.ShowMainForm:= true;
 close
end;
 
const
 TopScroll=190;
 HeightScroll=70;
 
procedure Tlgs.PaintScrollText;
var
  i,j,n,DLeft: Integer;
  PTxt,PBmp,PBase: PByteArray;
  Bmp: TBitmap;
  R: TRect;
  ArrB: array of byte;
  a1,a2:single;
begin
  fCancel:= False;
  nLines:=4;
 
  Bmp :=Im.Picture.Bitmap;
  SetLength(ArrB,3);
  i:=Im.Picture.Bitmap.Canvas.Pixels[3,Bmp.Height-4];
  ArrB[2]:=GetRValue(i);ArrB[1]:=GetRValue(i);ArrB[0]:=GetBValue(i);
  DLeft:=Bmp.Width div 2-BmpText.Width div 2;
 
  for j:=0  to HeightScroll-1 do begin
    PTxt:=BmpText.ScanLine[(LinePos+j) mod BmpText.Height];
    PBmp:=Bmp.ScanLine[j+TopScroll];
    for i:=0  to BmpText.Width-1 do begin
     a2:=1;
 
     if j=0 then a2:=0.1;  if j=HeightScroll-9 then a2:=0.9;
     if j=1 then a2:=0.2;  if j=HeightScroll-8 then a2:=0.8;
     if j=2 then a2:=0.3;  if j=HeightScroll-7 then a2:=0.7;
     if j=3 then a2:=0.4;  if j=HeightScroll-6 then a2:=0.6;
     if j=4 then a2:=0.5;  if j=HeightScroll-5 then a2:=0.5;
     if j=5 then a2:=0.6;  if j=HeightScroll-4 then a2:=0.4;
     if j=6 then a2:=0.7;  if j=HeightScroll-3 then a2:=0.3;
     if j=7 then a2:=0.8;  if j=HeightScroll-2 then a2:=0.2;
     if j=8 then a2:=0.9;  if j=HeightScroll-1 then a2:=0.1;
 
     a1:=1-a2;
     PBmp[(i+DLeft)*3+0]:=trunc(ArrB[0]*a1+PTxt[i*3+0]*a2);
     PBmp[(i+DLeft)*3+1]:=trunc(ArrB[1]*a1+PTxt[i*3+1]*a2);
     PBmp[(i+DLeft)*3+2]:=trunc(ArrB[2]*a1+PTxt[i*3+2]*a2);
    end;
  end;
  inc(LinePos);
  InvalidateRect(handle,nil,false)
end;
 
 
procedure Tlgs.Timer1Timer(Sender: TObject);
begin
 PaintScrollText
end;
 
procedure Tlgs.ImMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Timer1.Enabled:= not Timer1.Enabled;
 
 if Button=mbRight then begin
  Timer1.Enabled:=false;
  Close
 end
end;
 
procedure Tlgs.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var NewLine: Integer;
begin
 NewLine:=LinePos-Sign(WheelDelta)*5;
 if NewLine<LinePos then NewLine:=NewLine-1;
 if NewLine>0 then  LinePos:=NewLine;
 
 PaintScrollText
end;
 
procedure Tlgs.FormShow(Sender: TObject);
begin
 LinePos:=0;
 PaintScrollText
end;

var
  Form1: TForm1;
  First:Boolean=true;
  BmpText:TBitmap;
 
implementation
 
{$R *.dfm}
 
uses xmldom;  //   подключил обращение к юниту.

var LinePos: integer;