急!!!高分!大放血!用listview装入host下的目录及文件却无法显示图标?(200分)

  • 主题发起人 主题发起人 harmer
  • 开始时间 开始时间
unit unit1;

interface

uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
stdctrls;

type
tform1 = class(tform)
list1: tcombobox;
button1: tbutton;
procedure button1click(sender: tobject);
procedure formcreate(sender: tobject);
procedure list1drawitem(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
s: string;
begin
randomize;
s:= inttostr(random(100));//last here!
createdir(s);
end;
procedure tform1.formcreate(sender: tobject);
var
bit1,bit2,bit3,bit4,bit5,bit6: tbitmap;
begin
list1.style := csownerdrawvariable;
list1.itemheight := 30;
bit1 := tbitmap.create;
bit1.loadfromfile('c:/program files/oicq/face/1-1.bmp');
bit2 := tbitmap.create;
bit2.loadfromfile('c:/program files/oicq/face/2-1.bmp');
bit3 := tbitmap.create;
bit3.loadfromfile('c:/program files/oicq/face/3-1.bmp');
bit4 := tbitmap.create;
bit4.loadfromfile('c:/program files/oicq/face/4-1.bmp');
bit5 := tbitmap.create;
bit5.loadfromfile('c:/program files/oicq/face/5-1.bmp');
bit6 := tbitmap.create;
bit6.loadfromfile('c:/program files/oicq/face/6-1.bmp');
list1.items.addobject('图标1',bit1);
list1.items.addobject('图标2',bit2);
list1.items.addobject('图标3', bit3);
list1.items.addobject('图标4', bit4);
list1.items.addobject('图标5', bit5);
list1.items.addobject('图标6', bit6);
list1.itemindex :=0;
end;

procedure tform1.list1drawitem(control: twincontrol; index: integer;
rect: trect; state: townerdrawstate);
var
bitmap: tbitmap;
offset: integer;
begin
with(control as tcombobox).canvas do
begin
fillrect(rect);
bitmap := tbitmap(list1.items.objects[index]);
//bitmap := tbitmap.create;
//imagelist1.getbitmap(index,bitmap);
if bitmap<> nil then
begin
brushcopy(bounds(rect.left+2,rect.top+2,bitmap.width,bitmap.height),bitmap,
bounds(0,0,bitmap.width,bitmap.height),clred);
offset := bitmap.width + 8;
textout(rect.left+offset,rect.top,list1.items[index]);
end;

end;


end;

end.
 
我的意思是:如何读取windows文件夹/文件图标.(在listview,不是在listbox!)
 
在DEMOS文件夹中有一个Virtual Listview的例子,看看对你有没有帮助吧
 
harmer:如果你还要继续讨论请定期提前你的帖子,如果不想继续讨论请结束帖子。
 
var IconIndex:word;
h:HIcon;
begin
IconIndex:=0;
h:=ExtractAssociatedIcon(hInstance,'c:/windows/notepad.exe',IconIndex);
DrawIcon(Form1.Canvas.Handle,10,10,0);
end;
========================================================================
或参考下面的单元
========================================================================
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
Test='C:/';
var
Form1: TForm1;
ShFileInfo:TShFileInfo;

implementation

{$R *.DFM}
function GetFileIconIndex(FileName:string):integer;
var Ext:string;
begin
Ext:=FileName;
result:=ShGetFileInfo(pchar(Ext),0,ShFileInfo,SizeOf(ShFileInfo),
ShGfi_LargeIcon or ShGfi_SysIconIndex or ShGfi_TypeName);
REsult:=ShFileInfo.iIcon;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with ListView1 do
begin
SmallImages:=TImageList.CreateSize(32,32);
SmallImages.ShareImages:=true;
SmallImages.Handle:=ShGetFileInfo('*.*',0,ShFileInfo,SizeOf(ShFileInfo),ShGfi_LargeIcon or ShGfi_Icon or ShGfi_SysIconIndex);
LargeImages:=TImageList.CreateSize(32,32);
largeImages.ShareImages:=true;
LargeImages.handle:=ShGetFileInfo('*.*',0,ShfileInfo,SizeOf(ShFileInfo),ShGfi_LargeIcon or ShGfi_Icon or ShGfi_sysIconIndex);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ListView1.SmallImages.Free;
ListView1.LargeImages.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListView1.Items.Item[0].ImageIndex:=GetFileIconIndex(Test);
end;

end.
 
接受答案了.
 
Buder 兄:
你的代码编译无法通过啊。
 
后退
顶部