dxgdiplusapi.pas

胜天进销存源码,国产优秀的进销存

    GdipGetHatchBackgroundColor := LoadGdiPlusMethod('GdipGetHatchBackgroundColor');
    // GDI+ Pen methods loading
    GdipCreatePen1 := LoadGdiPlusMethod('GdipCreatePen1');
    GdipCreatePen2 := LoadGdiPlusMethod('GdipCreatePen2');
    GdipClonePen := LoadGdiPlusMethod('GdipClonePen');
    GdipDeletePen := LoadGdiPlusMethod('GdipDeletePen');
    GdipGetPenFillType := LoadGdiPlusMethod('GdipGetPenFillType');
    GdipSetPenBrushFill := LoadGdiPlusMethod('GdipSetPenBrushFill');
    GdipGetPenBrushFill := LoadGdiPlusMethod('GdipGetPenBrushFill');
    GdipSetPenColor := LoadGdiPlusMethod('GdipSetPenColor');
    GdipGetPenColor := LoadGdiPlusMethod('GdipGetPenColor');
    GdipSetPenMode := LoadGdiPlusMethod('GdipSetPenMode');
    GdipGetPenMode := LoadGdiPlusMethod('GdipGetPenMode');
    GdipSetPenWidth := LoadGdiPlusMethod('GdipSetPenWidth');
    GdipGetPenWidth := LoadGdiPlusMethod('GdipGetPenWidth');
    // GDI+ Graphis methods loading
    GdipCreateFromHDC := LoadGdiPlusMethod('GdipCreateFromHDC');
    GdipDeleteGraphics := LoadGdiPlusMethod('GdipDeleteGraphics');
    GdipGetDC := LoadGdiPlusMethod('GdipGetDC');
    GdipReleaseDC := LoadGdiPlusMethod('GdipReleaseDC');
    GdipGraphicsClear := LoadGdiPlusMethod('GdipGraphicsClear');
    GdipDrawLineI := LoadGdiPlusMethod('GdipDrawLineI');
    GdipFillRectangleI := LoadGdiPlusMethod('GdipFillRectangleI');
    GdipDrawArcI := LoadGdiPlusMethod('GdipDrawArcI');
    GdipDrawBezierI := LoadGdiPlusMethod('GdipDrawBezierI');
    GdipDrawRectangleI := LoadGdiPlusMethod('GdipDrawRectangleI');
    GdipDrawEllipseI := LoadGdiPlusMethod('GdipDrawEllipseI');
    GdipDrawPieI := LoadGdiPlusMethod('GdipDrawPieI');
    GdipDrawPolygonI := LoadGdiPlusMethod('GdipDrawPolygonI');
    GdipDrawCurve2I := LoadGdiPlusMethod('GdipDrawCurve2I');
    GdipDrawClosedCurve2I := LoadGdiPlusMethod('GdipDrawClosedCurve2I');
    GdipFillPolygonI := LoadGdiPlusMethod('GdipFillPolygonI');
    GdipFillEllipseI := LoadGdiPlusMethod('GdipFillEllipseI');
    GdipFillPieI := LoadGdiPlusMethod('GdipFillPieI');
    GdipFillClosedCurveI := LoadGdiPlusMethod('GdipFillClosedCurveI');
    // added from MSN
    GdipLoadImageFromStream := LoadGdiPlusMethod('GdipLoadImageFromStream');
    GdipCreateBitmapFromFile := LoadGdiPlusMethod('GdipCreateBitmapFromFile');
    GdipCreateBitmapFromStream := LoadGdiPlusMethod('GdipCreateBitmapFromStream');
    GdipCreateBitmapFromStreamICM := LoadGdiPlusMethod('GdipCreateBitmapFromStreamICM');
    GdipCreateHBITMAPFromBitmap := LoadGdiPlusMethod('GdipCreateHBITMAPFromBitmap');
    GdipLoadImageFromFile := LoadGdiPlusMethod('GdipLoadImageFromFile');
    GdipGetImageDimension := LoadGdiPlusMethod('GdipGetImageDimension');
    GdipDrawImageRectI := LoadGdiPlusMethod('GdipDrawImageRectI');
    GdipDisposeImage := LoadGdiPlusMethod('GdipDisposeImage');
    GdipGetImageEncodersSize := LoadGdiPlusMethod('GdipGetImageEncodersSize');
    GdipGetImageEncoders := LoadGdiPlusMethod('GdipGetImageEncoders');
    GdipSaveImageToStream := LoadGdiPlusMethod('GdipSaveImageToStream');
    GdipCreateBitmapFromHBITMAP := LoadGdiPlusMethod('GdipCreateBitmapFromHBITMAP');
    GdipGetEncoderParameterListSize := LoadGdiPlusMethod('GdipGetEncoderParameterListSize');
    GdipGetEncoderParameterList := LoadGdiPlusMethod('GdipGetEncoderParameterList');
    GdipCreateBitmapFromGdiDib := LoadGdiPlusMethod('GdipCreateBitmapFromGdiDib');
    GdipCreateBitmapFromScan0 := LoadGdiPlusMethod('GdipCreateBitmapFromScan0');
    GdipBitmapLockBits := LoadGdiPlusMethod('GdipBitmapLockBits');
    GdipBitmapUnlockBits := LoadGdiPlusMethod('GdipBitmapUnlockBits');
    GdipDrawImageRectRectI := LoadGdiPlusMethod('GdipDrawImageRectRectI');
    GdipDrawImageRectRect := LoadGdiPlusMethod('GdipDrawImageRectRect');
    GdipDrawImagePointRect := LoadGdiPlusMethod('GdipDrawImagePointRect');
    GdipCloneImage := LoadGdiPlusMethod('GdipCloneImage');
    //lcm
    GdipSetInterpolationMode := LoadGdiPlusMethod('GdipSetInterpolationMode');
    GdipGetInterpolationMode := LoadGdiPlusMethod('GdipGetInterpolationMode');
    GdipCreateCachedBitmap := LoadGdiPlusMethod('GdipCreateCachedBitmap');
    GdipDeleteCachedBitmap := LoadGdiPlusMethod('GdipDeleteCachedBitmap');
    GdipDrawCachedBitmap := LoadGdiPlusMethod('GdipDrawCachedBitmap');
    GdipCreateBitmapFromGraphics := LoadGdiPlusMethod('GdipCreateBitmapFromGraphics');
    GdipGetImageGraphicsContext := LoadGdiPlusMethod('GdipGetImageGraphicsContext');
    GdipGetImageWidth := LoadGdiPlusMethod('GdipGetImageWidth');
    GdipGetImageHeight := LoadGdiPlusMethod('GdipGetImageHeight');
    GdipSetCompositingMode := LoadGdiPlusMethod('GdipSetCompositingMode');
    GdipGetCompositingMode := LoadGdiPlusMethod('GdipGetCompositingMode');
    GdipSetCompositingQuality := LoadGdiPlusMethod('GdipSetCompositingQuality');
    GdipGetCompositingQuality := LoadGdiPlusMethod('GdipGetCompositingQuality');
    GdipSetSmoothingMode := LoadGdiPlusMethod('GdipSetSmoothingMode');
    GdipGetSmoothingMode := LoadGdiPlusMethod('GdipGetSmoothingMode');
    GdipCloneBitmapAreaI := LoadGdiPlusMethod('GdipCloneBitmapAreaI');
    //
    if (GdiPlusStartup(FGDIPlusToken, DefaultStartup, @FGdiPlusHook) <> OK) or
      (FGdiPlusHook.NotificationHook(FGDIPlusToken) <> Ok) then
    begin
      FGDIPresent := False;
      FillChar(FGdiPlusHook, SizeOf(FGdiPlusHook), 0);
    end;                 
  end;
end;

function CheckGdiPlus: Boolean;
begin
  if not FGDIPresent then  
    GdiPlusLoad;
  Result := FGDIPresent;
end;

function dxUnitsLoader: TdxUnitsLoader;
begin
  if UnitsLoader = nil then
    UnitsLoader := TdxUnitsLoader.Create;
  Result := UnitsLoader;
end;

procedure dxInitializeGDIPlus;
begin
  dxUnitsLoader.Initialize;
end;

procedure dxFinalizeGDIPlus;
begin
  dxUnitsLoader.Finalize;
end;

procedure GdiPlusUnload;
begin
  if FGDIPresent then
  begin
    FGdiPlusHook.NotificationUnhook(FGDIPlusToken);
    GdiPlusShutdown(FGDIPlusToken);
  end;
  if FGDIPlusLibrary <> 0 then
    FreeLibrary(FGDIPlusLibrary);
  FGDIPresent := False;
end;

{ TGdiplusBase }

class function TdxGPBase.NewInstance: TObject;
begin
  Result := InitInstance(GdipAlloc(ULONG(instanceSize)));
end;

procedure TdxGPBase.FreeInstance;
begin
  CleanupInstance;
  GdipFree(Self);
end;

{ TdxGPPoint }

function MakePoint(X, Y: Integer): TdxGPPoint;
begin
  result.X := X;
  result.Y := Y;
end;

function MakePoint(X, Y: Single): TdxGPPointF;
begin
  Result.X := X;
  result.Y := Y;
end;

{ TdxGPSizeF }

function MakeSize(Width, Height: Single): TdxGPSizeF;
begin
  result.Width := Width;
  result.Height := Height;
end;

function MakeSize(Width, Height: Integer): TdxGPSize;
begin
  result.Width := Width;
  result.Height := Height;
end;

{ TdxGPRectF }

function MakeRect(x, y, width, height: Single): TdxGPRectF; overload;
begin
  Result.X      := x;
  Result.Y      := y;
  Result.Width  := width;
  Result.Height := height;
end;

function MakeRect(location: TdxGPPointF; size: TdxGPSizeF): TdxGPRectF; overload;
begin
  Result.X      := location.X;
  Result.Y      := location.Y;
  Result.Width  := size.Width;
  Result.Height := size.Height;
end;

{ TdxGPRect }

function MakeRect(x, y, width, height: Integer): TdxGPRect; overload;
begin
  Result.X      := x;
  Result.Y      := y;
  Result.Width  := width;
  Result.Height := height;
end;

function MakeRect(location: TdxGPPoint; size: TdxGPSize): TdxGPRect; overload;
begin
  Result.X      := location.X;
  Result.Y      := location.Y;
  Result.Width  := size.Width;
  Result.Height := size.Height;
end;

function MakeRect(Rect: TRect): TdxGPRect; overload;
begin
  Result.X      := Rect.Left;
  Result.Y      := Rect.Top;
  Result.Width  := Rect.Right - Rect.Left;
  Result.Height := Rect.Bottom - Rect.Top;
end;

function GetCodecID(const CodecName: string; out Clsid: TGUID): GPStatus;
var
  Count, Size, Index: Integer;
  CodecInfo, StartInfo: PdxGPImageCodecInfo;
begin
  Count := 0;
  Size := 0;
  Result := GenericError;
  if not CheckGdiPlus or (GdipGetImageEncodersSize(Count, Size) <> Ok) or (Size <= 0) then Exit;
  GetMem(StartInfo, Size);
  CodecInfo := StartInfo;
  try
    if GdipGetImageEncoders(Count, Size, CodecInfo) = Ok then
      for Index := 0 to Count - 1 do
      begin
        if SameText(CodecInfo^.MimeType, CodecName) then
        begin
           Clsid := CodecInfo^.Clsid;
           Result := Ok;
           Break;
        end;
        Inc(Integer(CodecInfo), SizeOf(TdxGPImageCodecInfo));
      end;
  finally
    FreeMem(StartInfo, Size);
  end;
end;

procedure CheckPngCodec;
begin
  if (PngCodec.D1 = 0) and (PngCodec.D2 = 0) and (PngCodec.D3 = 0) then  
    GetCodecID('image/png', PngCodec);
end;

procedure GdipCheck(AStatus: GPStatus);
begin
  GdipCheck(AStatus = Ok);
end;

procedure GdipCheck(AStatus: Boolean);
begin
  Assert(AStatus, scxGdipInvalidOperation);
end;

function DifferentImage2Bitmap(AStream: TStream): TBitmap;
var
  Data: HGlobal;
  DataPtr: Pointer;
  Image: GpImage;
  AccessStream: IStream;
  Handle: HBitmap;
  Header: TBitmapFileHeader;
begin
  Result := TBitmap.Create;
  try
    if AStream.Size > SizeOf(Header) then
    begin
      AStream.ReadBuffer(Header, SizeOf(Header));
      if Header.bfType = $4D42 then
      begin
        AStream.Position := 0;
        Result.LoadFromStream(AStream);
        Result.PixelFormat := pf32Bit;
        Exit;
      end;
    end;
    if not CheckGdiPlus then Exit;
    Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, AStream.Size);
    try
      DataPtr := GlobalLock(Data);
      try
        AStream.Position := 0;
        AStream.Read(DataPtr^, AStream.Size);
        Image := nil;
        GdipCheck(CreateStreamOnHGlobal(Data, False, AccessStream) = s_OK);
        GdipCheck(GdipCreateBitmapFromStream(AccessStream, Image));
        GdipCheck(GdipCreateHBITMAPFromBitmap(Image, Handle, 0));
        Result.Handle := Handle;
        GdipCheck(GdipDisposeImage(Image));

      finally
        GlobalUnlock(Data);
        AccessStream := nil;
      end;
    finally
      GlobalFree(Data);
    end;
    Result.PixelFormat := pf32Bit;
  except
    Result.Free;
  end;
end;

function DifferentImage2Bitmap(const AFileName: string): TBitmap; overload;
var
  AStream: TStream;
begin
  AStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    Result := DifferentImage2Bitmap(AStream);
  finally
    AStream.Free;
  end;
end;

procedure Bitmap2PNG(ABitmap: TBitmap; AStream: TStream);
var
  Image: GpImage;
  Picture: Pointer;
  RowSize, Row: Integer;
const
  PixelFormat32bppPARGB     = $E200B;
begin
  CheckPngCodec;
  Picture := nil;
  try
    if ABitmap.PixelFormat = pf32bit then
    begin
      RowSize := ABitmap.Width * 4;
      GetMem(Picture, RowSize * ABitmap.Height);
      for Row := 0 to ABitmap.Height - 1 do
        Move(ABitmap.ScanLine[Row]^, PByteArray(Picture)^[Row * RowSize], RowSize);
      GdipCheck(GdipCreateBitmapFromScan0(ABitmap.Width,
        ABitmap.Height, ABitmap.Width * 4, PixelFormat32bppPARGB, Picture, Image));
    end
    else
      GdipCheck(GdipCreateBitmapFromHBITMAP(ABitmap.Handle, ABitmap.Palette, Image));
    GdipCheck(GdipSaveImageToStream(Image,
      TStreamAdapter.Create(AStream, soReference), @PngCodec, nil));
    GdipCheck(GdipDisposeImage(Image));
  finally
    FreeMem(Picture);
  end;
end;

procedure Bitmap2PNG(ABitmap: TBitmap; const AFileName: string);
var
  AStream: TStream;
begin
  AStream := TFileStream.Create(AFileName, fmCreate);
  try
    Bitmap2PNG(ABitmap, AStream);
  finally
    AStream.Free;
  end;
end;

procedure RegisterAssistants;
begin
  FGDIPresent := False;
end;

procedure UnregisterAssistants;
begin
  GdiPlusUnload;
end;

initialization
  dxUnitsLoader.AddUnit(@RegisterAssistants, @UnregisterAssistants);

finalization
  if FGDIPresent and IsDLL and (UnitsLoader.FinalizeList.Count > 0) then
    raise Exception.Create('Need call dxFinalizeGDIPlus before free library!');
  FreeAndNil(UnitsLoader);

end.