Adds a Corel Draw file format explorer and starts implementing the CDR reader in fpvectorial

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15829 3ad0048d-3df7-0310-abae-a5850022a9f2

8 files changed, 384 insertions, 1 deletions

diff --git a/packages/fpvectorial/examples/fpce_mainform.lfm b/packages/fpvectorial/examples/fpce_mainform.lfm
new file mode 100644
index 0000000000..41608aa372
--- /dev/null
+++ b/packages/fpvectorial/examples/fpce_mainform.lfm
@@ -0,0 +1,54 @@
+object formCorelExplorer: TformCorelExplorer
+  Left = 216
+  Height = 345
+  Top = 192
+  Width = 466
+  Caption = 'FP Corel Explorer'
+  ClientHeight = 345
+  ClientWidth = 466
+  LCLVersion = '0.9.29'
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 40
+    Width = 123
+    Caption = 'Location of the Input file:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 8
+    Height = 32
+    Top = 8
+    Width = 224
+    AutoSize = False
+    Caption = 'This application helps us explore the internal structure of Corel Draw files (*.cdr).'
+    ParentColor = False
+    WordWrap = True
+  end
+  object shellInput: TShellTreeView
+    Left = 8
+    Height = 272
+    Top = 64
+    Width = 224
+    FileSortType = fstFoldersFirst
+    TabOrder = 0
+    OnSelectionChanged = shellInputSelectionChanged
+    ObjectTypes = [otFolders, otNonFolders]
+  end
+  object labelFilename: TLabel
+    Left = 256
+    Height = 14
+    Top = 65
+    Width = 47
+    Caption = 'Filename:'
+    ParentColor = False
+  end
+  object labelVersion: TLabel
+    Left = 256
+    Height = 14
+    Top = 88
+    Width = 40
+    Caption = 'Version:'
+    ParentColor = False
+  end
+end
diff --git a/packages/fpvectorial/examples/fpce_mainform.pas b/packages/fpvectorial/examples/fpce_mainform.pas
new file mode 100644
index 0000000000..6df6d1f120
--- /dev/null
+++ b/packages/fpvectorial/examples/fpce_mainform.pas
@@ -0,0 +1,85 @@
+unit fpce_mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  EditBtn, ExtCtrls, ComCtrls, ShellCtrls;
+
+type
+
+  { TformCorelExplorer }
+
+  TformCorelExplorer = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    labelVersion: TLabel;
+    labelFilename: TLabel;
+    shellInput: TShellTreeView;
+    procedure buttonQuitClick(Sender: TObject);
+    procedure shellInputSelectionChanged(Sender: TObject);
+  private
+    { private declarations }
+    function CheckInput(): Boolean;
+  public
+    { public declarations }
+  end; 
+
+var
+  formCorelExplorer: TformCorelExplorer;
+
+implementation
+
+uses
+  fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
+  fpvtocanvas;
+
+{$R *.lfm}
+
+{ TformCorelExplorer }
+
+procedure TformCorelExplorer.buttonQuitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TformCorelExplorer.shellInputSelectionChanged(Sender: TObject);
+var
+  Vec: TvVectorialDocument;
+  Reader: TvCDRVectorialReader;
+  lFormat: TvVectorialFormat;
+  lChunk, lCurChunk: TCDRChunk;
+  Str: string;
+begin
+  // First check the in input
+  if not CheckInput() then Exit;
+
+  // Now read the data from the input file
+  Reader := TvCDRVectorialReader.Create;
+  try
+    Reader.ExploreFromFile(shellInput.GetSelectedNodePath(), lChunk);
+
+    labelFilename.Caption := 'Filename: ' + shellInput.GetSelectedNodePath();
+    if (lChunk.ChildChunks <> nil) and (lChunk.ChildChunks.First <> nil) then
+    begin
+      lCurChunk := TCDRChunk(lChunk.ChildChunks.First);
+      Str := TCDRChunkVRSN(lCurChunk).VersionStr;
+      labelVersion.Caption := 'Version: ' + Str;
+    end;
+  finally
+    Reader.Free;
+  end;
+end;
+
+function TformCorelExplorer.CheckInput(): Boolean;
+var
+  lPath: String;
+begin
+  lPath := shellInput.GetSelectedNodePath();
+  Result := (ExtractFileExt(lPath) = STR_CORELDRAW_EXTENSION);
+end;
+
+end.
+
diff --git a/packages/fpvectorial/examples/fpcorelexplorer.ico b/packages/fpvectorial/examples/fpcorelexplorer.ico
new file mode 100644
index 0000000000..0341321b5d
--- /dev/null
+++ b/packages/fpvectorial/examples/fpcorelexplorer.ico
diff --git a/packages/fpvectorial/examples/fpcorelexplorer.lpi b/packages/fpvectorial/examples/fpcorelexplorer.lpi
new file mode 100644
index 0000000000..384cea7d41
--- /dev/null
+++ b/packages/fpvectorial/examples/fpcorelexplorer.lpi
@@ -0,0 +1,91 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <AlwaysBuild Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="fpcorelexplorer"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="fpcorelexplorer.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcorelexplorer"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fpce_mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="formCorelExplorer"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="fpce_mainform"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="fpcorelexplorer"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="4">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+      <Item4>
+        <Name Value="EConvertError"/>
+      </Item4>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fpvectorial/examples/fpcorelexplorer.lpr b/packages/fpvectorial/examples/fpcorelexplorer.lpr
new file mode 100644
index 0000000000..0ae0fc957f
--- /dev/null
+++ b/packages/fpvectorial/examples/fpcorelexplorer.lpr
@@ -0,0 +1,20 @@
+program fpcorelexplorer;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, fpce_mainform
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TformCorelExplorer, formCorelExplorer);
+  Application.Run;
+end.
+
diff --git a/packages/fpvectorial/examples/fpvc_mainform.lfm b/packages/fpvectorial/examples/fpvc_mainform.lfm
index b388483bc5..7e9613739d 100644
--- a/packages/fpvectorial/examples/fpvc_mainform.lfm
+++ b/packages/fpvectorial/examples/fpvc_mainform.lfm
@@ -17,7 +17,7 @@ object formVectorialConverter: TformVectorialConverter
     ParentColor = False
   end
   object Label2: TLabel
-    Left = 8
+    Left = 11
     Height = 96
     Top = 8
     Width = 224
diff --git a/packages/fpvectorial/src/cdrvectorialreader.pas b/packages/fpvectorial/src/cdrvectorialreader.pas
index ab8d0fb325..d438dc0bba 100644
--- a/packages/fpvectorial/src/cdrvectorialreader.pas
+++ b/packages/fpvectorial/src/cdrvectorialreader.pas
@@ -28,23 +28,150 @@ uses
 
 type
 
+  TCDRChunk = class
+    Name: array[0..3] of Char;
+    Size: Cardinal;
+    ChildChunks: TFPList;
+  end;
+
+  TCDRChunkClass = class of TCDRChunk;
+
+  TvCDRInternalData = TCDRChunk;
+
+  TCDRChunkVRSN = class(TCDRChunk)
+    VersionStr: string;
+    VersionNum: Integer;
+  end;
+
   { TvCDRVectorialReader }
 
   TvCDRVectorialReader = class(TvCustomVectorialReader)
+  private
+    procedure ReadVersionChunk(AStream: TStream; var AData: TCDRChunk);
+    function AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
   public
     { General reading methods }
     procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
+    { File format exploring methods }
+    procedure ExploreFromFile(AFilename: string; out AData: TvCDRInternalData);
+    procedure ExploreFromStream(AStream: TStream; out AData: TvCDRInternalData);
   end;
 
 implementation
 
 { TvPDFVectorialReader }
 
+procedure TvCDRVectorialReader.ReadVersionChunk(AStream: TStream;
+  var AData: TCDRChunk);
+var
+  lDWord: DWord;
+  lChunk: TCDRChunkVRSN absolute AData;
+  lVerBytes: array[0..1] of Byte;
+begin
+  // Read the Chunk name
+  lDWord := AStream.ReadDWord();
+
+  // Read the Chunk size
+  lDWord := AStream.ReadDWord();
+
+  // Read the version
+  AStream.Read(lVerBytes, 2);
+
+  if (lVerBytes[0] = $BC) and (lVerBytes[1] = $02) then
+  begin
+    lChunk.VersionNum := 7;
+    lChunk.VersionStr := 'CorelDraw 7';
+  end
+  else if (lVerBytes[0] = $20) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 8;
+    lChunk.VersionStr := 'CorelDraw 8';
+  end
+  else if (lVerBytes[0] = $21) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 8;
+    lChunk.VersionStr := 'CorelDraw 8bidi';
+  end
+  else if (lVerBytes[0] = $84) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 9;
+    lChunk.VersionStr := 'CorelDraw 9';
+  end
+  else if (lVerBytes[0] = $E8) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 10;
+    lChunk.VersionStr := 'CorelDraw 10';
+  end
+  else if (lVerBytes[0] = $4C) and (lVerBytes[1] = $04) then
+  begin
+    lChunk.VersionNum := 11;
+    lChunk.VersionStr := 'CorelDraw 11';
+  end
+  else if (lVerBytes[0] = $B0) and (lVerBytes[1] = $04) then
+  begin
+    lChunk.VersionNum := 12;
+    lChunk.VersionStr := 'CorelDraw 12';
+  end
+  else if (lVerBytes[0] = $14) and (lVerBytes[1] = $05) then
+  begin
+    lChunk.VersionNum := 13;
+    lChunk.VersionStr := 'CorelDraw X3';
+  end;
+end;
+
+function TvCDRVectorialReader.AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
+begin
+  if AData.ChildChunks = nil then AData.ChildChunks := TFPList.Create;
+
+  Result := AClass.Create;
+
+  AData.ChildChunks.Add(Result);
+end;
+
 procedure TvCDRVectorialReader.ReadFromStream(AStream: TStream;
   AData: TvVectorialDocument);
 begin
 end;
 
+procedure TvCDRVectorialReader.ExploreFromFile(AFilename: string;
+  out AData: TvCDRInternalData);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
+  try
+    ExploreFromStream(FileStream, AData);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TvCDRVectorialReader.ExploreFromStream(AStream: TStream;
+  out AData: TvCDRInternalData);
+var
+  lRIFF: array[0..3] of Char;
+  lDocSize, lDWord: Cardinal;
+  lChild: TCDRChunk;
+begin
+  // Create the data object
+  AData := TCDRChunk.Create;
+
+  // All CorelDraw files starts with "RIFF"
+  AStream.Read(lRIFF, 4);
+  if lRIFF <> 'RIFF' then
+    raise Exception.Create('[TvCDRVectorialReader.ExploreFromStream] The Corel Draw RIFF file marker wasn''t found.');
+
+  // And then 4 bytes for the document size
+  lDocSize := AStream.ReadDWord();
+
+  // And mroe 4 bytes of other stuff
+  lDWord := AStream.ReadDWord();
+
+  // Now comes the version
+  lChild := AddNewChunk(AData, TCDRChunkVRSN);
+  ReadVersionChunk(AStream, lChild);
+end;
+
 initialization
 
   RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR);
diff --git a/packages/fpvectorial/src/fpvectorial.pas b/packages/fpvectorial/src/fpvectorial.pas
index a89843b6ff..39f3991e0d 100644
--- a/packages/fpvectorial/src/fpvectorial.pas
+++ b/packages/fpvectorial/src/fpvectorial.pas
@@ -90,6 +90,7 @@ type
     procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
     procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
     class function GetFormatFromExtension(AFileName: string): TvVectorialFormat;
+    function  GetDetailedFileFormat(): string;
     { Data reading methods }
     function  GetPath(ANum: Cardinal): TPath;
     function  GetPathCount: Integer;
@@ -548,6 +549,11 @@ begin
     raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.');
 end;
 
+function  TvVectorialDocument.GetDetailedFileFormat(): string;
+begin
+
+end;
+
 function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
 begin
   if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');