📄 graphicsconversionslibrary.pas
字号:
// Load various graphics formats (BMP, JPG, WMF, EMF, ICO, GIF) into a
// pf24bit TBitmap. The use of a pf24bit TBitmap avoids any palette issues.
//
// For GIF support, Anders Melander's TGIFImage must be installed
// (find it at www.melander.dk/delphi/gifimage) and a "GIF" conditional
// must be defined prior to compilation.
//
// efg, Sept 98.
unit GraphicsConversionsLibrary;
interface
uses
Graphics;
function LoadGraphicsFile(const Filename: string): TBitmap;
implementation
uses
{$IFDEF GIF}
GIFImage, // TGIFImage
{$ENDIF}
JPEG, // TJPEGImage
SysUtils; // FileExists
// Create TBitmap from BMP, JPG, WMF, EMF or GIF disk file.
// Could be easily extended to other image types.
function LoadGraphicsFile(const Filename: string): TBitmap;
var
Extension: string;
{$IFDEF GIF}
GIFImage: TGIFImage;
{$ENDIF}
Icon: TIcon;
JPEGImage: 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
ASSERT((Extension = 'BMP') or
(Extension = 'EMF') or
{$IFDEF GIF}
(Extension = 'GIF') or
{$ENDIF}
(Extension = 'ICO') or
(Extension = 'JPG') or
(Extension = 'WMF'));
RESULT := TBitmap.Create;
// BMP File -- no additional work to get TBitmap
if Extension = 'BMP'
then RESULT.LoadFromFile(Filename);
{$IFDEF GIF}
// GIF File
if Extension = 'GIF'
then begin
GIFImage := TGIFImage.Create;
try
GIFImage.LoadFromFile(Filename);
RESULT.Height := GIFImage.Height;
RESULT.Width := GIFImage.Width;
RESULT.PixelFormat := pf24bit;
RESULT.Canvas.Draw(0, 0, GIFImage)
finally
GIFImage.Free
end
end;
{$ENDIF}
// ICO File
if Extension = 'ICO'
then begin
Icon := TIcon.Create;
try
try
Icon.LoadFromFile(Filename);
RESULT.Height := Icon.Height;
RESULT.Width := Icon.Width;
RESULT.PixelFormat := pf24bit; // avoid palette problems
RESULT.Canvas.Draw(0, 0, Icon)
except
// Ignore problem icons, e.g., Stream read errors
end;
finally
Icon.Free
end
end;
// JPG File
if Extension = 'JPG'
then begin
JPEGImage := TJPEGImage.Create;
try
JPEGImage.LoadFromFile(Filename);
RESULT.Height := JPEGImage.Height;
RESULT.Width := JPEGImage.Width;
RESULT.PixelFormat := pf24bit;
RESULT.Canvas.Draw(0, 0, JPEGImage)
finally
JPEGImage.Free
end
end;
// Windows Metafiles, WMF or EMF
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;
// If Graphic is missing or invalid, create the "Red X"
if RESULT = nil
then begin
RESULT.Height := 32;
RESULT.Width := 32;
RESULT.PixelFormat := pf24bit;
with RESULT.Canvas do begin
Pen.Color := clRed;
Pen.Width := 3;
MoveTo(2, 2);
LineTo(29, 29);
MoveTo(2, 29);
LineTo(29, 2);
end
end
end {LoadGraphicFile};
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -