この発言に対し以下のコメントが寄せられています

#00123　凹凹凹          さん　RE:ListBoxにBitMapを貼る(OwnerDraw)






//ListBoxに画像を貼ります。
//データを書き込む　画を作る
procedure TForm1.Button1Click(Sender: TObject);
var
   i:integer;
   theBitMap:TBitmap;
begin
   ListBox1.Style:=lbOwnerDrawFixed;
   for i:=0 to 100 do
   begin
      theBitMap:=TBitmap.create;
      theBitmap.height:=12;
      theBitmap.width:=12;
      theBitMap.Canvas.brush.Color:=
        (random(255) shl 16)+(random(255) shl 8)+random(255);
      theBitmap.canvas.fillrect(theBitmap.Canvas.ClipRect);
      theBitMap.canvas.font.size:=6;
      theBitMap.Canvas.Font.Color:=ClWhite;
      theBitMap.canvas.textOut(1,1,Char(Random(25)+Ord('A')));
      ListBox1.items.addObject(IntToStr(i),theBitMap);
   end;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
   theBitMap:TBitMap;
   DestRect,
   SourceRect:TRect;
begin
   theBitMap:=TBitmap(ListBox1.Items.Objects[Index]);
   with SourceRect do
   begin
      Top:=0;Left:=0;Right:=theBitmap.Width;Bottom:=theBitmap.Height;
   end;
   with DestRect do
   begin
      Top:=Rect.Top;Left:=0;Right:=theBitmap.Width;
      Bottom:=Top+theBitmap.Height;
   end;
   ListBox1.Canvas.CopyRect(DestRect,theBitMap.Canvas,SourceRect);
   ListBox1.Canvas.TextOut(
        DestRect.Right+2,Rect.Top+2,ListBox1.items[Index]
                            );
end;

//フォームを閉じるときにBitMapを解放
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
   i:integer;
begin
   For i:=0 to ListBox1.items.Count-1 do
   begin
      if ListBox1.Items.Objects[i]<>nil then
      begin
         TBitmap(ListBox1.items.Objects[i]).free;
      end;
   end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
   ListBox1.Refresh;//これしないと汚くなる
end;

☆☆☆　　かわいいコードにゃ旅をさせよう　いざサンプル蔵へ!!　☆☆☆
                                 97/10/25(土) 17:49 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。