ListBox med billeder

Hvordan får jeg små billeder i min listbox ud ved siden af teksten (en item)?

Billederne kunne evt. være et ikon elelr bitmap, som der ligger et eller andet sted på harddisken.

Du kan gøre det ved at fange OnDrawItem eventen i din ListBox, og så derefter tegne på canvaset, i den rect som du får tildelt.

MH.

The-Freak

Livet er for kort til at kede sig.

Ja det er rigtigt. men jeg kunen godt bruge et stykke kode tak.

Ok... Her er lidt eksemepl:

For at tilføje rigtigt til ListBox'en gør du flg.:

ListBox1.Items.AddObject('Det der skal stå', MinBitmap);

Og MinBitmap skal selvfølgelig erstattes af din Bitmap...

Så laver du en OnDrawItem, til din ListBox, som i dette eksempel hedder ListBox1, så det vil se sådan her ud:

procedure TBrowser.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
  MyRect: TRect;
begin
  with (Control as TListBox).Canvas do begin
    FillRect(Rect);
    Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
    if Bitmap <> nil then begin
      MyRect := Rect;
      MyRect.Right := 34;
      MyRect.Left := 2;
      MyRect.Top := MyRect.Top+2;
      MyRect.Bottom := MyRect.Top+34;
      StretchDraw(MyRect, Bitmap);
      Offset := Bitmap.width + 8;
      TextOut(MyRect.Right + 5, MyRect.Top + 8, Listbox1.Items[Index]);
    end;
  end;
end;

Dette vil tegne et skaleret billede på 32*32 ude i siden af din Item. Der vil også være noget tekst. Men din Item vil nu være for lille. Derfor skal flg. event også tilføjes til ListBox1. OnMeasureItem. Det vil se sådan her ud:

procedure TBrowser.ListBox1MeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  Height := 38;
end;

Vupti... Så er det klaret, og din Bitmap er nu blevet tegnet ud i siden, mens der ved siden af den er blevet skrevet noget tekst.

MH.

The-Freak

Livet er for kort til at kede sig.

[Redigeret d. 06/06-04 14:59:13 af The-Freak]

Her er fejlen: www.tmcg.dk/fejl.jpg

Hej,

Dit problem er bla. at du ikke generere et nyt bitmap for hver entry i din listbox.
Jeg har skrevet din EnumWindowsProc lidt om, så den kan finde icon og tekst (til vinduet) på samme tid.
Jeg har ikke testet mine rettelser da de er skrevet direkte ind her på udvikleren, men det burde give dig et praj om hvordan det kan gøres.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox2: TListBox;
    Button1: TButton;
    Timer1: TTimer;
    Image1: TImage;
    ImageList1: TImageList;
    Button2: TButton;

    procedure Button1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox2MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

function EnumWindowsProc(Wnd: HWND; lst: TListbox): BOOL; stdcall;
var
  capttxt: Array [0..128] of Char;
  ico : TIcon;
  bmp : TBitmap;
begin
  Result := True;
  if  IsWindowVisible(Wnd)  and { skip invisible windows }
     ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0)  or { only top-level windows}
     (HWND(GetWindowLong(Wnd, GWL_HWNDPARENT)) = GetDesktopWindow)) and
      ((GetWindowLong(Wnd, GWL_EXSTYLE) ann
      WS_EX_TOOLWINDOW) = 0)  {skip Tool windows }  
      then
  begin
// Hent vinduets tekst
    SendMessage( Wnd, WM_GETTEXT, Sizeof(capttxt), integer(@capttxt));
// hent icon fra vinduet.
    ico := TIcon.Create;
    CopyIconFromWindowHandle(Wnd, ico);
// opret nyt bitmap med ikonens indhold
    bmp := TBitmap.Create;
    bmp.Width := ico.Width;
    bmp.Height := ico.Height;
    if ico.Handle <> 0 then
      bmp.Canvas.Draw(0, 0, ico);
// Gem tekst og bitmap i listbox'en
    lst.Items.AddObject(capttxt, bmp);
    ico.Free;
  end;
end;


function CopyIconFromWindowHandle(AHandle: THandle; AIcon: TIcon): boolean;
var
  hWindowIcon: THandle;  {HICON}
  tmpIcon: TIcon;  {temporary TIcon}
begin
  Result := false;
  if (AHandle > 0) or (AIcon <> nil) then
  begin
    hWindowIcon := GetClassLong(AHandle, GCL_HICON);
    if hWindowIcon > 0 then
    begin
      tmpIcon := TIcon.Create;
      try
        tmpIcon.Handle := CopyIcon(hWindowIcon);
        if tmpIcon.Handle > 0 then
        begin
          AIcon.Assign(tmpIcon);
          tmpIcon.Free;
          Result := true;
          exit;
        end;
      except
        tmpIcon.Free;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox2.clear;
  EnumWindows(@EnumWindowsProc, integer(ListBox2));
end;


procedure TForm1.ListBox2Click(Sender: TObject);
var
  Handle : HWND;
  wHandle: THandle;
  TestIcon: TIcon;
begin
  Handle := FindWindow(nil,PChar(Listbox2.Items[ListBox2.ItemIndex]));
 // SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 3);
 // SetForegroundWindow(Handle);


    wHandle := Handle;
  if not (wHandle > 0) then
    exit;

  TestIcon := TIcon.Create;
  try
 //   TestIcon.Handle := CopyIcon(Application.Icon.Handle);
    Canvas.Draw(0, 0, TestIcon);
    if CopyIconFromWindowHandle(wHandle, TestIcon) = true then
      Canvas.Draw(0, 80, TestIcon);
  finally
    TestIcon.Free;
  end;
end;




procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
  MyRect: TRect;
begin
  with (Control as TListBox).Canvas do begin
    FillRect(Rect);
    Bitmap := TBitmap(ListBox2.Items.Objects[Index]);
    if Bitmap <> nil then begin
      MyRect := Rect;
      MyRect.Right := 34;
      MyRect.Left := 2;
      MyRect.Top := MyRect.Top+2;
      MyRect.Bottom := MyRect.Top+34;
      StretchDraw(MyRect, Bitmap);
    Offset := Bitmap.width + 8;
      TextOut(MyRect.Right + 5, MyRect.Top + 8, Listbox2.Items[Index]);
    end;
  end;
end;

procedure TForm1.ListBox2MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
Height := 38;
end;

end.

/Michael.

Hvordan får jeg små billeder i min listbox ud ved siden af teksten (en item)?

Billederne kunne evt. være et ikon elelr bitmap, som der ligger et eller andet sted på harddisken.

Du kan gøre det ved at fange OnDrawItem eventen i din ListBox, og så derefter tegne på canvaset, i den rect som du får tildelt.

MH.

The-Freak

Livet er for kort til at kede sig.

Hvordan får jeg små billeder i min listbox ud ved siden af teksten (en item)?

Billederne kunne evt. være et ikon elelr bitmap, som der ligger et eller andet sted på harddisken.

Du kan gøre det ved at fange OnDrawItem eventen i din ListBox, og så derefter tegne på canvaset, i den rect som du får tildelt.

MH.

The-Freak

Livet er for kort til at kede sig.

Ja det er rigtigt. men jeg kunen godt bruge et stykke kode tak.

ups dobble post

[Redigeret d. 06/06-04 14:26:48 af Kasper Færch Mikkelsen]

der kommer bare en fejl så..... det virker ikke.

Måske kan dette hjælpe.. her er min units kode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox2: TListBox;
    Button1: TButton;
    Timer1: TTimer;
    Image1: TImage;
    ImageList1: TImageList;
    Button2: TButton;

    procedure Button1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox2MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

function EnumWindowsProc(Wnd: HWND; lst: TStringList): BOOL; stdcall;
var
  capttxt: Array [0..128] of Char;
begin
  Result := True;
  if  IsWindowVisible(Wnd)  { skip invisible windows }  and
      ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0)  { only top-level windows}
      or (HWND(GetWindowLong(Wnd, GWL_HWNDPARENT)) = GetDesktopWindow))
      and ((GetWindowLong(Wnd, GWL_EXSTYLE) and
      WS_EX_TOOLWINDOW) = 0)  {skip Tool windows }  then
  begin
    SendMessage( Wnd, WM_GETTEXT, Sizeof(capttxt), integer(@capttxt));
    Form1.ListBox2.Items.AddObject(capttxt, Form1.Image1);
  end;
end;


function CopyIconFromWindowHandle(AHandle: THandle; AIcon: TIcon): boolean;
var
  hWindowIcon: THandle;  {HICON}
  tmpIcon: TIcon;  {temporary TIcon}
begin
  Result := true;
  if (not (AHandle > 0)) or (AIcon = nil) then
  begin
    Result := false;
    exit;
  end;
  hWindowIcon := GetClassLong(AHandle, GCL_HICON);
  if hWindowIcon = 0 then
  begin
    Result := false;
    exit;
  end;
  tmpIcon := TIcon.Create;
  try
    {exactly the same icon is copied}
    tmpIcon.Handle := CopyIcon(hWindowIcon);
    if tmpIcon.Handle = 0 then
    begin
      Result := false;
      exit;
    end;
    {AIcon is changing}
    try
      AIcon.Assign(tmpIcon);
    except
      Result := false;
      raise;
    end
  finally
    tmpIcon.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox2.clear;
  EnumWindows(@EnumWindowsProc, integer(ListBox2));
end;


procedure TForm1.ListBox2Click(Sender: TObject);
var
  Handle : HWND;
  wHandle: THandle;
  TestIcon: TIcon;
begin
  Handle := FindWindow(nil,PChar(Listbox2.Items[ListBox2.ItemIndex]));
 // SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 3);
 // SetForegroundWindow(Handle);


    wHandle := Handle;
  if not (wHandle > 0) then
    exit;

  TestIcon := TIcon.Create;
  try
 //   TestIcon.Handle := CopyIcon(Application.Icon.Handle);
    Canvas.Draw(0, 0, TestIcon);
    if CopyIconFromWindowHandle(wHandle, TestIcon) = true then
      Canvas.Draw(0, 80, TestIcon);
  finally
    TestIcon.Free;
  end;
end;




procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
  MyRect: TRect;
begin
  with (Control as TListBox).Canvas do begin
    FillRect(Rect);
    Bitmap := TBitmap(ListBox2.Items.Objects[Index]);
    if Bitmap <> nil then begin
      MyRect := Rect;
      MyRect.Right := 34;
      MyRect.Left := 2;
      MyRect.Top := MyRect.Top+2;
      MyRect.Bottom := MyRect.Top+34;
      StretchDraw(MyRect, Bitmap);
    Offset := Bitmap.width + 8;
      TextOut(MyRect.Right + 5, MyRect.Top + 8, Listbox2.Items[Index]);
    end;
  end;
end;

procedure TForm1.ListBox2MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
Height := 38;
end;

end.

Ja, jeg kan ikke hjælpe ret meget når jeg ikke ved hvad fejlen er

MH.

The-Freak

Livet er for kort til at kede sig.

Her er fejlen: www.tmcg.dk/fejl.jpg

Ret lige funktionen EnumWindowsProc til dette:

function EnumWindowsProc(Wnd: HWND; lst: TListbox): BOOL; stdcall;
var
  capttxt: Array [0..128] of Char;
  ico : TIcon;
  bmp : TBitmap;
begin
  Result := True;
  if  IsWindowVisible(Wnd)  and { skip invisible windows }
     ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0)  or { only top-level windows}
     (HWND(GetWindowLong(Wnd, GWL_HWNDPARENT)) = GetDesktopWindow)) and
      ((GetWindowLong(Wnd, GWL_EXSTYLE) and
      WS_EX_TOOLWINDOW) = 0)  {skip Tool windows }  
      then
  begin
// Hent vinduets tekst
    SendMessage( Wnd, WM_GETTEXT, Sizeof(capttxt), integer(@capttxt));
// hent icon fra vinduet.
    ico := TIcon.Create;
    CopyIconFromWindowHandle(Wnd, ico);
// opret nyt bitmap med ikonens indhold
    bmp := TBitmap.Create;
    bmp.Width := ico.Width;
    bmp.Height := ico.Height;
    if ico.Handle <> 0 then
      bmp.Canvas.Draw(0, 0, ico);
// Gem tekst og bitmap i listbox'en
    lst.Items.AddObject(capttxt, bmp);
    ico.Free;
  end;
end;

/Michael.

nu kommer der ingen fejl, men den viser heller ikke noget ikon
Kan eller anden ikke lige teste det for at se om det er mig der gør det forkert så?