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

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

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