首页
社区
课程
招聘
[Delphi] Gdi+图像格式转换
发表于: 2012-12-10 03:25 4295

[Delphi] Gdi+图像格式转换

2012-12-10 03:25
4295

type
  DebugEventLevel = (
    DebugEventLevelFatal,
    DebugEventLevelWarning
  );
  TDebugEventLevel = DebugEventLevel;
  DebugEventProc = procedure(level: DebugEventLevel; message: PWideChar); stdcall;

  ImageCodecInfo = record
    Clsid             : TGUID;
    FormatID          : TGUID;
    CodecName         : PWideChar;
    DllName           : PWideChar;
    FormatDescription : PWideChar;
    FilenameExtension : PWideChar;
    MimeType          : PWideChar;
    Flags             : DWORD;
    Version           : DWORD;
    SigCount          : DWORD;
    SigSize           : DWORD;
    SigPattern        : PBYTE;
    SigMask           : PBYTE;
  end;
  TImageCodecInfo = ImageCodecInfo;
  PImageCodecInfo = ^TImageCodecInfo;

  GdiplusStartupInput = record
    GdiplusVersion          : Cardinal;
    DebugEventCallback      : DebugEventProc;
    SuppressBackgroundThread: BOOL;
    SuppressExternalCodecs  : BOOL;
  end;
  TGdiplusStartupInput = GdiplusStartupInput;
  PGdiplusStartupInput = ^TGdiplusStartupInput;

  EncoderParameter = record
    Guid           : TGUID;
    NumberOfValues : ULONG;
    Type_          : ULONG;
    Value          : Pointer;
  end;
  TEncoderParameter = EncoderParameter;
  PEncoderParameter = ^TEncoderParameter;

  EncoderParameters = record
    Count     : UINT;
    Parameter : array[0..0] of TEncoderParameter;
  end;
  TEncoderParameters = EncoderParameters;
  PEncoderParameters = ^TEncoderParameters;

  Status = (
    Ok,
    GenericError,
    InvalidParameter,
    OutOfMemory,
    ObjectBusy,
    InsufficientBuffer,
    NotImplemented,
    Win32Error,
    WrongState,
    Aborted,
    FileNotFound,
    ValueOverflow,
    AccessDenied,
    UnknownImageFormat,
    FontFamilyNotFound,
    FontStyleNotFound,
    NotTrueTypeFont,
    UnsupportedGdiplusVersion,
    GdiplusNotInitialized,
    PropertyNotFound,
    PropertyNotSupported
  );
  TStatus = Status;

  GpStatus           = TStatus;
  GpImage = Pointer;

  
  NotificationHookProc = function(out token: ULONG): Status; stdcall;
  NotificationUnhookProc = procedure(token: ULONG); stdcall;
 GdiplusStartupOutput = record
    NotificationHook  : NotificationHookProc;
    NotificationUnhook: NotificationUnhookProc;
  end;
  TGdiplusStartupOutput = GdiplusStartupOutput;
  PGdiplusStartupOutput = ^TGdiplusStartupOutput;

const WINGDIPDLL = 'gdiplus.dll';

var
  Form1: TForm1;
  StartupInput  :TGdiplusStartupInput;
  gdiplusToken  :ULONG;

function GdipGetImageEncodersSize(out numEncoders: UINT; out size: UINT): GPSTATUS; stdcall; external WINGDIPDLL name 'GdipGetImageEncodersSize';
function GdipGetImageEncoders(numEncoders: UINT; size: UINT; encoders: PIMAGECODECINFO): GPSTATUS; stdcall; external WINGDIPDLL name 'GdipGetImageEncoders';
function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput; output: PGdiplusStartupOutput): Status; stdcall; external WINGDIPDLL name 'GdiplusStartup';
function GdipLoadImageFromFile(filename: PWCHAR; out image: GPIMAGE): GPSTATUS; stdcall; external WINGDIPDLL name 'GdipLoadImageFromFile';
function GdipSaveImageToFile(image: GPIMAGE; filename: PWCHAR; clsidEncoder: PGUID; encoderParams: PENCODERPARAMETERS): GPSTATUS; stdcall; external WINGDIPDLL name 'GdipSaveImageToFile';
procedure GdiplusShutdown(token: ULONG); stdcall; external WINGDIPDLL name 'GdiplusShutdown';
implementation

{$R *.dfm}


function GetClsid(const format:PWideChar; pClsid:PGUID):Integer;
var
 num  :UINT;
 Size :UINT;
 Codec:PImageCodecInfo;
 Seek :PImageCodecInfo;
 j    :UINT;
begin
 Result := -1;
 Size := 0;
 num  := 0;
 GdipGetImageEncodersSize(num, size);
 if(size = 0) then Exit;
 Codec := GetMemory(size);
 Seek  := Codec;
 GdipGetImageEncoders(num, size, PImageCodecInfo(Codec));
 for j:= 0 to num do
 begin
  if lstrcmpW(Seek^.MimeType, format) = 0  then
  begin
   pClsid^ := Seek^.Clsid;
   Result  := j;
   Break;
  end;
  Inc(PByte(Seek), SizeOf(TImageCodecInfo));
 end;
 FreeMemory(Codec);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  encoderClsid  :TGUID;
  nativeImage   :Pointer;
  encoderParams :PEncoderParameters;
begin
 GetClsid('image/jpeg', @encoderClsid);
 nativeImage  := nil;
 encoderParams:= nil;
 GdipLoadImageFromFile('E:\源代码\1.bmp', nativeImage);
 GdipSaveImageToFile(nativeImage, 'E:\系统变量环境\桌面\1.jpeg', @encoderClsid, encoderParams);
 GdiplusShutdown(gdiplusToken);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 StartupInput.DebugEventCallback := nil;   //初始化一定要第一时间初始化不然    GdipGetImageEncodersSize 会爆 内存错误
 StartupInput.SuppressBackgroundThread := False;
 StartupInput.SuppressExternalCodecs   := False;
 StartupInput.GdiplusVersion := 1;
 GdiplusStartup(gdiplusToken, @StartupInput, nil);
end;

end.


因为刚好要用到就百度 结果发现全是控件的..... 然后就自己辛苦下

[培训]内核驱动高级班,冲击BAT一流互联网大厂工作,每周日13:00-18:00直播授课

收藏
免费 0
支持
分享
最新回复 (0)
游客
登录 | 注册 方可回帖
返回
//