// unit GraphicsExpand;interface uses Forms , Registry , Graphics , ShellAPI , Controls , SysUtils , Windows , Dialogs;Function GetExeByOpenFile(FileName:String):String; //得到打开这个文件的EXE文件 Function GetExeIcoByOpenFile(FileName:String):integer; //得到这个文件对应的EXE里的图标号 Function AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer; //把这个文件的图标增加到ImageList中去。 implementationFunction AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer; var Count , IcoIndex : integer; Ico : Ticon; ExFile : String; begin Result := -1; ExFile := GetExeByOpenFile(FileName); IcoIndex := GetExeIcoByOpenFile(FileName); Count := ExtractIcon( Application.Handle, PChar(ExFile),$FFFFFFFF); Ico := Ticon.Create; if( IcoIndex < Count ) then begin Ico.Handle := ExtractIcon( Application.Handle, PChar(ExFile), IcoIndex ); ImageList.AddIcon(Ico); Result := ImageList.Count -1; end; Ico.Free; end;Function GetStrByOpenFile(FileName:String):String; var Reg : Tregistry; FEName , RegNe: String; begin Result := '%SystemRoot%\System32\shell32.dll,0'; FeName := ansiuppercase(Trim(extractfileext(FileName))); if FEName='.EXE' then Result := Trim(FileName) else if copy(Trim(FileName),Length(Trim(FileName)),1)='\' then Result := '%SystemRoot%\System32\shell32.dll,3' else if FEName='' then Result := '%SystemRoot%\System32\shell32.dll,0' else begin if copy(FEName,1,1)<>'.' then FEName := '.'+FEName; Reg := TRegistry.Create; Reg.RootKey := HKEY_CLASSES_ROOT; if Reg.OpenKey(FEName,True) then begin RegNE := Reg.ReadString('')+'\\DefaultIcon'; Reg.CloseKey; if RegNe <> '\\DefaultIcon' then begin Reg.OpenKey(RegNE,True); Result := Reg.ReadString(''); Reg.CloseKey; end; end; Reg.Free; end; end;Function GetExeIcoByOpenFile(FileName:String):integer; var Tmp , cStr : String; begin Result := 0; Tmp := ''; cStr := GetStrByOpenFile(FileName); if cStr<>'' then while True do begin if pos(copy(cStr,Length(cStr),1),'-0123456789')>0 then begin Tmp := copy(cStr,Length(cStr),1) + Tmp; cStr := copy(cStr,1,Length(cStr)-1) end else begin if Tmp<>'' then Result := strtoint(Tmp); Break; end; end; end;Function GetExeByOpenFile(FileName:String):String; var cStr : String; begin cStr := GetStrByOpenFile(FileName); Result := cStr; if (cStr<>'') and (Pos(',',cStr)>0) then while True do begin if copy(cStr,Length(cStr),1)<>',' then cStr := copy(cStr,1,Length(cStr)-1) else begin Result := copy(cStr,1,Length(cStr)-1); Break; end; end; end;end.//使用方法: AddFileIcoToImgLst('DD.DOC',ImageList); 就把Word的图标加到ImageList中了,就可以直接从ImageList中得到图标了三。 :)
Function GetStrByOpenFile(FileName:String):String; var Reg : Tregistry; FEName , RegNe: String; begin Result := '%SystemRoot%\System32\shell32.dll,0'; 看到这一句没有,没有关联的当然是取这个图标了。
unit GraphicsExpand;interface
uses
Forms , Registry , Graphics , ShellAPI , Controls , SysUtils , Windows , Dialogs;Function GetExeByOpenFile(FileName:String):String; //得到打开这个文件的EXE文件
Function GetExeIcoByOpenFile(FileName:String):integer; //得到这个文件对应的EXE里的图标号
Function AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer;
//把这个文件的图标增加到ImageList中去。
implementationFunction AddFileIcoToImgLst(FileName : String ; ImageList : TImageList) : integer;
var
Count , IcoIndex : integer;
Ico : Ticon;
ExFile : String;
begin
Result := -1;
ExFile := GetExeByOpenFile(FileName);
IcoIndex := GetExeIcoByOpenFile(FileName);
Count := ExtractIcon( Application.Handle, PChar(ExFile),$FFFFFFFF);
Ico := Ticon.Create;
if( IcoIndex < Count ) then begin
Ico.Handle := ExtractIcon( Application.Handle, PChar(ExFile), IcoIndex );
ImageList.AddIcon(Ico);
Result := ImageList.Count -1;
end;
Ico.Free;
end;Function GetStrByOpenFile(FileName:String):String;
var
Reg : Tregistry;
FEName , RegNe: String;
begin
Result := '%SystemRoot%\System32\shell32.dll,0';
FeName := ansiuppercase(Trim(extractfileext(FileName)));
if FEName='.EXE' then Result := Trim(FileName)
else if copy(Trim(FileName),Length(Trim(FileName)),1)='\' then Result := '%SystemRoot%\System32\shell32.dll,3'
else if FEName='' then Result := '%SystemRoot%\System32\shell32.dll,0'
else begin
if copy(FEName,1,1)<>'.' then FEName := '.'+FEName;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey(FEName,True) then begin
RegNE := Reg.ReadString('')+'\\DefaultIcon';
Reg.CloseKey;
if RegNe <> '\\DefaultIcon' then begin
Reg.OpenKey(RegNE,True);
Result := Reg.ReadString('');
Reg.CloseKey;
end;
end;
Reg.Free;
end;
end;Function GetExeIcoByOpenFile(FileName:String):integer;
var
Tmp , cStr : String;
begin
Result := 0;
Tmp := '';
cStr := GetStrByOpenFile(FileName);
if cStr<>'' then
while True do begin
if pos(copy(cStr,Length(cStr),1),'-0123456789')>0 then
begin
Tmp := copy(cStr,Length(cStr),1) + Tmp;
cStr := copy(cStr,1,Length(cStr)-1)
end
else begin
if Tmp<>'' then Result := strtoint(Tmp);
Break;
end;
end;
end;Function GetExeByOpenFile(FileName:String):String;
var
cStr : String;
begin
cStr := GetStrByOpenFile(FileName);
Result := cStr;
if (cStr<>'') and (Pos(',',cStr)>0) then
while True do begin
if copy(cStr,Length(cStr),1)<>',' then
cStr := copy(cStr,1,Length(cStr)-1)
else begin
Result := copy(cStr,1,Length(cStr)-1);
Break;
end;
end;
end;end.//使用方法:
AddFileIcoToImgLst('DD.DOC',ImageList);
就把Word的图标加到ImageList中了,就可以直接从ImageList中得到图标了三。
:)
var
Reg : Tregistry;
FEName , RegNe: String;
begin
Result := '%SystemRoot%\System32\shell32.dll,0';
看到这一句没有,没有关联的当然是取这个图标了。
这段代码还有个小问题,如果在注册表中关联的程序加上""就取不到图标了,比如c:\aa.exe在注册表中写成"c:\aa.exe",这样被关联的文件还是可以用aa.exe打开,但图标却是那种没有被关联的文件的图标,而且用你的代码得不到任何图标,当然解决也很简单,就是判断一下
(Count := ExtractIcon( Application.Handle, PChar(ExFile),$FFFFFFFF);)中的count是否为0,为零就把ExFile赋值为'%SystemRoot%\System32\shell32.dll,0'就可以了。:)
你也太黑了吧,问题都没帮我解决居然要我结贴?:)
好吧,算了,问到这份上我也该收手了,给分。