dxgdiplusclasses.pas

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

  if GdipCreateFromHDC(DC, AGraphics) = Ok then
  begin
    GdipCheck(GdipGetImageDimension(Handle, AImageWidth, AImageHeight));
    GdipCheck(GdipDrawImageRectRectI(AGraphics, Handle, R.Left, R.Top,
      R.Right - R.Left, R.Bottom - R.Top, 0, 0,
      Trunc(AImageWidth), Trunc(AImageHeight), UnitPixel, nil, nil, nil));
    GdipCheck(GdipDeleteGraphics(AGraphics));
  end;
end;

class function TdxGPImage.GetBitmapBits(ABitmap: TBitmap): TdxRGBColors;
var
  AInfo: TBitmapInfo;
  AScreenDC: HDC;
begin
  SetLength(Result, ABitmap.Width * ABitmap.Height);
  FillChar(AInfo, SizeOf(AInfo), 0);
  AInfo.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
  AInfo.bmiHeader.biWidth := ABitmap.Width;
  AInfo.bmiHeader.biHeight := -ABitmap.Height;
  AInfo.bmiHeader.biPlanes := 1;
  AInfo.bmiHeader.biBitCount := 32;
  AInfo.bmiHeader.biCompression := BI_RGB;
  AScreenDC := GetDC(0);
  if GetDIBits(AScreenDC, ABitmap.Handle, 0, ABitmap.Height, Result, AInfo,
    DIB_RGB_COLORS) = 0
  then
    GetBitmapBitsByScanLine(ABitmap, Result);
  ReleaseDC(0, AScreenDC);
end;

class procedure TdxGPImage.GetBitmapBitsByScanLine(ABitmap: TBitmap;
  var AColors: TdxRGBColors);
var
  AIndex: Integer;
  AQuad: PRGBQuad;
  I, J: Integer;
begin
  // todo: try to get bitmap bits if GetDIBits fail
  if ABitmap.PixelFormat = pf32bit then
  begin
    if Length(AColors) <> ABitmap.Width * ABitmap.Height then
      SetLength(AColors, ABitmap.Width * ABitmap.Height);
    AIndex := 0;
    for J := 0 to ABitmap.Height - 1 do
    begin
      AQuad := ABitmap.ScanLine[J];
      for I := 0 to ABitmap.Width - 1 do
      begin
        AColors[AIndex] := AQuad^;
        Inc(AQuad);
        Inc(AIndex);
      end;
    end;
  end;
end;

procedure TdxGPImage.LoadFromDataStream(AStream: TStream);
var
  Data: HGlobal;
  DataPtr: Pointer;
  AccessStream: IStream;
begin
  Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, AStream.Size);
  try
    DataPtr := GlobalLock(Data);
    try
      AStream.Read(DataPtr^, AStream.Size);
      GdipCheck(CreateStreamOnHGlobal(Data, False, AccessStream) = s_OK);
      GdipCheck(GdipCreateBitmapFromStream(AccessStream, FHandle));
    finally
      GlobalUnlock(Data);
      AccessStream := nil;
    end;
  finally
    GlobalFree(Data);
  end;
end;

{ TdxGPNullImage }

class function TdxGPNullImage.NewInstance: TObject;
begin
  Result := InitInstance(AllocMem(InstanceSize));
end;

procedure TdxGPNullImage.FreeInstance;
var
  P: Pointer;
begin
  CleanupInstance;
  P := Self;
  FreeMem(P);
end;

{ TdxPNGImage }

destructor TdxPNGImage.Destroy;
begin
  Handle := nil;
  inherited Destroy;
end;

procedure TdxPNGImage.Assign(Source: TPersistent);
begin
  if Source is TBitmap then
    Handle := CreateFromBitmap(TBitmap(Source))
  else
    if (Source is TdxPNGImage) and (TdxPNGImage(Source).Handle <> nil) then
      Handle := TdxPNGImage(Source).Handle.Clone
    else
      inherited Assign(Source);
end;

function TdxPNGImage.Compare(AImage: TdxPngImage): Boolean;

  function GetColors(AImage: TdxPNGImage): TdxRGBColors;
  var
    ABitmap: TBitmap;
  begin
    ABitmap := AImage.GetAsBitmap;
    try
      Result := AImage.Handle.GetBitmapBits(ABitmap);
    finally
      ABitmap.Free;
    end;
  end;

  function CompareColors(Color1, Color2: TRGBQuad): Boolean;
  begin
    Result := (Color1.rgbBlue = Color2.rgbBlue) and
      (Color1.rgbGreen = Color2.rgbGreen) and
      (Color1.rgbRed = Color2.rgbRed) and
      (Color1.rgbReserved = Color2.rgbReserved);
  end;

var
  AColors: TdxRGBColors;
  AColors2: TdxRGBColors;
  I: Integer;
begin
  AColors := nil;
  AColors2 := nil;
  Result := (AImage.Height = Height) and (AImage.Width = Width);
  if Result and not (AImage.Empty or Empty) then
  begin
    AColors := GetColors(AImage);
    AColors2 := GetColors(Self);
    for I := 0 to High(AColors) do
    begin
      Result := CompareColors(AColors[I], AColors2[I]);
      if not Result then
        Exit;
    end;
  end;
end;

procedure TdxPNGImage.DrawEx(
  Graphics: GpGraphics; const ADest, ASource: TRect);
begin
  if Handle = nil then Exit;
  StretchDrawEx(Graphics, ADest, ASource);
end;

function TdxPNGImage.GetAsBitmap: TBitmap;
var
  AHandle: HBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf32Bit;
  GdipCheck(GdipCreateHBITMAPFromBitmap(Handle.Handle, AHandle, 0));
  Result.Handle := AHandle;
end;

class function TdxPNGImage.CreateFromBitmap(ASource: TBitmap): TdxGPImage;
begin
  CheckGdiPlus;
  Result := dxGPImageClass.CreateFromBitmap(ASource);
end;

procedure TdxPNGImage.LoadFromStream(Stream: TStream);
begin
  if Stream.Size = 0 then
    Handle := nil
  else
    Handle := dxGPImageClass.CreateFromStream(Stream)
end;

procedure TdxPNGImage.SaveToStream(Stream: TStream);
var
  ADest: TMemoryStream;
begin
  if Handle <> nil then
  begin
    ADest := TMemoryStream.Create();
    try
      Handle.SaveToStream(ADest);
      ADest.Position := 0;
      Stream.CopyFrom(ADest, ADest.Size);
    finally
      ADest.Free;
    end;
  end;
end;

procedure TdxPNGImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
begin
end;

procedure TdxPNGImage.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  var APalette: HPALETTE);
begin
end;

procedure TdxPNGImage.SetBitmap(ABitmap: TBitmap);
begin
  Handle := CreateFromBitmap(ABitmap);
end;

procedure TdxPNGImage.StretchDraw(DC: HDC; const ADest: TRect);
begin
  StretchDraw(DC, ADest, Rect(0, 0, Width, Height));
end;

procedure TdxPNGImage.StretchDraw(DC: HDC; const ADest, ASource: TRect);
var
  Gp: GpGraphics;
begin
  if Handle = nil then Exit;
  GdipCheck(GdipCreateFromHDC(DC, Gp));
  StretchDrawEx(Gp, ADest, ASource);
  GdipCheck(GdipDeleteGraphics(Gp));
end;

procedure TdxPNGImage.StretchDrawEx(
  Graphics: GpGraphics; const ADest, ASource: TRect);
var
  DstH, DstW, SrcH, SrcW: Single;
begin
  if Handle = nil then Exit;
  SrcW := ASource.Right - ASource.Left;
  SrcH := ASource.Bottom - ASource.Top;
  DstW := ADest.Right - ADest.Left;
  DstH := ADest.Bottom - ADest.Top;
  if (SrcW < 1) or (SrcH < 1) or (DstW < 1) or (DstH < 1) then Exit;
  if (DstW > SrcW) and (SrcW > 1) then
    SrcW := SrcW - 1;
  if (DstH > SrcH) and (SrcH > 1) then
    SrcH := SrcH - 1;
  GdipCheck(GdipDrawImageRectRect(Graphics, Handle.Handle, ADest.Left, ADest.Top,
    DstW, DstH, ASource.Left, ASource.Top, SrcW,  SrcH, UnitPixel, nil, nil, nil))
end;

procedure TdxPNGImage.AssignTo(Dest: TPersistent); 
var
  ABitmap: TBitmap;
begin
  if Dest is TdxPNGImage then
    (Dest as TdxPNGImage).Assign(Self)  
  else
    if Dest is TBitmap then
    begin
      ABitmap := GetAsBitmap;
      try
        (Dest as TBitmap).Assign(ABitmap);
      finally
        ABitmap.Free;
      end;
    end
    else
      inherited AssignTo(Dest);
end;

procedure TdxPNGImage.Changed(Sender: TObject);
begin
  FIsAlphaUsedAssigned := False;
  inherited Changed(Sender);
end;

function TdxPNGImage.CheckAlphaUsed: Boolean;
var
  ABitmap: TBitmap;
  AColors: TdxRGBColors;
  I: Integer;
begin
  Result := False;
  ABitmap := GetAsBitmap;
  try
    AColors := Handle.GetBitmapBits(ABitmap);
    for I := Low(AColors) to High(AColors) do
    begin
      Result := AColors[I].rgbReserved <> 255;
      if Result then
        Break;
    end;  
  finally
    ABitmap.Free;
  end;
end;

procedure TdxPNGImage.Draw(ACanvas: TCanvas; const ARect: TRect);
begin
  StretchDraw(ACanvas.Handle, ARect, Rect(0, 0, Width, Height));
end;

function TdxPNGImage.GetEmpty: Boolean;
begin
  with GetSize do
    Result := (cx <= 0) or (cy <= 0)
end;

function TdxPNGImage.GetHeight: Integer;
begin
  Result := GetSize.cy;
end;

function TdxPNGImage.GetIsAlphaUsed: Boolean;
begin
  if FIsAlphaUsedAssigned then
    Result := FIsAlphaUsed
  else
  begin
    FIsAlphaUsed := CheckAlphaUsed;
    FIsAlphaUsedAssigned := True;
    Result := FIsAlphaUsed;
  end;
end;

function TdxPNGImage.GetSize: TSize;
var
  W, H: Single;
begin
  if Handle <> nil then
    GdipCheck(GdipGetImageDimension(Handle.Handle, W, H))
  else
  begin
    W := 0;
    H := 0;
  end;
  Result.cx := Trunc(W);
  Result.cy := Trunc(H);
end;

function TdxPNGImage.GetTransparent: Boolean;
begin
  Result := True;
end;

function TdxPNGImage.GetWidth: Integer;
begin
  Result := GetSize.cx;
end;

procedure TdxPNGImage.SetWidth(Value: Integer);
begin
end;

procedure TdxPNGImage.SetHeight(Value: Integer);
begin
end;

procedure TdxPNGImage.SetHandle(AHandle: TdxGPImage);
begin
  if AHandle <> FHandle then
  begin
    if FHandle <> nil then
      FHandle.Free;
    FHandle := AHandle;
  end;
end;

procedure RegisterAssistants;
begin
  dxGPImageClass := TdxGPNullImage;
  if CheckGdiPlus then
  begin
    CheckPngCodec;
    dxGPImageClass := TdxGPImage;
    RegisterClasses([TdxPNGImage]);
    TPicture.RegisterFileFormat('PNG', 'PNG graphics from DevExpress', TdxPNGImage);
  end;
end;

procedure UnregisterAssistants;
begin
  TPicture.UnregisterGraphicClass(TdxPNGImage);
  UnregisterClasses([TdxPNGImage]);
end;

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

finalization
  dxUnitsLoader.RemoveUnit(@UnregisterAssistants);

end.