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

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