gdipclasses.pas

Workflow Studio是一款专为商业进程管理（BPM）设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最

procedure TGPBlockDrawer.TransformPath(APath: TGPGraphicsPath);
begin
  TranslateRectsPath(APath);
  RotatePath(APath);
end;

function TGPBlockDrawer.GetRotCenter: TPointX;
begin
  result := GPCanvas.RotationCenter;
end;

procedure TGPBlockDrawer.SetRotCenter(const Value: TPointX);
begin
  GPCanvas.RotationCenter := Value;
end;

function TGPBlockDrawer.GetAngle: single;
begin
  result := GPCanvas.Angle;
end;

procedure TGPBlockDrawer.SetAngle(const Value: single);
begin
  GPCanvas.Angle := Value;
end;

{ TDgrPicture }

procedure TDgrPicture.Changed(Sender: TObject);
begin
  DestroyGPImage;
end;

constructor TDgrPicture.Create;
begin
  inherited Create;
  FGPImage := nil;
  FStream := TMemoryStream.Create;
  FTransparency := 0;
end;

type
  {This StreamAdapter solves a problem with Delphi VCL stream adapter.
   The problem happens when a PNG image is being loaded from a Stream by the Gdi+ api.
   The ntdll will raise a breakpoint. This class fixes the problem}
  TFixStreamAdapter = class(TStreamAdapter)
  public
    function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; override; stdcall;
  end;

function TFixStreamAdapter.Stat(out statstg: TStatStg; grfStatFlag: Integer): HResult;
begin
  result := inherited Stat(statstg, grfStatFlag);
  statstg.pwcsName := nil;
end;

procedure TDgrPicture.CreateGPImage;
var
  AStream: TStreamAdapter;
begin
  AStream := TFixStreamAdapter.Create(FStream);
  AStream.Stream.Position := 0;
  Graphic.SaveToStream(FStream);
  AStream.Stream.Position := 0;
  FGPImage := TGPImage.Create(AStream);
end;

destructor TDgrPicture.Destroy;
begin
  DestroyGPImage;
  FStream.Free;
  inherited;
end;

procedure TDgrPicture.DestroyGPImage;
begin
  if FGPImage <> nil then
  begin
    FGPImage.Free;
    FGPImage := nil;
  end;
end;

function TDgrPicture.GPImage: TGPImage;
begin
  if FGPImage = nil then
    CreateGPImage;
  result := FGPImage;
end;

procedure TDgrPicture.SetTransparency(const Value: integer);
begin
  if FTransparency <> Value then
  begin
    FTransparency := Value;
    Changed(Self);
  end;
end;

{ TDgrGraphic }

procedure TDgrGraphic.Assign(Source: TPersistent);

  procedure AssignFromGraphic(AGraphic: TGraphic);
  var
    st: TMemoryStream;
  begin
    st := TMemoryStream.Create;
    AGraphic.SaveToStream(st);
    st.Position := 0;
    FDataStream.Clear;
    FDataStream.LoadFromStream(st);
    st.Free;
    FIsEmpty := false;
    Transparent := AGraphic.Transparent;
    Changed(Self);
  end;

begin
  FIsEmpty := True;
  if Source = nil then
  begin
    FDataStream.Clear;
    FIsEmpty := true;
    Changed(Self);
  end
  else
  if Source is TDgrGraphic then
  begin
    FDataStream.LoadFromStream(TDgrGraphic(Source).FDataStream);
    FIsEmpty := False;
    Changed(Self);
  end
  else
  if Source is TGraphic then
    AssignFromGraphic(TGraphic(Source))
  else
  if Source is TPicture then
    AssignFromGraphic(TPicture(Source).Graphic);

  GetImageSizes;
end;

constructor TDgrGraphic.Create;
begin
  inherited;
  FDataStream := TMemoryStream.Create;
  FIsEmpty := True;
  FGPImage := nil;
end;

destructor TDgrGraphic.Destroy;
begin
  DestroyGPImage;
  FDataStream.Free;
  inherited;
end;

procedure TDgrGraphic.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  AGPCanvas: TGPCanvas;
begin
  if Empty then
    Exit;

  if FDataStream.Size = 0 then
    Exit;

  AGPCanvas := TGPCanvas.Create(ACanvas.Handle);
  try
    AGPCanvas.StretchDraw(RectX(Rect), GPImage, 0, Transparent);
  finally
    AGPCanvas.Free;
  end;
end;

function TDgrGraphic.GetImageSizes: boolean;
var
  multi: TGPImage;
  pstm: IStream;
  hGlobal: THandle;
  pcbWrite: Longint;
  aSize: Largeint;
begin
  Result := false;

  if Empty then
    Exit;

  if FDataStream.Size = 0 then
    Exit;

  hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
  if (hGlobal = 0) then
    raise Exception.Create('Could not allocate memory for image');

  try
    pstm := nil;
    // Create IStream* from global memory
    CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
    pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
    pstm.Seek(0, STREAM_SEEK_SET, aSize);
    multi := TGPImage.Create(pstm);

    FWidth := multi.GetWidth;
    FHeight := multi.GetHeight;

    Result := true;

    multi.Free;
  finally
    GlobalFree(hGlobal);
  end;

end;

function TDgrGraphic.GetEmpty: Boolean;
begin
  Result := FIsEmpty;
end;

function TDgrGraphic.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TDgrGraphic.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TDgrGraphic.LoadFromFile(const FileName: string);
begin
  try
    FDataStream.LoadFromFile(Filename);

    FIsEmpty := False;

    {if Assigned(OnClear) then
      OnClear(self);}

    GetImageSizes;

    Changed(Self);

  except
    FIsEmpty:=true;
  end;
end;

procedure TDgrGraphic.LoadFromStream(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.LoadFromStream(Stream);
    FIsEmpty := False;

    GetImageSizes;

    Changed(Self);
  end;
end;

procedure TDgrGraphic.ReadData(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.LoadFromStream(stream);
    FIsEmpty := False;
  end;
end;

procedure TDgrGraphic.SaveToStream(Stream: TStream);
begin
  if Assigned(Stream) then
    FDataStream.SaveToStream(Stream);
end;

procedure TDgrGraphic.SetHeight(Value: Integer);
begin
  {$IFDEF DELPHI6_LVL}
  inherited;
  {$ENDIF}
end;

procedure TDgrGraphic.SetWidth(Value: Integer);
begin
  {$IFDEF DELPHI6_LVL}
  inherited;
  {$ENDIF}
end;

(*procedure TDgrGraphic.LoadFromResourceName(Instance: THandle; const ResName: string);
var
  Stream: TCustomMemoryStream;
begin
  if FindResource(Instance,PChar(ResName),RT_RCDATA) <> 0 then
  begin
    Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
    try
      LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TDgrGraphic.LoadFromResourceID(Instance: THandle; ResID: Integer);
var
  Stream: TCustomMemoryStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;*)

procedure TDgrGraphic.WriteData(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.SaveToStream(stream);
  end;
end;

(*procedure TDgrGraphic.LoadFromURL(url: string);
begin
  if (pos('RES://',UpperCase(url))=1) then
  begin
    Delete(url,1,6);
    if (url<>'') then
      LoadFromResourceName(hinstance,url);
    Exit;
  end;

  if (pos('FILE://',uppercase(url))=1) then
  begin
    Delete(url,1,7);
    if (url<>'')
      then LoadFromFile(url);
  end;
end;*)

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

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

procedure TDgrGraphic.CreateGPImage;
var
  pstm: IStream;
  pcbWrite: Longint;
  aSize: Largeint;
  TempImage: TGPImage;
  TempGraphics: TGPGraphics;
  hglobal: THandle;
begin
  FDataStream.Position := 0;

  hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
  if (hGlobal = 0) then
    raise Exception.Create('Could not allocate memory for image');
  try

    pstm := nil;
    // Create IStream* from global memory
    CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
    pstm.Write(FDataStream.Memory, FDataStream.Size, @pcbWrite);
    pstm.Seek(0, STREAM_SEEK_SET, aSize);

    TempImage := TGPImage.Create(pstm);
    if TempImage.GetType = ImageTypeBitmap then
    begin
      {If the image is a bitmap, we must create a second bitmap and "copy" the original to the second one.
       If we don't do that, we should keep the stream open for the lifetime of the bitmap, so this copy
       simplifies things and we can destroy the stream (which is destroyed automatically when TempImage is destroyed)
       We don't need to do that with metafiles}
      FGPImage := TGPBitmap.Create(TempImage.GetWidth, TempImage.GetHeight, PixelFormat32bppARGB);
      TempGraphics := TGPGraphics.Create(FGPImage);
      TempGraphics.DrawImage(TempImage, 0, 0, TempImage.GetWidth, TempImage.GetHeight);
      TempGraphics.Free;
      TempImage.Free;
    end else
      FGPImage := TempImage;

  finally
    GlobalFree(hGlobal);
  end;
end;

procedure TDgrGraphic.DestroyGPImage;
begin
  if FGPImage <> nil then
  begin
    FGPImage.Free;
    FGPImage := nil;
  end;
end;

function TDgrGraphic.GPImage: TGPImage;
begin
  if FGPImage = nil then
    CreateGPImage;
  result := FGPImage;
end;

procedure TDgrGraphic.Changed(Sender: TObject);
begin
  inherited;
  DestroyGPImage;
end;

{$ENDIF}

end.