📄 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.
Uint 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 + -