unit frxDrawingView;
{$I SGDXF.inc}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Menus, ExtDlgs,
  Controls, Forms, Variants, Dialogs, Printers,
  sgConsts, DXFConv, CADImage, DXF
  {$IFNDEF sgDXFONLY}
  ,DWG, HPGL2, CGM, SVG, DWF
  {$ENDIF}
  ,frxClass, frxDsgnIntf, frxDesgnEditors, frxEditPicture;


type
  TsgScaleFactor = (
      sfScaleToFit,
      sf1,// 1;
      sf1_2,//1 / 2;
      sf1_4,//1 / 4;
      sf1_8,//1 / 8;
      sf1_10,//1 / 10;
      sf1_16,//1 / 16;
      sf1_20,//1 / 20;
      sf1_30,//1 / 30;
      sf1_40,//1 / 40;
      sf1_50,//1 / 50;
      sf1_100,//1 / 100;
      sf1_200,//1 / 200;
      sf1_500,//1 / 500;
      sf1_1000,//1 / 1000;
      sf1_5000,//1 / 5000;
      sf1_10000,//1 / 10000;
      sf1_50000,//1 / 50000;
      sf2,//2;
      sf4,//4;
      sf8,//8;
      sf10,//10;
      sf100,//100;
      sfUseScaleFactor);

  TfrxPictureProperty = class(TfrxClassProperty)
  private
    FComponent: TPersistent;
    FPictureEditForm: frxEditPicture.TfrxPictureEditorForm;
    FPictureChange: TNotifyEvent;
    procedure OpenClick(Sender: TObject);
    procedure PictureChange(Sender: TObject);
    function GetComponent: TPersistent;
  public
    function Edit: Boolean; override;
    function GetAttributes: TfrxPropertyAttributes; override;
    function GetValue: string; override;
    property Component: TPersistent read GetComponent;
  end;

  TfrxScaleProperty = class(TfrxEnumProperty)
  public
    constructor Create(Designer: TfrxCustomDesigner); override;
    destructor Destroy; override;
    function GetAttributes: TfrxPropertyAttributes; override;
    procedure GetValues; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  TfrxDrawingViewEditor = class(TfrxComponentEditor)
  public
    function Edit: Boolean; override;
    function HasEditor: Boolean; override;
    function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
    procedure GetMenuItems; override;
  end;

  TfrxDrawingView = class(TfrxView)
  private
    FDrawMode: Byte;
    FScale: TsgScaleFactor;
    FScaleFactor: Double;
    FPicture: TPicture;
    FStretch: Boolean;
    FCenter: Boolean;
    FKeepAspectRatio: Boolean;
    procedure SetScale(const Value: TsgScaleFactor);
    procedure SetScaleFactor(const Value: Double);
    procedure SetDrawMode(const Value: Byte);
    procedure SetPicture(const Value: TPicture);
    procedure FillBuff(const ADataSet: TfrxDataSet);
    procedure SetStretch(const Value: Boolean);
    procedure SetCenter(const Value: Boolean);
    procedure SetKeepAspectRatio(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
    class function GetDescription: string; override;
    procedure GetData; override;
  published
    property Center: Boolean read FCenter write SetCenter default False;
    property Color;
    property BrushStyle;
    property DataField;
    property DataSet;
    property DataSetName;
    property DrawMode: Byte read FDrawMode write SetDrawMode;
    property Frame;
    property KeepAspectRatio: Boolean read FKeepAspectRatio write SetKeepAspectRatio;
    property Picture: TPicture read FPicture write SetPicture;
    property Scale: TsgScaleFactor read FScale write SetScale;
    property ScaleFactor: Double read FScaleFactor write SetScaleFactor;
    property Stretch: Boolean read FStretch write SetStretch default False;
  end;

  function GetCADClassByContent(Source: TStream): TsgCADImageClass;

implementation

var
  Scales: TStringList = nil;

function GetCADClassByContent(Source: TStream): TsgCADImageClass;
var
  vPos: Integer;
  vBuf: array[0 .. 4095] of AnsiChar;
  I, vBytesRead: Integer;
  vDXFLines: TStringList;
  vFind: Boolean;
{$IFDEF SGDEL_2009}
  vEnc: TEncoding;
  vBytes: TBytes;
  S: string;
{$ENDIF}

  {$IFNDEF sgDXFONLY}
  function IsDWG(const S: AnsiString): Boolean;
  var
    vVer: TsgDWGVersion;
  begin
    IsDWG := GetDWGVersion(S, vVer) = 0;
  end;

  function IsDWF(const S: PAnsiChar): Boolean;
  const
    cnstDWF = $46574428; //'(DWF'
    cnstW2D = $44325728; //'(W2D'
    cnst_V = $5620; //' V';
  begin
    Result := ((PCardinal(S)^ = cnstDWF) or (PCardinal(S)^ = cnstW2D)) and
      (PWord(TsgNativeUInt(S) + 4)^ = cnst_V);
  end;

  function IsCGM(const S: PAnsiChar): Boolean;
  const
    cnstCGMStrHeader = $4D474542; //'BEGM'
  var
    vHeader: Cardinal;
  begin
    if S[0] = #0 then
      Result := Byte(S[1]) and $20 <> 0
    else
      Result := (PCardinal(S)^ and $DFDFDFDF = cnstCGMStrHeader) and // appercase
        (PByte(TsgNativeUInt(S) + 4)^ and $DF = $46); //'F'
  end;
  {$ENDIF}

begin
  Result := nil;
  if Source.Size > 0 then
  begin
    vPos := Source.Position;
    try
      Source.Position := 0;
      vDXFLines := TStringList.Create;
      try
        vDXFLines.LoadFromStream(Source);
        I := 0;
        vFind := False;
        if vDXFLines.Count > 0 then
          repeat
            vFind := Trim(vDXFLines.Strings[I]) = '0';
            Inc(I);
          until (I >= vDXFLines.Count) or vFind;
        if vFind then
          if Trim(vDXFLines.Strings[I]) = 'SECTION' then
            Result := TsgCADdxfImage;
      finally
        vDXFLines.Free;
      end;
      {$IFNDEF sgDXFONLY}
      if not Assigned(Result) then
      begin
        Source.Position := 0;
        vBytesRead := Source.Read(vBuf, SizeOf(vBuf));
        if IsDWF(vBuf)then
          Result := TsgDWFImage
        else
        if IsDWG(vBuf)then
          Result := TsgDWGImage
        else
        if IsCGM(vBuf) then
          Result := TsgCGMImage
        else
        begin
{$IFDEF SGDEL_2009}
          SetLength(vBytes, 16);
          Move(vBuf[0], vBytes[0], 16);
          vEnc := nil;
          TEncoding.GetBufferEncoding(vBytes, vEnc);
          try
            if Assigned(vEnc) then
            begin
              S := vEnc.GetString(vBytes);
              if S[1] = '<' then
                Result := TsgSVGImage
            end;
          finally
            if not TEncoding.IsStandardEncoding(vEnc) then
              vEnc.Free;
          end;
{$ELSE}
          if (vBuf[0] = '<') then
            Result := TsgSVGImage;
{$ENDIF}
          if not Assigned(Result) then
          begin
            repeat
              I := 0;
              repeat
                vFind := vBuf[I] <> #0;
                Inc(I);
              until (I >= vBytesRead) or vFind;
              if not vFind then
                vBytesRead := Source.Read(vBuf, SizeOf(vBuf))
              else
                Dec(I);
            Until (Source.Position >= Source.Size) or vFind;
            if vFind then
            begin
              if (vBuf[I] = #27) or (vBuf[I] = ';') or
                ((vBuf[I] = 'P') and (vBuf[I+1] = 'A')) or
                ((vBuf[I] = 'B') and (vBuf[I+1] = 'E')) or
                ((vBuf[I] = 'S') and (vBuf[I+1] = 'P')) or
                ((vBuf[I] = 'I') and (vBuf[I+1] = 'N')) or
                ((vBuf[I] = 'B') and (vBuf[I+1] = 'P')) or
                ((vBuf[I] = 'D') and (vBuf[I+1] = 'F')) or
                ((vBuf[I] = 'I') and (vBuf[I+1] = 'P')) then
                Result := TsgHPGLImage;
            end;
          end;
        end;
      end;
      {$ENDIF}
    finally
      Source.Position := vPos;
    end;
  end;
end;

{ TfrxDrawingView }

constructor TfrxDrawingView.Create(AOwner: TComponent);
begin
  FScale := sfScaleToFit;
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  Color := clWindow;
end;

destructor TfrxDrawingView.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TfrxDrawingView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  r: TRect;
  kx, ky: Double;
  Bmp: TBitmap;
  vScaleFactor: Double;
  vNullWidth: Integer;
  //vRgn: HRGN;
  vDrawMode: TsgDXFDrawMode;
  vDstRect: TRect;
  DC: HDC;
  vSaveDC: Integer;
  mmToPixelX, mmToPixelY: Double;
  PicW, PicH: Double;

  procedure DoProportional;
  begin
    if KeepAspectRatio then
    begin
      kx := FDX / PicW;
      ky := FDY / PicH;
      if kx < ky then
        r := Rect(FX, FY, FX1, FY + Round(PicH * kx))
      else
        r := Rect(FX, FY, FX + Round(PicW * ky), FY1);
    end;
  end;

  procedure DoCenter;
  begin
    if Center then
      OffsetRect(r, Round((FDX - (r.Right - r.Left)) / 2), Round((FDY - (r.Bottom - r.Top)) / 2));
  end;

begin
  DC := Canvas.Handle;
  vSaveDC := SaveDC(DC);
  try
    BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
    DrawBackground;
    Canvas.Brush.Color := Color;
    Canvas.Brush.Style := BrushStyle;
    r := Classes.Rect(FX, FY, FX1, FY1);
    vDstRect := r;
    if ((Picture.Graphic = nil) or Picture.Graphic.Empty) then
    begin
      Canvas.Font.Name := 'Arial';
      Canvas.Font.Size := 8;
      Canvas.Font.Style := [];
      Canvas.Font.Color := clBlack;
  {$IFNDEF Delphi2}
      Canvas.Font.Charset := DEFAULT_CHARSET;
  {$ENDIF}
      Bmp := TBitmap.Create;
      try
        Bmp.Handle := LoadBitmap(hInstance, 'ButtonIcon');
        Canvas.Draw(FX, FY, Bmp);
      finally
        Bmp.Free;
      end;
    end
    else if not ((Picture.Graphic = nil) or Picture.Graphic.Empty) then
    begin
      vDrawMode := dmNormal;
      vNullWidth := 0;
      if Picture.Graphic is TsgCADImage then
      begin
        vDrawMode := TsgCADImage(Picture.Graphic).DrawMode;
        case DrawMode of
          0: TsgCADImage(Picture.Graphic).DrawMode := dmNormal;
          1: TsgCADImage(Picture.Graphic).DrawMode := dmBlack;
          2: TsgCADImage(Picture.Graphic).DrawMode := dmGray;
        end;
        if IsPrinting then
        begin
          vNullWidth := TsgCADImage(Picture.Graphic).NullWidth;
          TsgCADImage(Picture.Graphic).NullWidth := 3;
        end;
      end;
      mmToPixelX := GetDeviceCaps(DC, HORZSIZE) / GetDeviceCaps(DC, HORZRES);
      mmToPixelY := GetDeviceCaps(DC, VERTSIZE) / GetDeviceCaps(DC, VERTRES);
      if Picture.Graphic is TsgCADImage then
      begin
        PicW := (TsgCADImage(Picture.Graphic).Extents.Right - TsgCADImage(Picture.Graphic).Extents.Left) / mmToPixelX;
        PicH := (TsgCADImage(Picture.Graphic).Extents.Top - TsgCADImage(Picture.Graphic).Extents.Bottom) / mmToPixelY;
      end
      else
      begin
        PicW := Picture.Width;
        PicH := Picture.Height;
      end;
      try
        if not Stretch then
        begin
          vScaleFactor := 1;
          case Scale of
            sf1: vScaleFactor := 1;
            sf1_2: vScaleFactor := 1 / 2;
            sf1_4: vScaleFactor := 1 / 4;
            sf1_8: vScaleFactor := 1 / 8;
            sf1_10: vScaleFactor := 1 / 10;
            sf1_16: vScaleFactor := 1 / 16;
            sf1_20: vScaleFactor := 1 / 20;
            sf1_30: vScaleFactor := 1 / 30;
            sf1_40: vScaleFactor := 1 / 40;
            sf1_50: vScaleFactor := 1 / 50;
            sf1_100: vScaleFactor := 1 / 100;
            sf1_200: vScaleFactor := 1 / 200;
            sf1_500: vScaleFactor := 1 / 500;
            sf1_1000: vScaleFactor := 1 / 1000;
            sf1_5000: vScaleFactor := 1 / 5000;
            sf1_10000: vScaleFactor := 1 / 10000;
            sf1_50000: vScaleFactor := 1 / 50000;
            sf2: vScaleFactor := 2;
            sf4: vScaleFactor := 4;
            sf8: vScaleFactor := 8;
            sf10: vScaleFactor := 10;
            sf100: vScaleFactor := 100;
            sfUseScaleFactor: vScaleFactor := ScaleFactor;
          end;
          if vScaleFactor = 0 then
            vScaleFactor := 1;
          DoProportional;
          if Scale <> sfScaleToFit then
          begin
            r.Right := r.Left + Round(vScaleFactor * PicW);
            r.Bottom := r.Top + Round(vScaleFactor * PicH);
          end;
        end
        else
          DoProportional;
        DoCenter;
        IntersectClipRect(DC, vDstRect.Left, vDstRect.Top, vDstRect.Right, vDstRect.Bottom);
        //vRgn := CreateRectRgn(vDstRect.Left, vDstRect.Top, vDstRect.Right, vDstRect.Bottom);
        try
          //SelectClipRgn(Canvas.Handle, vRgn);
          try
            Canvas.StretchDraw(r, Picture.Graphic);
          finally
            //SelectClipRgn(Canvas.Handle, 0);
          end;
        finally
          //DeleteObject(vRgn);
        end;
      finally
        if Picture.Graphic is TsgCADImage then
        begin
          TsgCADImage(Picture.Graphic).DrawMode := vDrawMode;
          if IsPrinting then
            TsgCADImage(Picture.Graphic).NullWidth := vNullWidth;
        end;
      end;
    end;
  finally
    RestoreDC(DC, vSaveDC);
    DrawFrame;
  end;
end;

class function TfrxDrawingView.GetDescription: string;
begin
  Result := 'CAD Picture';
end;

procedure TfrxDrawingView.SetScale(const Value: TsgScaleFactor);
begin
  FScale := Value;
end;

procedure TfrxDrawingView.SetScaleFactor(const Value: Double);
begin
  FScaleFactor := Value;
end;

procedure TfrxDrawingView.SetDrawMode(const Value: Byte);
begin
  FDrawMode := Value;
end;

procedure TfrxDrawingView.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TfrxDrawingView then
  begin
    FDrawMode := TfrxDrawingView(Source).FDrawMode;
    FScale := TfrxDrawingView(Source).FScale;
    FScaleFactor := TfrxDrawingView(Source).FScaleFactor;
    FKeepAspectRatio := TfrxDrawingView(Source).FKeepAspectRatio;
  end;
end;

procedure TfrxDrawingView.GetData;
begin
  if Assigned(DataSet) then
    FillBuff(DataSet);
  if not (Picture.Graphic is TsgCADImage) then
    inherited GetData;
end;

procedure TfrxDrawingView.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TfrxDrawingView.FillBuff(const ADataSet: TfrxDataSet);
var
  vClass: TsgCADImageClass;
  vGr: TsgCADImage;
  vPicView: TfrxPictureView;
  vBuff: TMemoryStream;
begin
  vBuff := TMemoryStream.Create;
  try
    ADataSet.AssignBlobTo(DataField, vBuff);
    vClass := GetCADClassByContent(vBuff);
    if Assigned(vClass) then
    begin
      vGr := vClass.Create;
      try
        vGr.LoadFromStream(vBuff);
        Picture.Graphic := vGr;
      finally
        vGr.Free;
      end;
    end
    else
    begin
      vPicView := TfrxPictureView.Create(Self);
      try
        vPicView.LoadPictureFromStream(vBuff);
        Picture.Graphic := vPicView.Picture.Graphic;
        vBuff.Position := 0;
      finally
        vPicView.Free;
      end;
    end;
  finally
    vBuff.Free;
  end;
end;

procedure TfrxDrawingView.SetStretch(const Value: Boolean);
begin
  FStretch := Value;
end;

procedure TfrxDrawingView.SetCenter(const Value: Boolean);
begin
  FCenter := Value;
end;

procedure TfrxDrawingView.SetKeepAspectRatio(const Value: Boolean);
begin
  FKeepAspectRatio := Value;
end;

{ TfrxScaleProperty }

constructor TfrxScaleProperty.Create(Designer: TfrxCustomDesigner);
begin
  inherited;
  GetValues;
end;

destructor TfrxScaleProperty.Destroy;
begin
  inherited Destroy;
end;

function TfrxScaleProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paReadOnly];
end;

function TfrxScaleProperty.GetValue: string;
begin
  Result := Values[Ord(TfrxDrawingView(Component).Scale)];
end;

procedure TfrxScaleProperty.GetValues;
begin
  Values.Assign(Scales);
end;

procedure TfrxScaleProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  I := Values.IndexOf(Value);
  TfrxDrawingView(Component).Scale := TsgScaleFactor(I);
end;

{ TfrxPictureProperty }

function TfrxPictureProperty.Edit: Boolean;
begin
  FPictureEditForm := TfrxPictureEditorForm.Create(Application);
  try
    FPictureEditForm.LoadB.OnClick := OpenClick;
    FPictureEditForm.Image.Stretch := True;
    FPictureEditForm.Image.Proportional := True;
    FPictureEditForm.Image.Picture := TfrxDrawingView(Component).Picture;
    FPictureChange := FPictureEditForm.Image.Picture.OnChange;
    FPictureEditForm.Image.Picture.OnChange := PictureChange;
    Result := FPictureEditForm.ShowModal = mrOk;
    if Result then
      TfrxDrawingView(Component).Picture := FPictureEditForm.Image.Picture;
  finally
    FPictureEditForm.Free;
    FPictureEditForm := nil;
  end;
end;

function TfrxPictureProperty.GetAttributes: TfrxPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paDialog];
end;

function TfrxPictureProperty.GetComponent: TPersistent;
begin
  Result := FComponent;
  if not Assigned(Result) then
    Result := inherited Component;
end;

function TfrxPictureProperty.GetValue: string;
begin
  if TfrxDrawingView(Component).Picture.Graphic <> nil then
    Result := '(' + TfrxDrawingView(Component).Picture.Graphic.ClassName + ')'
  else
    Result := '(Not assigned)';
end;

procedure TfrxPictureProperty.OpenClick(Sender: TObject);
var
  OpenPictureDialog: TOpenPictureDialog;
begin
  OpenPictureDialog := TOpenPictureDialog.Create(Application);
  try
    if OpenPictureDialog.Execute then
      FPictureEditForm.Image.Picture.LoadFromFile(OpenPictureDialog.FileName);
  finally
    OpenPictureDialog.Free;
  end;
end;

procedure TfrxPictureProperty.PictureChange(Sender: TObject);
begin
  if Assigned(FPictureChange) then
    FPictureChange(FPictureEditForm.Image.Picture);
  if Assigned(FPictureEditForm.Image.Picture.Graphic) then
      FPictureEditForm.StatusBar.SimpleText := IntToStr(FPictureEditForm.Image.Picture.Width) + ' x ' +
        IntToStr(FPictureEditForm.Image.Picture.Height)
  else
    FPictureEditForm.StatusBar.SimpleText := 'Empty'
end;

{ TfrxDrawingViewEditor }

function TfrxDrawingViewEditor.Edit: Boolean;
var
  vPicProp: TfrxPictureProperty;
begin
  vPicProp := TfrxPictureProperty.Create(Component.Report.Designer);
  try
    vPicProp.FComponent := Component;
    Result := vPicProp.Edit;
  finally
    vPicProp.Free;
  end;
end;

function TfrxDrawingViewEditor.Execute(Tag: Integer;
  Checked: Boolean): Boolean;
begin
  Result := True;
  case Tag of
    1: TfrxDrawingView(Component).Center := Checked;
    2: TfrxDrawingView(Component).KeepAspectRatio := Checked;
    3: TfrxDrawingView(Component).Stretch := Checked;
    5..7: TfrxDrawingView(Component).DrawMode := Tag - 5;
  end;
end;

procedure TfrxDrawingViewEditor.GetMenuItems;
begin
  AddItem('Center', 1, TfrxDrawingView(Component).Center);
  AddItem('KeepAspectRatio', 2, TfrxDrawingView(Component).KeepAspectRatio);
  AddItem('Stretch', 3, TfrxDrawingView(Component).Stretch);
  AddItem('-', 4, False);
  AddItem('Normal', 5, TfrxDrawingView(Component).DrawMode = 0);
  AddItem('Black', 6, TfrxDrawingView(Component).DrawMode = 1);
  AddItem('Gray', 7, TfrxDrawingView(Component).DrawMode = 2);
end;

function TfrxDrawingViewEditor.HasEditor: Boolean;
begin
  Result := True;
end;

initialization

  Scales := TStringList.Create;
  Scales.AddObject('Scale to fit', Pointer(-1));
  Scales.AddObject('1:1', Pointer(1));
  Scales.AddObject('1:2', Pointer(-2));
  Scales.AddObject('1:4', Pointer(-4));
  Scales.AddObject('1:8', Pointer(-8));
  Scales.AddObject('1:10', Pointer(-10));
  Scales.AddObject('1:16', Pointer(-16));
  Scales.AddObject('1:20', Pointer(-20));
  Scales.AddObject('1:30', Pointer(-30));
  Scales.AddObject('1:40', Pointer(-40));
  Scales.AddObject('1:50', Pointer(-50));
  Scales.AddObject('1:100', Pointer(-100));
  Scales.AddObject('1:200', Pointer(-200));
  Scales.AddObject('1:500', Pointer(-500));
  Scales.AddObject('1:1000', Pointer(-1000));
  Scales.AddObject('1:5000', Pointer(-5000));
  Scales.AddObject('1:10000', Pointer(-10000));
  Scales.AddObject('1:50000', Pointer(-50000));
  Scales.AddObject('2:1', Pointer(2));
  Scales.AddObject('4:1', Pointer(4));
  Scales.AddObject('8:1', Pointer(8));
  Scales.AddObject('10:1', Pointer(10));
  Scales.AddObject('100:1', Pointer(100));
  Scales.AddObject('Use ScaleFactor', Pointer(0));

finalization

  Scales.Free;


end.
