TAChart: Add Windows Metafile drawing back-end

git-svn-id: trunk@30239 -

.gitattributes

@@ -2453,6 +2453,8 @@ components/tachart/tachartbgra.pas svneol=native#text/pascal
 components/tachart/tachartlazaruspkg.lpk svneol=native#text/plain
 components/tachart/tachartlazaruspkg.pas svneol=native#text/plain
 components/tachart/tachartutils.pas svneol=native#text/plain
+components/tachart/tachartwmf.lpk svneol=native#text/plain
+components/tachart/tachartwmf.pas svneol=native#text/pascal
 components/tachart/tacustomseries.pas svneol=native#text/plain
 components/tachart/tacustomsource.pas svneol=native#text/pascal
 components/tachart/tadbsource.pas svneol=native#text/pascal
@@ -2462,6 +2464,7 @@ components/tachart/tadrawercanvas.pas svneol=native#text/pascal
 components/tachart/tadrawerfpcanvas.pas svneol=native#text/pascal
 components/tachart/tadraweropengl.pas svneol=native#text/pascal
 components/tachart/tadrawersvg.pas svneol=native#text/pascal
+components/tachart/tadrawerwmf.pas svneol=native#text/pascal
 components/tachart/tadrawutils.pas svneol=native#text/pascal
 components/tachart/tafuncseries.pas svneol=native#text/pascal
 components/tachart/tageometry.pas svneol=native#text/pascal

components/tachart/tachartwmf.lpk

@@ -0,0 +1,42 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <PathDelim Value="\"/>
+    <Name Value="TAChartWMF"/>
+    <CompilerOptions>
+      <Version Value="10"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
+      </SearchPaths>
+      <Other>
+        <CompilerMessages>
+          <UseMsgFile Value="True"/>
+        </CompilerMessages>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="tadrawerwmf.pas"/>
+        <UnitName Value="TADrawerWMF"/>
+      </Item1>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="TAChartLazarusPkg"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

components/tachart/tachartwmf.pas

@@ -0,0 +1,20 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit TAChartWMF; 
+
+interface
+
+uses
+  TADrawerWMF, LazarusPackageIntf;
+
+implementation
+
+procedure Register; 
+begin
+end; 
+
+initialization
+  RegisterPackage('TAChartWMF', @Register); 
+end.

components/tachart/tadrawercanvas.pas

@@ -35,11 +35,11 @@ type
   TCanvasDrawer = class(
     TBasicDrawer, IChartDrawer, IChartTCanvasDrawer)
   private
-    FCanvas: TCanvas;
     procedure SetBrush(ABrush: TFPCustomBrush);
     procedure SetFont(AFont: TFPCustomFont);
     procedure SetPen(APen: TFPCustomPen);
   strict protected
+    FCanvas: TCanvas;
     function GetFontAngle: Double; override;
     function SimpleTextExtent(const AText: String): TPoint; override;
     procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;

components/tachart/tadrawerwmf.pas

@@ -0,0 +1,432 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+Authors: Luís Rodrigues, Alexander Klenin
+
+}
+
+unit TADrawerWMF;
+
+{$H+}
+
+interface
+
+uses
+  Windows, Classes, Graphics,
+  TADrawerCanvas;
+
+type
+  { TMetafile }
+
+  TMetafile = class(TGraphic)
+  private
+    FImageHandle: HENHMETAFILE;
+    FMMHeight: Integer; // are in 0.01 mm logical pixels
+    FMMWidth: Integer;  // are in 0.01 mm logical pixels
+    FImagePxHeight: Integer; // in device pixels
+    FImagePxWidth: Integer;  // in device pixels
+
+    procedure DeleteImage;
+    function GetAuthor: String;
+    function GetDescription: String;
+    function GetHandle: HENHMETAFILE;
+    procedure SetHandle(AValue: HENHMETAFILE);
+    procedure SetMMHeight(AValue: Integer);
+    procedure SetMMWidth(AValue: Integer);
+  protected
+    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
+    function GetEmpty: Boolean; override;
+    function GetHeight: Integer; override;
+    function GetTransparent: Boolean; override;
+    function GetWidth: Integer; override;
+    procedure SetHeight(AValue: Integer); override;
+    procedure SetTransparent(AValue: Boolean); override;
+    procedure SetWidth(AValue: Integer); override;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+
+  public
+    procedure Assign(ASource: TPersistent); override;
+    procedure Clear; override;
+    procedure LoadFromFile(const AFileName: String); override;
+    procedure LoadFromStream(AStream: TStream); override;
+    function ReleaseHandle: HENHMETAFILE;
+    procedure SaveToFile(const AFileName: String); override;
+    procedure SaveToStream(AStream: TStream); override;
+
+    property CreatedBy: String read GetAuthor;
+    property Description: String read GetDescription;
+    property Empty: boolean read GetEmpty;
+    property Handle: HENHMETAFILE read GetHandle write SetHandle;
+
+    property MMHeight: Integer read FMMHeight write SetMMHeight;
+    property MMWidth: Integer read FMMWidth write SetMMWidth;
+  end;
+
+
+  { TMetafileCanvas }
+
+  TMetafileCanvas = class(TCanvas)
+  strict private
+    FMetafile: TMetafile;
+  public
+    constructor Create(AMetafile: TMetafile; AReferenceDevice: HDC);
+    constructor CreateWithComment(
+      AMetafile: TMetafile; AReferenceDevice: HDC;
+      const ACreatedBy, ADescription: String);
+    destructor Destroy; override;
+  end;
+
+  { TWindowsMetafileDrawer }
+
+  TWindowsMetafileDrawer = class(TCanvasDrawer)
+  strict private
+    FFileName: String;
+    FMetafile: TMetafile;
+    FMetafileCanvas: TMetafileCanvas;
+  public
+    constructor Create(const AFileName: String); reintroduce;
+    destructor Destroy; override;
+  public
+    procedure DrawingBegin(const ABoundingBox: TRect); override;
+    procedure DrawingEnd; override;
+  end;
+
+implementation
+
+uses
+  SysUtils, TAChartUtils;
+
+{ TWindowsMetafileDrawer }
+
+constructor TWindowsMetafileDrawer.Create(const AFileName: String);
+begin
+  FFileName := AFileName;
+  FMetafile := TMetafile.Create;
+  inherited Create(nil);
+end;
+
+destructor TWindowsMetafileDrawer.Destroy;
+begin
+  FreeAndNil(FCanvas);
+  FreeAndNil(FMetafile);
+  inherited Destroy;
+end;
+
+procedure TWindowsMetafileDrawer.DrawingBegin(const ABoundingBox: TRect);
+begin
+  inherited DrawingBegin(ABoundingBox);
+  FCanvas := TMetafileCanvas.Create(FMetafile, 0);
+end;
+
+procedure TWindowsMetafileDrawer.DrawingEnd;
+begin
+  FreeAndNil(FCanvas);
+  FMetafile.SaveToFile(FFileName);
+end;
+
+{ TMetafile }
+
+procedure TMetafile.DeleteImage;
+begin
+  if FImageHandle <> 0 then
+     DeleteEnhMetafile(FImageHandle);
+   FImageHandle := 0;
+end;
+
+function TMetafile.GetAuthor: String;
+var
+  authorLength: Integer;
+begin
+  Result := '';
+  if FImageHandle = 0 then exit;
+
+  authorLength := GetEnhMetafileDescription(FImageHandle, 0, nil);
+  if authorLength <= 0 then exit;
+  SetLength(Result, authorLength);
+  GetEnhMetafileDescription(FImageHandle, authorLength, PChar(Result));
+  SetLength(Result, StrLen(PChar(Result)));
+end;
+
+function TMetafile.GetDescription: String;
+var
+  descLength: Integer;
+begin
+  Result := '';
+  if FImageHandle = 0 then Exit;
+
+  descLength := GetEnhMetafileDescription(FImageHandle, 0, nil);
+  if descLength <= 0 then exit;
+  SetLength(Result, descLength);
+  GetEnhMetafileDescription(FImageHandle, descLength, PChar(Result));
+  SetLength(Result, StrLen(PChar(Result)));
+end;
+
+function TMetafile.GetEmpty: Boolean;
+begin
+  Result := FImageHandle = 0;
+end;
+
+function TMetafile.GetHandle: HENHMETAFILE;
+begin
+  Result := FImageHandle;
+end;
+
+procedure TMetafile.SetHandle(AValue: HENHMETAFILE);
+var
+  emfHeader: TEnhMetaHeader;
+begin
+  if
+    (AValue <> 0) and
+    (GetEnhMetafileHeader(AValue, sizeof(emfHeader), @emfHeader) = 0)
+  then
+     raise EInvalidImage.Create('Invalid Metafile');;
+
+  if FImageHandle <> 0 then DeleteImage;
+
+  FImageHandle := AValue;
+  FImagePxWidth := 0;
+  FImagePxHeight := 0;
+  FMMWidth := emfHeader.rclFrame.Right - emfHeader.rclFrame.Left;
+  FMMHeight := emfHeader.rclFrame.Bottom - emfHeader.rclFrame.Top;
+end;
+
+
+procedure TMetafile.SetMMHeight(AValue: Integer);
+begin
+  FImagePxHeight := 0;
+  if FMMHeight <> AValue then FMMHeight := AValue;
+end;
+
+procedure TMetafile.SetMMWidth(AValue: Integer);
+begin
+  FImagePxWidth := 0;
+  if FMMWidth <> AValue then FMMWidth := AValue;
+end;
+
+procedure TMetafile.SetTransparent(AValue: Boolean);
+begin
+  if AValue then
+    raise EComponentError.Create('Not implemented');
+end;
+
+procedure TMetafile.Draw(ACanvas: TCanvas; const ARect: TRect);
+var
+  r: TRect;
+begin
+  if FImageHandle = 0 then exit;
+  r := ARect;
+  PlayEnhMetaFile(ACanvas.Handle, FImageHandle, r);
+end;
+
+function TMetafile.GetHeight: Integer;
+var
+  emfHeader: TEnhMetaHeader;
+begin
+  if FImageHandle = 0 then
+     exit(FImagePxHeight);
+  // convert 0.01mm units to device pixels
+  GetEnhMetaFileHeader(FImageHandle, Sizeof(emfHeader), @emfHeader);
+  Result := MulDiv(
+    FMMHeight, // metafile height in 0.01mm
+    emfHeader.szlDevice.cy,  // device height in pixels
+    emfHeader.szlMillimeters.cy * 100); // device height in mm
+end;
+
+function TMetafile.GetTransparent: Boolean;
+begin
+  Result := false;
+end;
+
+function TMetafile.GetWidth: Integer;
+var
+  emfHeader: TEnhMetaHeader;
+begin
+  if FImageHandle = 0 then
+    exit(FImagePxWidth);
+  // convert 0.01mm units to device pixels
+  GetEnhMetaFileHeader(FImageHandle, Sizeof(emfHeader), @emfHeader);
+  Result := MulDiv(
+    FMMWidth, // metafile width in 0.01mm
+    emfHeader.szlDevice.cx, // device width in pixels
+    emfHeader.szlMillimeters.cx * 100); // device width in 0.01mm
+end;
+
+
+procedure TMetafile.SetHeight(AValue: Integer);
+var
+  emfHeader: TEnhMetaHeader;
+begin
+  if FImageHandle = 0 then
+    FImagePxHeight := AValue
+  else begin // convert device pixels to 0.01mm units
+    GetEnhMetaFileHeader(FImageHandle, Sizeof(emfHeader), @emfHeader);
+    MMHeight := MulDiv(AValue, // metafile height in pixels
+      emfHeader.szlMillimeters.cy * 100, // device height in 0.01mm
+      emfHeader.szlDevice.cy); // device height in pixels
+  end;
+end;
+
+procedure TMetafile.SetWidth(AValue: Integer);
+var
+  emfHeader: TEnhMetaHeader;
+begin
+  if FImageHandle = 0 then
+    FImagePxWidth := AValue
+  else begin // convert device pixels to 0.01mm units
+    GetEnhMetaFileHeader(FImageHandle, Sizeof(emfHeader), @emfHeader);
+    MMWidth := MulDiv(AValue, // metafile width in pixels
+      emfHeader.szlMillimeters.cx * 100, // device width in mm
+      emfHeader.szlDevice.cx); // device width in pixels
+  end;
+end;
+
+constructor TMetafile.Create;
+begin
+  inherited Create;
+  FImageHandle := 0;
+end;
+
+destructor TMetafile.Destroy;
+begin
+  DeleteImage;
+  inherited Destroy;
+end;
+
+procedure TMetafile.Assign(ASource: TPersistent);
+begin
+  if (ASource = nil) or (ASource is TMetafile) then begin
+    if FImageHandle <> 0 then
+      DeleteImage;
+    if Assigned(ASource) then begin
+      FImageHandle := TMetafile(ASource).Handle;
+      FMMWidth := TMetafile(ASource).MMWidth;
+      FMMHeight := TMetafile(ASource).MMHeight;
+      FImagePxWidth := TMetafile(ASource).Width;
+      FImagePxHeight := TMetafile(ASource).Height;
+    end
+  end
+  else
+    inherited Assign(ASource);
+end;
+
+procedure TMetafile.Clear;
+begin
+  DeleteImage;
+end;
+
+procedure TMetafile.LoadFromFile(const AFileName: String);
+begin
+  Unused(AFileName);
+  raise EComponentError.Create('Not Implemented');
+end;
+
+procedure TMetafile.SaveToFile(const AFileName: String);
+var
+  outFile: HENHMETAFILE;
+begin
+  if FImageHandle = 0 then exit;
+  outFile := CopyEnhMetaFile(FImageHandle, PChar(AFileName));
+  if outFile = 0 then
+    RaiseLastWin32Error;
+  DeleteEnhMetaFile(outFile);
+end;
+
+procedure TMetafile.LoadFromStream(AStream: TStream);
+begin
+  Unused(AStream);
+  raise EComponentError.Create('Not Implemented');
+end;
+
+procedure TMetafile.SaveToStream(AStream: TStream);
+begin
+  Unused(AStream);
+  raise EComponentError.Create('Not Implemented');
+end;
+
+function TMetafile.ReleaseHandle: HENHMETAFILE;
+begin
+  DeleteImage;
+  Result := FImageHandle;
+  FImageHandle := 0;
+end;
+
+{ TMetafileCanvas }
+
+constructor TMetafileCanvas.Create(AMetafile: TMetafile; AReferenceDevice: HDC);
+begin
+  CreateWithComment(
+    AMetafile, AReferenceDevice, AMetafile.CreatedBy, AMetafile.Description);
+end;
+
+constructor TMetafileCanvas.CreateWithComment(
+  AMetafile: TMetafile; AReferenceDevice: HDC;
+  const ACreatedBy, ADescription: String);
+var
+  refDC: HDC;
+  r: TRect;
+  temp: HDC;
+  p: PChar;
+  w, h: Integer;
+begin
+  inherited Create;
+  FMetafile := AMetafile;
+
+  refDC := AReferenceDevice;
+  if refDC = 0 then
+    refDC := GetDC(0);
+
+  try
+    if FMetafile.MMWidth = 0 then begin
+      w := GetDeviceCaps(refDC, HORZSIZE) * 100;
+      if FMetafile.Width = 0 then // if no width get refDC width
+        FMetafile.MMWidth := w
+      else // else convert
+        FMetafile.MMWidth := MulDiv(
+          FMetafile.Width, w, GetDeviceCaps(refDC, HORZRES));
+    end;
+
+    if FMetafile.MMHeight = 0 then begin
+      h := GetDeviceCaps(refDC, VERTSIZE) * 100;
+      if FMetafile.Height = 0 then // if no height get refDC height
+        FMetafile.MMHeight := h
+      else // else convert
+        FMetafile.MMHeight := MulDiv(
+          FMetafile.Height, h, GetDeviceCaps(refDC, VERTRES));
+    end;
+
+    r := Rect(0, 0, FMetafile.MMWidth, FMetafile.MMHeight);
+    // lpDescription stores both author and description
+    if (Length(ACreatedBy) > 0) or (Length(ADescription) > 0) then
+      p := PChar(ACreatedBy+#0+ADescription+#0#0)
+    else
+      p := nil;
+    temp := CreateEnhMetafile(refDC, nil, @r, p);
+    if temp = 0 then
+      raise EOutOfResources.Create('Out of Resources');;
+    Handle := temp;
+  finally
+    if AReferenceDevice = 0 then
+      ReleaseDC(0, refDC);
+  end;
+end;
+
+destructor TMetafileCanvas.Destroy;
+begin
+  FMetafile.Handle := CloseEnhMetafile(Handle);
+  inherited Destroy;
+end;
+
+
+end.
+