paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 01:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@15829 -
This commit is contained in:
sekelsenmat 2010-08-16 15:00:54 +00:00
parent 2c71cbfe3a
commit d66b8c7068
9 changed files with 389 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -2373,6 +2373,11 @@ packages/fpmkunit/fpmake.pp svneol=native#text/plain
packages/fpmkunit/src/fpmkunit.pp svneol=native#text/plain packages/fpmkunit/src/fpmkunit.pp svneol=native#text/plain
packages/fpvectorial/Makefile svneol=native#text/plain packages/fpvectorial/Makefile svneol=native#text/plain
packages/fpvectorial/Makefile.fpc svneol=native#text/plain packages/fpvectorial/Makefile.fpc svneol=native#text/plain
packages/fpvectorial/examples/fpce_mainform.lfm svneol=native#text/plain
packages/fpvectorial/examples/fpce_mainform.pas svneol=native#text/plain
packages/fpvectorial/examples/fpcorelexplorer.ico -text
packages/fpvectorial/examples/fpcorelexplorer.lpi svneol=native#text/plain
packages/fpvectorial/examples/fpcorelexplorer.lpr svneol=native#text/plain
packages/fpvectorial/examples/fpvc_mainform.lfm svneol=native#text/plain packages/fpvectorial/examples/fpvc_mainform.lfm svneol=native#text/plain
packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
packages/fpvectorial/examples/fpvectorialconverter.ico -text packages/fpvectorial/examples/fpvectorialconverter.ico -text

54
packages/fpvectorial/examples/fpce_mainform.lfm Normal file
View File

@ -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

85
packages/fpvectorial/examples/fpce_mainform.pas Normal file
View File

@ -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.

BIN
packages/fpvectorial/examples/fpcorelexplorer.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

91
packages/fpvectorial/examples/fpcorelexplorer.lpi Normal file
View File

@ -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>

20
packages/fpvectorial/examples/fpcorelexplorer.lpr Normal file
View File

@ -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.

2
packages/fpvectorial/examples/fpvc_mainform.lfm
View File

@ -17,7 +17,7 @@ object formVectorialConverter: TformVectorialConverter
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 8 Left = 11
Height = 96 Height = 96
Top = 8 Top = 8
Width = 224 Width = 224

127
packages/fpvectorial/src/cdrvectorialreader.pas
View File

@ -28,23 +28,150 @@ uses
type 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 }
TvCDRVectorialReader = class(TvCustomVectorialReader) TvCDRVectorialReader = class(TvCustomVectorialReader)
private
procedure ReadVersionChunk(AStream: TStream; var AData: TCDRChunk);
function AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
public public
{ General reading methods } { General reading methods }
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override; 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; end;
implementation implementation
{ TvPDFVectorialReader } { 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; procedure TvCDRVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument); AData: TvVectorialDocument);
begin begin
end; 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 initialization
RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR); RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR);

6
packages/fpvectorial/src/fpvectorial.pas
View File

@ -90,6 +90,7 @@ type
procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat); procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat); procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
class function GetFormatFromExtension(AFileName: string): TvVectorialFormat; class function GetFormatFromExtension(AFileName: string): TvVectorialFormat;
function GetDetailedFileFormat(): string;
{ Data reading methods } { Data reading methods }
function GetPath(ANum: Cardinal): TPath; function GetPath(ANum: Cardinal): TPath;
function GetPathCount: Integer; function GetPathCount: Integer;
@ -548,6 +549,11 @@ begin
raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.'); raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.');
end; end;
function TvVectorialDocument.GetDetailedFileFormat(): string;
begin
end;
function TvVectorialDocument.GetPath(ANum: Cardinal): TPath; function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
begin begin
if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds'); if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');