怎么在dbgrid中显示图片
如何在dbgrid中显示图片?
我的表纪录里有个字段,内容是某个图标的地址,如何将这个图标显示在dbgrid中?
------解决方案--------------------
function LoadPictureFromFile(const FileName: string): TBitmap;
var
Extension: string;
// GIFimage:TGIFimage;
Icon: TIcon;
jpeg: Tjpegimage;
Metafile: TMetafile;
begin
result := nil; // In case anything goes wrong
if FileExists(FileName) then
begin
Extension := UpperCase(Copy(FileName, Length(FileName) - 2, 3));
// Quick and dirty check that file type is OK
if ((Extension = 'BMP ') or (Extension = 'JPG ') or (Extension = 'ICO ')
or (Extension = 'WMF ') or (Extension = 'EMF ')) then
result := TBitmap.create;
// BMP File -- no additional work to get TBitmap
if (Extension = 'BMP ') then
result.LoadFromFile(FileName);
// ICO File
if (Extension = 'ICO ') then
begin
try
try
Icon := TIcon.create;
Icon.LoadFromFile(FileName);
result.Width := Icon.Width;
result.Height := Icon.Height;
result.PixelFormat := pf24bit; // avoid palette problems
result.Canvas.Draw(0, 0, Icon);
except
on e: exception do
begin
MessageBox(0, Pchar( '装载图象文件 ' + FileName +
'出错: '
+
e.Message),
'程序跳出 ', MB_OK);
end;
end;
finally
Icon.Free;
end;
end;
end;
// JPG File
if (Extension = 'JPG ') or (Extension = 'JPEG ') then
begin
try
jpeg := Tjpegimage.create;
jpeg.LoadFromFile(FileName);
result.PixelFormat := pf24bit;
result.Assign(jpeg);
finally
jpeg.Free;
end;
end;
if (Extension = 'WMF ') or (Extension = 'EMF ') then
begin
Metafile := TMetafile.create;
try
Metafile.LoadFromFile(FileName);
result.Height := Metafile.Height;
result.Width := Metafile.Width;
result.PixelFormat := pf24bit; // avoid palette problems
result.Canvas.Draw(0, 0, Metafile)
finally
Metafile.Free
end
end;
end;
procedure Tmainf.MN_SelectImageClick(Sender: TObject);
begin
if screen.ActiveControl is TDBimage then
if OpenPictureDialog1.Execute then
begin
TDBimage(screen.ActiveControl).Picture.Bitmap.assign(LoadPictureFromFile(OpenPictureDialog1.FileName));
end;
end;
我的表纪录里有个字段,内容是某个图标的地址,如何将这个图标显示在dbgrid中?
------解决方案--------------------
function LoadPictureFromFile(const FileName: string): TBitmap;
var
Extension: string;
// GIFimage:TGIFimage;
Icon: TIcon;
jpeg: Tjpegimage;
Metafile: TMetafile;
begin
result := nil; // In case anything goes wrong
if FileExists(FileName) then
begin
Extension := UpperCase(Copy(FileName, Length(FileName) - 2, 3));
// Quick and dirty check that file type is OK
if ((Extension = 'BMP ') or (Extension = 'JPG ') or (Extension = 'ICO ')
or (Extension = 'WMF ') or (Extension = 'EMF ')) then
result := TBitmap.create;
// BMP File -- no additional work to get TBitmap
if (Extension = 'BMP ') then
result.LoadFromFile(FileName);
// ICO File
if (Extension = 'ICO ') then
begin
try
try
Icon := TIcon.create;
Icon.LoadFromFile(FileName);
result.Width := Icon.Width;
result.Height := Icon.Height;
result.PixelFormat := pf24bit; // avoid palette problems
result.Canvas.Draw(0, 0, Icon);
except
on e: exception do
begin
MessageBox(0, Pchar( '装载图象文件 ' + FileName +
'出错: '
+
e.Message),
'程序跳出 ', MB_OK);
end;
end;
finally
Icon.Free;
end;
end;
end;
// JPG File
if (Extension = 'JPG ') or (Extension = 'JPEG ') then
begin
try
jpeg := Tjpegimage.create;
jpeg.LoadFromFile(FileName);
result.PixelFormat := pf24bit;
result.Assign(jpeg);
finally
jpeg.Free;
end;
end;
if (Extension = 'WMF ') or (Extension = 'EMF ') then
begin
Metafile := TMetafile.create;
try
Metafile.LoadFromFile(FileName);
result.Height := Metafile.Height;
result.Width := Metafile.Width;
result.PixelFormat := pf24bit; // avoid palette problems
result.Canvas.Draw(0, 0, Metafile)
finally
Metafile.Free
end
end;
end;
procedure Tmainf.MN_SelectImageClick(Sender: TObject);
begin
if screen.ActiveControl is TDBimage then
if OpenPictureDialog1.Execute then
begin
TDBimage(screen.ActiveControl).Picture.Bitmap.assign(LoadPictureFromFile(OpenPictureDialog1.FileName));
end;
end;