⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 graphicsconversionslibrary.~pas

📁 一个Delphi写的图片放大镜(很不错的源代码)
💻 ~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 + -