summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGraeme Geldenhuys <graemeg@gmail.com>2015-09-02 23:25:41 +0100
committerGraeme Geldenhuys <graemeg@gmail.com>2015-09-02 23:25:41 +0100
commitb0a9f3d90d7a8127ba41ab77a7054d797e816c83 (patch)
treeb11cdae78c316a7b728522e9a4bfb43880fad8f5
parentdb31f06d5e7adf28fad60e36fd9e5d2cf0519e84 (diff)
parentf52bde1cd49d0d01002e8b684909268b723a3edb (diff)
downloadfpGUI-master.tar.xz
Merge branch 'fixes_1.4'HEADmaster
-rw-r--r--docs/fpc_lang_ref.ipf2
-rw-r--r--docs/manifest.xml4
-rw-r--r--docs/release_process.txt3
-rw-r--r--docview/TODO.txt8
-rw-r--r--docview/components/richtext/CanvasFontManager.pas10
-rw-r--r--docview/components/richtext/RichTextDisplayUnit.pas9
-rw-r--r--docview/components/richtext/RichTextLayoutUnit.pas9
-rw-r--r--docview/components/richtext/RichTextView.pas4
-rw-r--r--docview/src/HelpBitmap.pas64
-rw-r--r--docview/src/HelpTopic.pas3
-rw-r--r--docview/src/IPFFileFormatUnit.pas4
-rw-r--r--docview/src/docview.rc8
-rw-r--r--docview/src/docview_clean.prj381
-rw-r--r--docview/src/frm_main.pas3
-rw-r--r--docview/src/lzwdecompress.pas55
-rw-r--r--examples/corelib/aggcanvas/agg_canvas_test.lpr2
-rw-r--r--examples/corelib/canvastest/fpgcanvas.lpr6
-rw-r--r--examples/gui/colorwheel/frm_main.pas252
-rw-r--r--examples/gui/dbtest/frm_main.pas50
-rw-r--r--examples/gui/tabtest/tabtest.lpr10
-rw-r--r--extras/lazarus_ide/fpgui_ide.lpk24
-rw-r--r--extras/lazarus_ide/fpguilazideintf.pas191
-rw-r--r--extras/lazarus_ide/regfpguitestrunner.pas2
-rw-r--r--languages/fpgui.af.po16
-rw-r--r--languages/fpgui.de.po16
-rw-r--r--languages/fpgui.en.po16
-rw-r--r--languages/fpgui.es.po16
-rw-r--r--languages/fpgui.fr.po66
-rw-r--r--languages/fpgui.it.po16
-rw-r--r--languages/fpgui.po16
-rw-r--r--languages/fpgui.pt.po16
-rw-r--r--languages/fpgui.ru.po16
-rw-r--r--src/VERSION_FILE.inc2
-rw-r--r--src/build.bat2
-rwxr-xr-xsrc/build.sh2
-rw-r--r--src/build_wince.bat22
-rw-r--r--src/corelib/fpg_base.pas2
-rw-r--r--src/corelib/fpg_imgfmt_png.pas6
-rw-r--r--src/corelib/fpg_main.pas2
-rw-r--r--src/corelib/gdi/fpg_gdi.pas45
-rw-r--r--src/corelib/gdi/fpgui_toolkit.lpk4
-rw-r--r--src/corelib/gdi/fpgui_toolkit.pas26
-rw-r--r--src/corelib/lang_af.inc4
-rw-r--r--src/corelib/lang_de.inc4
-rw-r--r--src/corelib/lang_en.inc4
-rw-r--r--src/corelib/lang_es.inc4
-rw-r--r--src/corelib/lang_fr.inc48
-rw-r--r--src/corelib/lang_it.inc4
-rw-r--r--src/corelib/lang_pt.inc4
-rw-r--r--src/corelib/lang_ru.inc4
-rw-r--r--src/corelib/render/software/Agg2D.pas8
-rw-r--r--src/corelib/render/software/agg_color.pas3
-rw-r--r--src/corelib/render/software/agg_scanline_storage_aa.pas3
-rw-r--r--src/corelib/render/software/fpg_fontcache.pas1
-rw-r--r--src/corelib/x11/fpg_netlayer_x11.pas2
-rw-r--r--src/corelib/x11/fpg_x11.pas3
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk3
-rw-r--r--src/gui/fpg_basegrid.pas4
-rw-r--r--src/gui/fpg_checkbox.pas1
-rw-r--r--src/gui/fpg_colormapping.pas2
-rw-r--r--src/gui/fpg_dialogs.pas25
-rw-r--r--src/gui/fpg_edit.pas5
-rw-r--r--src/gui/fpg_editcombo.pas6
-rw-r--r--src/gui/fpg_iniutils.pas4
-rw-r--r--src/gui/fpg_listbox.pas2
-rw-r--r--src/gui/fpg_memo.pas14
-rw-r--r--src/gui/fpg_menu.pas1
-rw-r--r--src/gui/fpg_scrollbar.pas2
-rw-r--r--src/gui/fpg_scrollframe.pas3
-rw-r--r--src/gui/fpg_spinedit.pas103
-rw-r--r--src/gui/fpg_tab.pas150
-rw-r--r--src/gui/fpg_trackbar.pas4
-rw-r--r--src/gui/messagedialog.inc1
-rw-r--r--src/gui/selectdirdialog.inc1
-rw-r--r--src/reportengine/u_command.pas2
-rw-r--r--src/reportengine/u_pdf.pas1293
-rw-r--r--src/reportengine/u_report.pas6
77 files changed, 2049 insertions, 1090 deletions
diff --git a/docs/fpc_lang_ref.ipf b/docs/fpc_lang_ref.ipf
index 366edb3e..cfef8813 100644
--- a/docs/fpc_lang_ref.ipf
+++ b/docs/fpc_lang_ref.ipf
@@ -4991,7 +4991,7 @@ for the class. Note that
:li.When the class is instantiated, the default value is not automatically
applied to the property, it is the responsability of the programmer to do
this in the constructor of the class.
-:li.The value 2147483648 cannot be used as a default value, as it is used
+:li.The value 2,147,483,648 cannot be used as a default value, as it is used
internally to denote 'nodefault'.
:li.It is not possible to specify a default for array properties.
:eol.
diff --git a/docs/manifest.xml b/docs/manifest.xml
index d0abae93..c1810300 100644
--- a/docs/manifest.xml
+++ b/docs/manifest.xml
@@ -1,8 +1,8 @@
<?xml version="1.0"?>
<packages>
<package name="fpgui">
- <version major="1" minor="4" micro="0" build="0"/>
- <filename>fpgui-1.4.0-0.zip</filename>
+ <version major="1" minor="4" micro="1" build="0"/>
+ <filename>fpgui-1.4.1-0.zip</filename>
<author>Graeme Geldenhuys</author>
<license>Modified LGPL</license>
<email>graemeg@gmail.com</email>
diff --git a/docs/release_process.txt b/docs/release_process.txt
index a97e0b8a..309535ec 100644
--- a/docs/release_process.txt
+++ b/docs/release_process.txt
@@ -48,3 +48,6 @@ Release notification
5. Update Wikipedia (English and Afrikaans)
6. Update FPC's wiki about fpGUI
+
+7. Post message to fpGUI newsgroup
+
diff --git a/docview/TODO.txt b/docview/TODO.txt
index d0cccc7c..2307e115 100644
--- a/docview/TODO.txt
+++ b/docview/TODO.txt
@@ -13,11 +13,11 @@ Todo list
[o] - Implement a ipfdump program. Already started work on this and is called
docdump in the src directory.
[ ] - Implement a IPF Compiler in Object Pascal
-[ ] - Text is not selectable in RichTextView. I imagine people want to
+[o] - Text is not selectable in RichTextView. I imagine people want to
copy & paste examples. Although "Save current Topic" already exists.
[ ] - Communication between application and docview. Both directions. Possible
solutions is Pipes or IPC unit.
-[ ] - Implement popup window for "notes" hyperlinks. eg: The hyper link text
+[o] - Implement popup window for "notes" hyperlinks. eg: The hyper link text
might be 'IBM', the "notes" link should then show a popup window (almost
like a tooltip window) showing 'International Business Machines'.
[ ] - RichTextView component issue. Incompatible with original OS/2 VIEW. When
@@ -57,8 +57,8 @@ Todo list
fpdoc IPF todo list
===================
-[ ] - Class declaration in overview page is missing. Like HTML output.
-[ ] - Class inheritance tree must be shown in overview page. Like HTML output.
+[x] - Class declaration in overview page is missing. Like HTML output.
+[x] - Class inheritance tree must be shown in overview page. Like HTML output.
[ ] -
[ ] -
[ ] -
diff --git a/docview/components/richtext/CanvasFontManager.pas b/docview/components/richtext/CanvasFontManager.pas
index e650141b..fe9606e6 100644
--- a/docview/components/richtext/CanvasFontManager.pas
+++ b/docview/components/richtext/CanvasFontManager.pas
@@ -44,6 +44,7 @@ type
constructor Create(ACanvas: TfpgCanvas; AWidget: TfpgWidget); reintroduce;
destructor Destroy; override;
function AverageCharWidth: longint;
+ function CharAscender: longint;
function CharDescender: longint;
function CharHeight: longint;
function CharWidth( const C: TfpgChar ): longint; // Retrieve the width of the given char, in the current font
@@ -179,8 +180,8 @@ begin
AFontDesc := AFontDesc + ':Strikeout';
if faUnderScore in Attrs Then
- if Pos(':Underscore', AFontDesc) = 0 then
- AFontDesc := AFontDesc + ':Underscore';
+ if Pos(':Underline', AFontDesc) = 0 then
+ AFontDesc := AFontDesc + ':Underline';
end;
// Provide font name substitutes for some common bitmap fonts found in INF files
@@ -314,6 +315,11 @@ begin
Result := FCanvas.Font.TextWidth('c');
end;
+function TCanvasFontManager.CharAscender: longint;
+begin
+ Result := FCanvas.Font.Ascent;
+end;
+
function TCanvasFontManager.MaximumCharWidth: longint;
begin
Result := FCanvas.Font.TextWidth('W');
diff --git a/docview/components/richtext/RichTextDisplayUnit.pas b/docview/components/richtext/RichTextDisplayUnit.pas
index 482a587b..cfdd20a7 100644
--- a/docview/components/richtext/RichTextDisplayUnit.pas
+++ b/docview/components/richtext/RichTextDisplayUnit.pas
@@ -122,6 +122,7 @@ Procedure DrawRichTextLine( var FontManager: TCanvasFontManager;
Line: TLayoutLine; Start: TPoint );
var
X, Y: longint;
+ YBaseLine: longint;
Element: TTextElement;
StartedDrawing: boolean;
Style: TTextDrawStyle;
@@ -180,7 +181,7 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
TextBlockStart := P;
- Y := Start.Y; // + Line.MaxDescender; // co-ordinates are from top/left, so do we need descender? [Graeme]
+ YBaseLine := Start.Y + Line.MaxAscender;
while P < EndP do
begin
@@ -209,6 +210,7 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
StartedDrawing := true;
end;
+ Y := YBaseLine - FontManager.CharAscender;
// Now do the drawing
if Element.ElementType = teImage then
begin
@@ -263,9 +265,10 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>');
and ( faItalic in Style.FontAttributes )
and ( not FontManager.IsFixed )
then
+ begin
// end of italic; add a space
- inc( X, FontManager.CharWidth( ' ' ) );
-
+// inc( X, FontManager.CharWidth( ' ' ) );
+ end;
Layout.PerformStyleTag( Element.Tag, Style, X );
NewMarginX := ( Start.X + Style.LeftMargin );
if NewMarginX > X then
diff --git a/docview/components/richtext/RichTextLayoutUnit.pas b/docview/components/richtext/RichTextLayoutUnit.pas
index 606b7805..8e39d65f 100644
--- a/docview/components/richtext/RichTextLayoutUnit.pas
+++ b/docview/components/richtext/RichTextLayoutUnit.pas
@@ -23,6 +23,7 @@ Type
Length: longint;
Height: longint;
Width: longint;
+ MaxAscender: longint;
MaxDescender: longint;
MaxTextHeight: longint; // maximum height of text, doesn't include images
LinkIndex: longint; // link index at start of line, if any
@@ -136,7 +137,7 @@ uses
function TLayoutLineList.GetItem(Index: Integer): TLayoutLine;
begin
- inherited GetItem(Index);
+ result := TLayoutLine( inherited GetItem(Index));
end;
procedure TLayoutLineList.SetItem(Index: Integer; const AValue: TLayoutLine);
@@ -240,8 +241,10 @@ Procedure TRichTextLayout.CheckFontHeights( Var Line: TLayoutLine );
var
FontHeight: longint;
Descender: longint;
+ Ascender: longint;
begin
FontHeight := FFontManager.CharHeight;
+ Ascender := FFontManager.CharAscender;
Descender := FFontManager.CharDescender;
if FontHeight > Line.Height then
@@ -252,6 +255,9 @@ begin
if Descender > Line.MaxDescender then
Line.MaxDescender := Descender;
+
+ if Ascender > Line.MaxAscender then
+ Line.MaxAscender := Ascender;
end;
function TRichTextLayout.IsValidBitmapIndex( Index: longint ): boolean;
@@ -297,6 +303,7 @@ Var
CurrentLine := TLayoutLine.Create;
CurrentLine.Style := Style;
CurrentLine.Height := 0;
+ CurrentLine.MaxAscender := 0;
CurrentLine.MaxDescender := 0;
CurrentLine.MaxTextHeight := 0;
CurrentLine.Width := 0;
diff --git a/docview/components/richtext/RichTextView.pas b/docview/components/richtext/RichTextView.pas
index e890ca54..bc967d59 100644
--- a/docview/components/richtext/RichTextView.pas
+++ b/docview/components/richtext/RichTextView.pas
@@ -2414,9 +2414,13 @@ begin
// BufferLength );
end;
+// TODO: This doesn't seem to be used anywhere, so we could probably delete it.
function TRichTextView.CopyTextToBuffer( Buffer: PChar;
BufferLength: longint ): longint;
begin
+ Result := -1;
+ // TODO: we do this to trap code using this, so we can fix it accordingly.
+ raise Exception.Create('TRichTextView.CopyTextToBuffer was called, but it is not implemented yet.');
//Result := CopyPlainTextToBuffer( FText,
// FText + strlen( FText ),
// Buffer,
diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas
index 45855a1f..b5464cbf 100644
--- a/docview/src/HelpBitmap.pas
+++ b/docview/src/HelpBitmap.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -73,7 +73,7 @@ type
end;
- THelpBitmap = class( TfpgImage )
+ THelpBitmap = class(TfpgImage)
protected
_Header: INFBITMAPHEADER;
_PaletteColorCount: longint;
@@ -81,12 +81,12 @@ type
_BitsSize: longint;
FileHandle: TFileStream;
_UncompressedBlockSize: longint;
- function GetPaletteSize: longint;
- procedure BitmapError(Msg: string);
- procedure ReadBitmapData( Blocks: TList; TotalSize: longword);
+ function GetPaletteSize: longint;
+ procedure BitmapError(Msg: string);
+ procedure ReadBitmapData( Blocks: TList; TotalSize: longword);
public
- constructor CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longint);
- destructor Destroy; override;
+ constructor CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longword);
+ destructor Destroy; override;
end;
@@ -128,7 +128,7 @@ begin
inherited Destroy;
end;
-constructor THelpBitmap.CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longint);
+constructor THelpBitmap.CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longword);
var
WordsPerLine: longint;
LineSize: longint;
@@ -282,10 +282,14 @@ var
ptr: PByte;
i: integer;
img: TfpgImage;
+ {$IFDEF LZW_DEBUG}
+ s: TFileStream;
+ {$ENDIF}
begin
BitmapOutputPointer := nil;
BitmapData := nil;
ptr := nil;
+ lastOutByte := $0;
// Allocate memory to store the bitmap
BitmapData := GetMem( TotalSize );
@@ -309,6 +313,9 @@ begin
case Block._CompressionType of
0,1: // uncompressed (I'm not sure about 1)
begin
+ {$IFDEF LZW_DEBUG}
+ writeln('Uncompressed image type');
+ {$ENDIF}
MemCopy( Block._Data^, BitmapOutputPointer^, Block._Size );
BytesWrittenFromBlock := Block._Size;
inc( BytesWritten, BytesWrittenFromBlock );
@@ -316,6 +323,9 @@ begin
2: // LZW compression
begin
+ {$IFDEF LZW_DEBUG}
+ writeln('LZW compressed image type');
+ {$ENDIF}
LZWDecompressBlock( Block._Data,
Block._Size,
BitmapOutputPointer,
@@ -353,35 +363,25 @@ begin
> BitmapData + TotalSize ) then
assert( false );
-{ NOTE: This doesn't seem right. It moves the pointer so later the moving of data to
- ImageData will be wrong! }
-// inc( BitmapOutputPointer, BytesWrittenFromBlock ); TPersistentObjectState
+ inc( BitmapOutputPointer, BytesWrittenFromBlock );
end;
- i := TotalSize + SizeOf(_Header) + GetPaletteSize;
- img := CreateImage_BMP(BitmapData, i);
-
- AllocateImage(32, _Header.cx, _Header.cy);
-
{$IFDEF LZW_DEBUG}
- writeln('Width = ', Width);
- writeln('Height = ', Height);
- writeln('ImageDataSize = ', ImageDataSize);
- writeln('------------- START -------------');
- for i := 1 to ImageDataSize do
- begin
- write(HexStr(BitmapOutputPointer[i-1],2)+' ');
- if (i mod 16 = 0) then
- writeln('')
- else if (i mod 4 = 0) then
- write (' | ');
- end;
- Writeln('');
- writeln('------------- END -------------');
+ // write the decompressed image to a .BMP file to verify it is okay
+ s := TFileStream.Create(Format('/tmp/image_%d.bmp', [TotalSize]), fmCreate);
+ BitmapData[0] := Byte('B');
+ s.WriteBuffer(BitmapData^, TotalSize);
+ s.Destroy;
+ BitmapData[0] := Byte('b');
{$ENDIF}
-// Move(BitmapOutputPointer^, ImageData^, ImageDataSize);
- Move(img.ImageData^, self.ImageData^, img.ImageDataSize);
+ img := CreateImage_BMP(BitmapData, TotalSize);
+
+ FreeImage; // just as a precaution
+ AllocateImage(32, _Header.cx, _Header.cy);
+ // copy imagedata from the img instance to our THelpBitmap.ImageData
+ MemCopy(img.ImageData^, self.ImageData^, img.ImageDataSize);
+
UpdateImage;
img.Free;
diff --git a/docview/src/HelpTopic.pas b/docview/src/HelpTopic.pas
index 8b12b569..275ab775 100644
--- a/docview/src/HelpTopic.pas
+++ b/docview/src/HelpTopic.pas
@@ -1119,7 +1119,7 @@ begin
begin
CheckForAutoURL( AText, State );
// supposed to turn word wrap on, default font
- OutputString := {'<align left>}'</nowrap>'; // I guess...
+ OutputString := '</nowrap><align left>'; // I guess...
State.Alignment := itaLeft;
end;
@@ -1254,6 +1254,7 @@ begin
begin
result := true;
// supposed to turn word wrap on, default font
+ State.Alignment := itaLeft;
State.Spacing := true;
end;
end; // case escape code of...
diff --git a/docview/src/IPFFileFormatUnit.pas b/docview/src/IPFFileFormatUnit.pas
index 7d6aade7..aeeaa003 100644
--- a/docview/src/IPFFileFormatUnit.pas
+++ b/docview/src/IPFFileFormatUnit.pas
@@ -239,7 +239,7 @@ const
// FF XX
ecSetLeftMargin = $02;
- ecHighlight1 = $04; // hp1,2,3,5,6,7
+ ecHighlight1 = $04; // hp1,2,3,4,5,6,7
ecLinkStart = $05;
ecFootnoteLinkStart = $07;
ecLinkEnd = $08;
@@ -260,7 +260,7 @@ const
ecStartLinkByResourceID = $1d;
ecExternalLink = $1f;
- // Subescape codes of
+ // SubEscape codes of
HPART_DEFINE = 0;
HPART_PT_HDREF = 1;
HPART_PT_FNREF = 2;
diff --git a/docview/src/docview.rc b/docview/src/docview.rc
index 35c0ade5..95d3d914 100644
--- a/docview/src/docview.rc
+++ b/docview/src/docview.rc
@@ -1,8 +1,8 @@
MAINICON ICON "../images/docview-48x48.ico"
1 VERSIONINFO
-FILEVERSION 1, 4, 0, 0
-PRODUCTVERSION 1, 4, 0, 0
+FILEVERSION 1, 4, 1, 0
+PRODUCTVERSION 1, 4, 1, 0
FILEFLAGSMASK 0
FILEOS 0x40000
FILETYPE 1
@@ -13,12 +13,12 @@ FILETYPE 1
{
VALUE "CompanyName", "fpGUI Toolkit"
VALUE "FileDescription", "fpGUI's INF Documentation Viewer"
- VALUE "FileVersion", "1.4.0"
+ VALUE "FileVersion", "1.4.1"
VALUE "InternalName", "docview"
VALUE "LegalCopyright", "GNU Public License"
VALUE "OriginalFilename", "docview"
VALUE "ProductName", "fpGUI Toolkit"
- VALUE "ProductVersion", "1.4.0"
+ VALUE "ProductVersion", "1.4.1"
}
}
BLOCK "VarFileInfo"
diff --git a/docview/src/docview_clean.prj b/docview/src/docview_clean.prj
new file mode 100644
index 00000000..829ae97f
--- /dev/null
+++ b/docview/src/docview_clean.prj
@@ -0,0 +1,381 @@
+[projectoptions]
+mainfile=docview.lpr
+targetfile=${PROJECTNAME}${EXEEXT}
+messageoutputfile=
+makecommand=${COMPILER}
+makedir=
+unitdirs=8
+ ../components/richtext
+ ${FPTest}3rdparty/epiktimer/
+ ${FPTest}src/
+ ${FPGUI}/src
+ ${FPGUI}/src/corelib/gdi
+ ${FPGUI}/src/corelib/x11
+ ${FPGUI}/src/gui
+ ${FPGUI}/src/corelib
+unitpref=-Fu
+incpref=-Fi
+libpref=-Fl
+objpref=-Fo
+targpref=-o
+befcommand=0
+aftcommand=0
+makeoptions=6
+ -l -Mobjfpc -Sh
+ -gl -O-
+ -B
+ -O2 -XX -Xs -CX
+ -FUunits/${TargetCPU}-${TargetOS}/
+ -gh
+codetemplatedirs=1
+ ${TEMPLATEDIR}
+toolmenus=1
+ fpGUI &UI Designer
+toolfiles=1
+ ${FPGUI_DIR}/uidesigner/units/${TargetCPU}-${TargetOS}/uidesigner${EXEEXT}
+toolparams=1
+ ${CURSOURCEFILE}
+fontnames=0
+scriptbeforecopy=
+scriptaftercopy=
+newprojectfiles=4
+ ${TEMPLATEDIR}/fptest/program.pas
+ ${TEMPLATEDIR}fpgui/units/i386-linux/placeholder.txt
+ ${TEMPLATEDIR}fpgui/units/i386-win32/placeholder.txt
+ ${TEMPLATEDIR}fpgui/units/x86_64-linux/placeholder.txt
+newprojectfilesdest=4
+ ${%PROJECTNAME%}.pas
+ ${%PROJECTDIR%}units/i386-linux/placeholder.txt
+ ${%PROJECTDIR%}units/i386-win32/placeholder.txt
+ ${%PROJECTDIR%}units/x86_64-linux/placeholder.txt
+newfinames=3
+ Program
+ Test Unit
+ Textfile
+newfifilters=3
+ "*.pas" "*.pp"
+ "*.pas" "*.pp"
+
+newfiexts=3
+ pas
+ pas
+
+newfisources=3
+ ${TEMPLATEDIR}fptest/program.pas
+ ${TEMPLATEDIR}fptest/unit.pas
+
+newfonames=2
+ Mainform
+ Simple Form
+newfonamebases=2
+
+
+newfosources=2
+ ${TEMPLATEDIR}fpgui/mainform.pas
+ ${TEMPLATEDIR}fpgui/simpleform.pas
+newfoforms=2
+
+
+forcezorder=0
+stripmessageesc=0
+copymessages=0
+closemessages=0
+checkmethods=1
+colorerror=-1610612712
+colorwarning=-1610612717
+colornote=-1610612716
+usercolors=30
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+usercolorcomment=30
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+formatmacronames=0
+formatmacrovalues=0
+settingsfile=docview_clean.prj
+settingseditor=1
+settingsdebugger=1
+settingsstorage=1
+settingsprojecttree=0
+settingsautoload=0
+settingsautosave=0
+modulenames=0
+moduletypes=0
+modulefiles=0
+befcommandon=0
+makeoptionson=6
+ 63
+ 31
+ 34
+ 32
+ 63
+ 60
+aftcommandon=0
+unitdirson=8
+ 65599
+ 65599
+ 65599
+ 196671
+ 196640
+ 196639
+ 65581
+ 196647
+macroon=7
+ 9
+ 3
+ 6
+ 4
+ 8
+ 63
+ 63
+macronames=7
+ TargetCPU
+ TargetOS
+ TargetCPU
+ TargetOS
+ TargetOS
+ HelpPath
+ FPTest
+macrovalues=7
+ x86_64
+ linux
+ i386
+ win32
+ freebsd
+ /data/devel/FPC_Docs/inf/
+ /data/devel/fptest/
+macrogroup=3
+groupcomments=6
+ Linux 64-bit
+ Linux 32-bit
+ Windows 32-bit
+ FreeBSD 64-bit
+
+
+toolsave=1
+ -1
+toolhide=1
+ 0
+toolparse=1
+ 0
+toolmessages=1
+ 0
+fontalias=0
+fontancestors=0
+fontheights=0
+fontwidths=0
+fontoptions=0
+fontxscales=0
+expandprojectfilemacros=4
+ 1
+ -1
+ -1
+ -1
+loadprojectfile=4
+ 1
+ 0
+ 0
+ 0
+newinheritedforms=2
+ 0
+ 0
+uid=0
+sourcefilemasks=5
+ "*.pas" "*.dpr" "*.pp" "*.inc" "*.lpr"
+ "*.c" "*.cc" "*.h"
+ "*.mfm"
+ "*.ipf"
+ "*.sql"
+syntaxdeffiles=5
+ ${SYNTAXDEFDIR}pascal_dark.sdef
+ ${SYNTAXDEFDIR}cpp.sdef
+ ${SYNTAXDEFDIR}objecttext.sdef
+ ${SYNTAXDEFDIR}ipf2.sdef
+ ${SYNTAXDEFDIR}sql.sdef
+filemasknames=5
+ Source
+ Forms
+ Text
+ IPF help
+ All Files
+filemasks=5
+ "*.pp" "*.pas" "*.inc" "*.dpr" "*.lpr"
+ frm_*.pas
+ *.txt
+ *.ipf
+ *
+showgrid=1
+snaptogrid=1
+moveonfirstclick=1
+noformdesignerdocking=0
+gridsizex=8
+gridsizey=8
+autoindent=1
+blockindent=2
+linenumberson=1
+rightmarginon=1
+rightmarginchars=80
+scrollheight=0
+tabstops=2
+spacetabs=1
+showtabs=0
+tabindent=0
+editfontname=Raize
+editfontheight=16
+editfontwidth=0
+editfontextraspace=0
+editfontcolor=-1879048183
+editbkcolor=-1879048186
+statementcolor=14745599
+editfontantialiased=1
+editmarkbrackets=1
+backupfilecount=0
+encoding=0
+codetemplatedirs=1
+ ${TEMPLATEDIR}
+debugcommand=${DEBUGGER}
+debugoptions=
+debugtarget=
+runcommand=
+xtermcommand=xterm -S${PTSN}/${PTSH}
+remoteconnection=
+uploadcommand=
+gdbprocessor=x86_64
+gdbservercommand=
+gdbservercommandattach=
+beforeconnect=
+afterconnect=
+beforeload=
+afterload=
+beforerun=
+sourcebase=
+sourcedirs=16
+ ../components/richtext/
+ ${FPCDIR}src/rtl/${TargetCPU}/
+ ${FPCDIR}src/rtl/inc/
+ ${FPCDIR}src/rtl/linux/${TargetCPU}/
+ ${FPCDIR}src/rtl/linux/
+ ${FPCDIR}src/rtl/unix/
+ ${FPCDIR}src/rtl/objpas/sysutils/
+ ${FPCDIR}src/rtl/objpas/classes/
+ ${FPCDIR}src/rtl/objpas/
+ ${FPTest}/
+ ${tiOPF}Options/
+ ${tiOPF}Core/
+ ${FPGUI}/src/corelib/gdi/X/
+ ${FPGUI}/src/corelib/x11/
+ ${FPGUI}/src/*/
+ ./
+defines=0
+progparameters=/data/devel/fpgui/docview/docs/IPFREF_v4.INF
+progworkingdirectory=
+envvarnames=0
+envvarvalues=0
+defineson=0
+stoponexception=0
+valuehints=1
+activateonbreak=1
+raiseonbreak=1
+showconsole=1
+externalconsole=0
+settty=1
+gdbdownload=0
+downloadalways=0
+startupbkpt=0
+startupbkpton=0
+gdbsimulator=0
+gdbserverstartonce=0
+gdbloadtimeout=
+gdbserverwait=0
+nogdbserverexit=0
+gdbservertty=0
+exceptclassnames=1
+ EconvertError
+exceptignore=1
+ 0
+nodebugbeginend=0
+sigsettings=27
+ 1,1,T,F
+ 3,3,T,F
+ 4,4,T,F
+ 6,6,T,F
+ 7,7,T,F
+ 8,8,T,F
+ 9,9,T,F
+ 10,10,T,F
+ 11,11,T,F
+ 12,12,T,F
+ 13,13,T,F
+ 15,15,T,F
+ 16,16,T,F
+ 17,17,F,F
+ 18,18,T,F
+ 19,19,T,F
+ 20,20,T,F
+ 21,21,T,F
+ 22,22,T,F
+ 23,23,T,F
+ 24,24,T,F
+ 25,25,T,F
+ 26,26,T,F
+ 27,27,T,F
+ 28,28,T,F
+ 29,29,T,F
+ 30,30,T,F
+defaultmake=4
diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas
index 00a192ea..27f2c51a 100644
--- a/docview/src/frm_main.pas
+++ b/docview/src/frm_main.pas
@@ -306,7 +306,7 @@ const
procedure TMainForm.MainFormException(Sender: TObject; E: Exception);
begin
- TfpgMessageDialog.Critical('An unexpected error occurred.', E.Message);
+ fpgApplication.ShowException(E);
end;
procedure TMainForm.lbIndexKeyPress(Sender: TObject; var KeyCode: word;
@@ -1747,6 +1747,7 @@ begin
// Now load the various parts of the file(s)
// into the user interface
DisplayFiles( tmpHelpFiles, FirstContentsNode );
+ tmpHelpFiles.Free;
//if CmdLineParameters.getHelpManagerFlag then
// ShowLeftPanel := Settings.ShowLeftPanel_Help
diff --git a/docview/src/lzwdecompress.pas b/docview/src/lzwdecompress.pas
index 0ebba38c..6645890c 100644
--- a/docview/src/lzwdecompress.pas
+++ b/docview/src/lzwdecompress.pas
@@ -1,7 +1,8 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2001 - Aaron Lawrence (aaronl@consultant.com)
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -24,9 +25,9 @@ interface
uses
SysUtils, types;
-procedure LZWDecompressBlock( pbInput: pByte;
+procedure LZWDecompressBlock( pbInput: PByte;
number_bytes: LongWord;
- pbOutput: PBYTE;
+ pbOutput: PByte;
Var bytesOut: LongWord;
Var FinalCode: byte );
@@ -57,9 +58,9 @@ Implementation
* Variables renamed etc to make things clearer.
*/
*)
-// -- Stuff for LZW decompression -- */
+// -- Stuff for LZW decompression --
const INIT_BITS = 9;
-const MAX_BITS = 12; //PLF Tue 95-10-03 02:16:56*/
+const MAX_BITS = 12;
const HASHING_SHIFT = MAX_BITS - 8;
{if MAX_BITS == 15
@@ -140,9 +141,11 @@ begin
inc( pbInput );
end
else
- input_bit_buffer:= input_bit_buffer
- or
- ( longword( 0 ) shl ( 24 - input_bit_count ) );
+ input_bit_buffer := input_bit_buffer or longword($00);
+{ The C version of LZWDecompress uses only "or $00", so I'm assuming the code
+ below is not needed. Tested and I see no difference. }
+// or
+// ( longword( 0 ) shl ( 24 - input_bit_count ) );
inc( bytes_out );
inc( input_bit_count, 8 );
end;
@@ -153,7 +156,7 @@ begin
if bytes_out > bytes_to_read then
begin
- // flush static vars and quit */
+ // flush static vars and quit
bytes_out:= 0;
input_bit_count:= 0;
input_bit_buffer:= 0;
@@ -167,11 +170,7 @@ end;
// this takes one of the INF bitmap blocks
// and decompresses it using LZW algorithms.
-procedure LZWDecompressBlock( pbInput: pByte;
- number_bytes: LongWord;
- pbOutput: PBYTE;
- Var bytesOut: LongWord;
- Var FinalCode: byte );
+procedure LZWDecompressBlock(pbInput: PByte; number_bytes: LongWord; pbOutput: PByte; var bytesOut: LongWord; var FinalCode: byte);
var
nextAvailableCode: LongWord;
currentCode: LongWord;
@@ -196,40 +195,40 @@ begin
begin
if clear_flag then
begin
- clear_flag:= false;
- lastCode:= currentCode;
- character:= currentCode;
+ clear_flag := false;
+ lastCode := currentCode;
+ character := currentCode;
- pbOutput^:= currentCode;
+ pbOutput^ := currentCode;
inc( pbOutput );
- FinalCode:= currentCode;
+ FinalCode := currentCode;
inc( BytesOut );
end
else if currentCode = CLEAR_TABLE then
begin
- clear_flag:= true;
- nextAvailableCode:= FIRST_CODE;
- bitsPerCode:= INIT_BITS;
- maxDictionaryCode:= MaxValNBits( bitsPerCode );
+ clear_flag := true;
+ nextAvailableCode := FIRST_CODE;
+ bitsPerCode := INIT_BITS;
+ maxDictionaryCode := MaxValNBits( bitsPerCode );
end
else
begin
if currentCode >= nextAvailableCode then
begin
decode_stack[ 0 ]:= character;
- theString:= decode_string( Addr( decode_stack[ 1 ] ),
+ theString := decode_string( Addr( decode_stack[ 1 ] ),
lastCode );
end
else
- theString:= decode_string( Addr( decode_stack[ 0 ] ),
+ theString := decode_string( Addr( decode_stack[ 0 ] ),
currentCode );
- character:= longword( theString^ );
+ character := longword( theString^ );
while theString >= Addr( decode_stack[ 0 ] ) do
begin
- FinalCode:= theString^;
+ FinalCode := theString^;
- pbOutput^:= theString^;
+ pbOutput^ := theString^;
inc( pbOutput );
dec( TheString );
diff --git a/examples/corelib/aggcanvas/agg_canvas_test.lpr b/examples/corelib/aggcanvas/agg_canvas_test.lpr
index 3b3a75ef..a3bde27f 100644
--- a/examples/corelib/aggcanvas/agg_canvas_test.lpr
+++ b/examples/corelib/aggcanvas/agg_canvas_test.lpr
@@ -245,7 +245,7 @@ begin
// Testing basic style drawings
- Canvas.Font := fpgApplication.DefaultFont;
+ Canvas.Font := fpgStyle.DefaultFont;
Canvas.DrawString(320, 3, 'DrawButtonFace():');
r.SetRect(300, 20, 75, 25);
diff --git a/examples/corelib/canvastest/fpgcanvas.lpr b/examples/corelib/canvastest/fpgcanvas.lpr
index 9d0656e4..14c87a82 100644
--- a/examples/corelib/canvastest/fpgcanvas.lpr
+++ b/examples/corelib/canvastest/fpgcanvas.lpr
@@ -96,7 +96,7 @@ begin
// Testing Text and Fonts
y := 60;
Canvas.SetTextColor(clBlack);
- Canvas.DrawString(5, y, 'This text must be black and default font (' + fpgApplication.DefaultFont.FontDesc + ')');
+ Canvas.DrawString(5, y, 'This text must be black and default font (' + fpgStyle.DefaultFont.FontDesc + ')');
// red dot indicates top/left corner of where previous text was started
Canvas.Pixels[5,y] := clRed;
@@ -117,7 +117,7 @@ begin
// Testing basic style drawings
- Canvas.Font := fpgApplication.DefaultFont;
+ Canvas.Font := fpgStyle.DefaultFont;
Canvas.DrawString(320, 3, 'DrawButtonFace():');
r.SetRect(300, 20, 75, 25);
@@ -138,7 +138,7 @@ begin
Canvas.DrawString(45, y, 'DrawControlFrame():');
y := y + Canvas.Font.Height;
- Canvas.DrawControlFrame(5, y, 200, 23);
+ fpgStyle.DrawControlFrame(Canvas, 5, y, 200, 23);
// Testing Bitmap painting
diff --git a/examples/gui/colorwheel/frm_main.pas b/examples/gui/colorwheel/frm_main.pas
index 612ea6c1..1cde9cdf 100644
--- a/examples/gui/colorwheel/frm_main.pas
+++ b/examples/gui/colorwheel/frm_main.pas
@@ -7,7 +7,7 @@ interface
uses
SysUtils, Classes, fpg_base, fpg_main, fpg_widget,
fpg_edit, fpg_form, fpg_label, fpg_button,
- fpg_dialogs, fpg_menu, fpg_checkbox,
+ fpg_dialogs, fpg_menu, fpg_checkbox, fpg_listbox, fpg_combobox,
fpg_panel, fpg_ColorWheel, fpg_spinedit;
type
@@ -55,7 +55,11 @@ type
edR: TfpgSpinEdit;
edG: TfpgSpinEdit;
edB: TfpgSpinEdit;
+ Label10: TfpgLabel;
+ cbColors: TfpgComboBox;
+ lbColors: TfpgColorListBox;
lblHex: TfpgLabel;
+ eHex: TfpgEdit;
Label7: TfpgLabel;
Label8: TfpgLabel;
Bevel2: TfpgBevel;
@@ -76,6 +80,14 @@ type
procedure UpdateRGBComponents;
procedure ColorChanged(Sender: TObject);
procedure RGBChanged(Sender: TObject);
+ procedure RGBChanging;
+ procedure ConvertToInt(Value: string);
+ procedure eHexKeyChar(Sender: TObject; AChar: TfpgChar; var Consumed: boolean);
+ procedure eHexKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
+ var Consumed: boolean);
+ procedure PopulatePaletteColorCombo;
+ procedure cbColorsChange(Sender: TObject);
+ procedure lbColorsChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
procedure AfterCreate; override;
@@ -87,6 +99,52 @@ implementation
{@VFD_NEWFORM_IMPL}
+procedure TMainForm.ConvertToInt(Value: string);
+var
+ iRed, iGreen, iBlue: integer;
+ i, iTemp : integer;
+ HexVal: string;
+begin
+ for i:= 2 to 7 do
+ begin
+ HexVal:= Copy(Value,i,1);
+ case Uppercase(HexVal) of
+ 'F':
+ iTemp:= 15;
+ 'E':
+ iTemp:= 14;
+ 'D':
+ iTemp:= 13;
+ 'C':
+ iTemp:= 12;
+ 'B':
+ iTemp:= 11;
+ 'A':
+ iTemp:= 10
+ else
+ if (HexVal>= '0') and (HexVal<= '9') then
+ iTemp:= StrToInt(HexVal);
+ end;
+ case i of
+ 2:
+ iRed:= iTemp;
+ 3:
+ iRed:= iRed * 16 +iTemp;
+ 4:
+ iGreen:= iTemp;
+ 5:
+ iGreen:= iGreen * 16 +iTemp;
+ 6:
+ iBlue:= iTemp;
+ 7:
+ iBlue:= iBlue * 16 +iTemp;
+ end;
+ end;
+ edR.Value := iRed;
+ edG.Value := iGreen;
+ edB.Value := iBlue;
+end;
+
function ConvertToHexa(Value: Integer): string;
var
ValH,ValL: Integer;
@@ -188,6 +246,11 @@ begin
end;
procedure TMainForm.RGBChanged(Sender: TObject);
+begin
+ RGBChanging;
+end;
+
+procedure TMainForm.RGBChanging;
var
rgb: TRGBTriple;
c: TfpgColor;
@@ -199,7 +262,7 @@ begin
c := RGBTripleTofpgColor(rgb);
ColorWheel1.SetSelectedColor(c); // This will trigger ColorWheel and ValueBar OnChange event
FViaRGB := False;
- lblHex.Text:= 'Hex = '+ Hexa(rgb.Red,rgb.Green,rgb.Blue);
+ eHex.Text:= Hexa(rgb.Red,rgb.Green,rgb.Blue);
end;
constructor TMainForm.Create(AOwner: TComponent);
@@ -249,8 +312,8 @@ end;
procedure TMainForm.UpdateHSVComponents;
begin
edH.Text := IntToStr(ColorWheel1.Hue);
- edS.Text := FormatFloat('0.000', ColorWheel1.Saturation);
- edV.Text := FormatFloat('0.000', ValueBar1.Value);
+ edS.Text := FormatFloat('##0.0', ColorWheel1.Saturation * 100);
+ edV.Text := FormatFloat('##0.0', ValueBar1.Value * 100);
Bevel1.BackgroundColor := ValueBar1.SelectedColor;
end;
@@ -264,17 +327,78 @@ begin
edR.Value := rgb.Red;
edG.Value := rgb.Green;
edB.Value := rgb.Blue;
- lblHex.Text:= 'Hex = '+ Hexa(rgb.Red,rgb.Green,rgb.Blue);
+ eHex.Text:= Hexa(rgb.Red,rgb.Green,rgb.Blue);
+end;
+
+procedure TMainForm.eHexKeyChar(Sender: TObject; AChar: TfpgChar; var Consumed: boolean);
+begin
+if Length(eHex.Text)= 0 then
+begin
+ if AChar<> '$' then
+ Consumed:= True;
+end
+else
+ if ((AChar< '0') or (AChar> '9')) and ((AChar< 'A') or (AChar> 'F')) and ((AChar< 'a') or (AChar> 'f')) then
+ Consumed:= True;
+end;
+
+procedure TMainForm.eHexKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
+ var Consumed: boolean);
+begin
+ if ((KeyCode= KeyReturn) or (KeyCode= KeyPEnter)) and (Length(eHex.Text)= 7) then
+ begin
+ ConvertToInt(eHex.Text);
+ RGBChanging;
+ end;
+end;
+
+procedure TMainForm.PopulatePaletteColorCombo;
+begin
+ with cbColors do
+ begin
+ Items.Clear;
+ Items.Add('cpStandardColors');
+ Items.Add('cpSystemColors');
+ Items.Add('cpWebColors');
+ FocusItem := 0;
+ OnChange := @cbColorsChange;
+ end;
+end;
+
+procedure TMainForm.cbColorsChange(Sender: TObject);
+begin
+ if cbColors.Text = 'cpStandardColors' then
+ lbColors.ColorPalette := cpStandardColors
+ else if cbColors.Text = 'cpSystemColors' then
+ lbColors.ColorPalette := cpSystemColors
+ else
+ lbColors.ColorPalette := cpWebColors;
+end;
+
+procedure TMainForm.lbColorsChange(Sender: TObject);
+var
+ rgb: TRGBTriple;
+ c: TfpgColor;
+begin
+ c := lbColors.Color;
+ rgb := fpgColorToRGBTriple(c);
+ edR.Value := rgb.Red;
+ edG.Value := rgb.Green;
+ edB.Value := rgb.Blue;
+ eHex.Text:= Hexa(rgb.Red,rgb.Green,rgb.Blue);
+ ConvertToInt(eHex.Text);
+ RGBChanging;
end;
procedure TMainForm.AfterCreate;
begin
{@VFD_BODY_BEGIN: MainForm}
Name := 'MainForm';
- SetPosition(349, 242, 537, 411);
+ SetPosition(0, 0, 540, 420);
WindowTitle := 'ColorWheel test app';
Hint := '';
- WindowPosition := wpUser;
+ IconName := '';
+ WindowPosition := wpScreenCenter;
Button1 := TfpgButton.Create(self);
with Button1 do
@@ -294,14 +418,14 @@ begin
with ColorWheel1 do
begin
Name := 'ColorWheel1';
- SetPosition(20, 20, 272, 244);
+ SetPosition(12, 20, 272, 244);
end;
ValueBar1 := TfpgValueBar.Create(self);
with ValueBar1 do
begin
Name := 'ValueBar1';
- SetPosition(304, 20, 52, 244);
+ SetPosition(290, 20, 52, 244);
Value := 1;
OnChange := @ColorChanged;
end;
@@ -318,7 +442,7 @@ begin
with Label1 do
begin
Name := 'Label1';
- SetPosition(116, 284, 52, 18);
+ SetPosition(108, 284, 64, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
@@ -329,62 +453,68 @@ begin
with Label2 do
begin
Name := 'Label2';
- SetPosition(116, 316, 52, 18);
+ SetPosition(108, 312, 64, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
- Text := 'Sat';
+ Text := 'Saturation';
end;
Label3 := TfpgLabel.Create(self);
with Label3 do
begin
Name := 'Label3';
- SetPosition(116, 344, 52, 18);
+ SetPosition(108, 340, 64, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
- Text := 'Val';
+ Text := 'Brightness';
end;
edH := TfpgEdit.Create(self);
with edH do
begin
Name := 'edH';
- SetPosition(172, 280, 56, 26);
+ SetPosition(176, 280, 44, 24);
+ BackgroundColor := clWindowBackground;
+ ExtraHint := '';
+ FontDesc := '#Edit1';
+ Hint := '';
TabOrder := 8;
Text := '';
- FontDesc := '#Edit1';
- BackgroundColor := clWindowBackground;
end;
edS := TfpgEdit.Create(self);
with edS do
begin
Name := 'edS';
- SetPosition(172, 308, 56, 26);
+ SetPosition(176, 308, 44, 24);
+ BackgroundColor := clWindowBackground;
+ ExtraHint := '';
+ FontDesc := '#Edit1';
+ Hint := '';
TabOrder := 9;
Text := '';
- FontDesc := '#Edit1';
- BackgroundColor := clWindowBackground;
end;
edV := TfpgEdit.Create(self);
with edV do
begin
Name := 'edV';
- SetPosition(172, 336, 56, 26);
+ SetPosition(176, 336, 44, 24);
+ BackgroundColor := clWindowBackground;
+ ExtraHint := '';
+ FontDesc := '#Edit1';
+ Hint := '';
TabOrder := 10;
Text := '';
- FontDesc := '#Edit1';
- BackgroundColor := clWindowBackground;
end;
Label4 := TfpgLabel.Create(self);
with Label4 do
begin
Name := 'Label4';
- SetPosition(236, 284, 56, 18);
+ SetPosition(230, 284, 56, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
@@ -395,7 +525,7 @@ begin
with Label5 do
begin
Name := 'Label5';
- SetPosition(236, 316, 56, 18);
+ SetPosition(230, 312, 56, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
@@ -406,7 +536,7 @@ begin
with Label6 do
begin
Name := 'Label6';
- SetPosition(236, 344, 56, 18);
+ SetPosition(230, 340, 56, 16);
Alignment := taRightJustify;
FontDesc := '#Label1';
Hint := '';
@@ -417,12 +547,13 @@ begin
with edR do
begin
Name := 'edR';
- SetPosition(296, 280, 44, 26);
+ SetPosition(290, 280, 44, 24);
TabOrder := 13;
MinValue := 0;
MaxValue := 255;
Value := 255;
FontDesc := '#Edit1';
+ OnChange := @RGBChanged;
OnExit := @RGBChanged;
end;
@@ -430,12 +561,13 @@ begin
with edG do
begin
Name := 'edG';
- SetPosition(296, 308, 44, 26);
+ SetPosition(290, 308, 44, 24);
TabOrder := 14;
MinValue := 0;
MaxValue := 255;
Value := 255;
FontDesc := '#Edit1';
+ OnChange := @RGBChanged;
OnExit := @RGBChanged;
end;
@@ -443,25 +575,76 @@ begin
with edB do
begin
Name := 'edB';
- SetPosition(296, 336, 44, 26);
+ SetPosition(290, 336, 44, 24);
TabOrder := 15;
MinValue := 0;
MaxValue := 255;
Value := 255;
FontDesc := '#Edit1';
+ OnChange := @RGBChanged;
OnExit := @RGBChanged;
end;
+ Label10 := TfpgLabel.Create(self);
+ with Label10 do
+ begin
+ Name := 'Label10';
+ SetPosition(352, 100, 180, 16);
+ FontDesc := '#Label1';
+ Hint := '';
+ Text := 'Predefined Color Palettes';
+ end;
+
+ cbColors := TfpgComboBox.Create(self);
+ with cbColors do
+ begin
+ Name := 'cbColors';
+ SetPosition(352, 120, 180, 22);
+ ExtraHint := '';
+ FontDesc := '#List';
+ Hint := '';
+ FocusItem := -1;
+ TabOrder := 18;
+ end;
+
+ lbColors := TfpgColorListBox.Create(self);
+ with lbColors do
+ begin
+ Name := 'lbColors';
+ SetPosition(352, 150, 180, 160);
+ Color := TfpgColor($FF00FFFF);
+ FontDesc := '#List';
+ Hint := '';
+ TabOrder := 19;
+ ScrollbarPage := VisibleItems;
+ OnChange := @lbColorsChange;
+ end;
+
lblHex := TfpgLabel.Create(self);
with lblHex do
begin
Name := 'lblHex';
- SetPosition(380, 316, 120, 16);
+ SetPosition(375, 340, 120, 16);
FontDesc := '#Label2';
Hint := '';
Text := 'Hex = ';
end;
+ eHex := TfpgEdit.Create(self);
+ with eHex do
+ begin
+ Name := 'eHex';
+ SetPosition(420, 336, 65, 24);
+ ExtraHint := '';
+ FontDesc := '#Label2';
+ Hint := '';
+ TabOrder := 21;
+ Text := '';
+ MaxLength:= 7;
+ OnKeyChar:= @eHexKeyChar;
+ OnKeyPress:= @eHexKeyPress;
+ end;
+
Label7 := TfpgLabel.Create(self);
with Label7 do
begin
@@ -476,7 +659,7 @@ begin
with Label8 do
begin
Name := 'Label8';
- SetPosition(304, 3, 64, 16);
+ SetPosition(290, 3, 64, 16);
FontDesc := '#Label2';
Hint := '';
Text := 'ValueBar';
@@ -486,7 +669,7 @@ begin
with Bevel2 do
begin
Name := 'Bevel2';
- SetPosition(388, 8, 2, 260);
+ SetPosition(388, 8, 2, 80);
Hint := '';
Style := bsLowered;
end;
@@ -542,17 +725,18 @@ begin
chkContinuous := TfpgCheckBox.Create(self);
with chkContinuous do
begin
- Name := 'chkContinous';
+ Name := 'chkContinuous';
SetPosition(205, 375, 90, 19);
FontDesc := '#Label1';
Hint := '';
TabOrder := 25;
- Text := 'Continous';
+ Text := 'Continuous';
OnChange := @chkContinuousChanged;
end;
{@VFD_BODY_END: MainForm}
+ PopulatePaletteColorCombo;
// link the two components
ColorWheel1.ValueBar := ValueBar1;
// ColorWheel1.BackgroundColor := clFuchsia;
diff --git a/examples/gui/dbtest/frm_main.pas b/examples/gui/dbtest/frm_main.pas
index 70ca7964..2061f09e 100644
--- a/examples/gui/dbtest/frm_main.pas
+++ b/examples/gui/dbtest/frm_main.pas
@@ -7,7 +7,7 @@ interface
uses
SysUtils, Classes, fpg_main,
fpg_widget, fpg_form, fpg_label, fpg_button,
- fpg_listbox, fpg_panel, fpgui_db, db, dbf{, dbf_fields};
+ fpg_listbox, fpg_panel, fpgui_db, db, dbf, u_reportimages;
type
@@ -114,6 +114,7 @@ constructor TMainForm.Create(AOwner: TComponent);
// fields: TDbfFieldDefs;
begin
inherited Create(AOwner);
+ CreateReportImages;
DataSet := TDBF.Create(Self);
DataSet.TableName := 'test.dbf';
@@ -150,10 +151,11 @@ procedure TMainForm.AfterCreate;
begin
{@VFD_BODY_BEGIN: MainForm}
Name := 'MainForm';
- SetPosition(225, 208, 417, 315);
+ SetPosition(461, 212, 417, 315);
WindowTitle := 'fpGUI DB controls test';
- WindowPosition := wpScreenCenter;
- Sizeable := False;
+ Hint := '';
+ IconName := '';
+ WindowPosition := wpOneThirdDown;
btnQuit := TfpgButton.Create(self);
with btnQuit do
@@ -162,7 +164,9 @@ begin
SetPosition(332, 264, 75, 24);
Text := 'Quit';
FontDesc := '#Label1';
+ Hint := '';
ImageName := 'stdimg.quit';
+ TabOrder := 1;
OnClick := @btnQuitClicked;
end;
@@ -171,10 +175,11 @@ begin
begin
Name := 'btnFirst';
SetPosition(8, 264, 30, 24);
- Text := '<<';
+ Text := '';
FontDesc := '#Label1';
- ImageName := '';
Hint := 'First record';
+ ImageName := 'repimg.first';
+ TabOrder := 2;
OnClick := @btnFirstClick;
OnMouseEnter := @ButtonEnter;
OnMouseExit := @ButtonExit;
@@ -185,10 +190,11 @@ begin
begin
Name := 'btnPrev';
SetPosition(40, 264, 30, 24);
- Text := '<';
+ Text := '';
FontDesc := '#Label1';
- ImageName := '';
Hint := 'Previous record';
+ ImageName := 'repimg.previous';
+ TabOrder := 3;
OnClick := @btnPrevClick;
OnMouseEnter := @ButtonEnter;
OnMouseExit := @ButtonExit;
@@ -199,10 +205,11 @@ begin
begin
Name := 'btnNext';
SetPosition(72, 264, 30, 24);
- Text := '>';
+ Text := '';
FontDesc := '#Label1';
- ImageName := '';
Hint := 'Next record';
+ ImageName := 'repimg.next';
+ TabOrder := 4;
OnClick := @btnNextClick;
OnMouseEnter := @ButtonEnter;
OnMouseExit := @ButtonExit;
@@ -213,10 +220,11 @@ begin
begin
Name := 'btnLast';
SetPosition(104, 264, 30, 24);
- Text := '>>';
+ Text := '';
FontDesc := '#Label1';
- ImageName := '';
Hint := 'Last record';
+ ImageName := 'repimg.last';
+ TabOrder := 5;
OnClick := @btnLastClick;
OnMouseEnter := @ButtonEnter;
OnMouseExit := @ButtonExit;
@@ -228,6 +236,8 @@ begin
Name := 'lstName1';
SetPosition(8, 24, 400, 156);
FontDesc := '#List';
+ Hint := '';
+ TabOrder := 6;
end;
dblblName := TfpgDBLabel.Create(self);
@@ -249,8 +259,9 @@ begin
begin
Name := 'lblName1';
SetPosition(20, 208, 80, 16);
- Text := 'Name:';
FontDesc := '#Label1';
+ Hint := '';
+ Text := 'Name:';
end;
lblName2 := TfpgLabel.Create(self);
@@ -258,8 +269,9 @@ begin
begin
Name := 'lblName2';
SetPosition(20, 228, 80, 16);
- Text := 'E-mail:';
FontDesc := '#Label1';
+ Hint := '';
+ Text := 'E-mail:';
end;
pnlName1 := TfpgBevel.Create(self);
@@ -268,6 +280,7 @@ begin
Name := 'pnlName1';
SetPosition(0, 296, 416, 18);
Anchors := [anLeft,anRight,anBottom];
+ Hint := '';
Style := bsLowered;
end;
@@ -276,8 +289,9 @@ begin
begin
Name := 'lblName3';
SetPosition(8, 4, 400, 16);
- Text := 'Available DB Records:';
FontDesc := '#Label1';
+ Hint := '';
+ Text := 'Available DB Records:';
end;
lblName4 := TfpgLabel.Create(self);
@@ -285,8 +299,9 @@ begin
begin
Name := 'lblName4';
SetPosition(8, 188, 168, 16);
- Text := 'Current record:';
FontDesc := '#Label2';
+ Hint := '';
+ Text := 'Current record:';
end;
lblStatusBar := TfpgLabel.Create(pnlName1);
@@ -295,8 +310,9 @@ begin
Name := 'lblStatusBar';
SetPosition(5, 1, 404, 16);
Anchors := [anLeft,anRight,anTop];
- Text := '';
FontDesc := '#Label1';
+ Hint := '';
+ Text := '';
end;
{@VFD_BODY_END: MainForm}
diff --git a/examples/gui/tabtest/tabtest.lpr b/examples/gui/tabtest/tabtest.lpr
index 3675e29a..d5bac5b9 100644
--- a/examples/gui/tabtest/tabtest.lpr
+++ b/examples/gui/tabtest/tabtest.lpr
@@ -22,6 +22,7 @@ type
btn2, btn3: TfpgButton;
chkSort: TfpgCheckBox;
cbTabPos: TfpgComboBox;
+ lblHeight: TfpgLabel;
edtHeight: TfpgEditInteger;
lbl: TfpgLabel;
procedure TabSheet4Painting(Sender: TObject);
@@ -106,6 +107,8 @@ begin
pcMain.Width := Width - 20;
pcMain.Height := 300;
pcMain.Anchors := [anLeft, anTop, anRight, anBottom];
+ pcMain.ActiveTabColor:= clOrangeRed;
+ pcMain.ActiveTabTextColor:= clYellow;
// pcMain.FixedTabWidth:=150;
// Tab One
@@ -124,6 +127,9 @@ begin
// Tab Three
tsThree := TfpgTabSheet.Create(pcMain);
tsThree.Text := 'Tab Three';
+ tsThree.BackgroundColor:= clWheat;
+ tsThree.TabColor:= clLightBlue;
+ tsThree.TabTextColor:= clWhite;
CreateLabel(tsThree, 80, 50, 'TabSheet Three');
// Tab Four
@@ -156,9 +162,11 @@ begin
cbTabPos.Hint := 'Tab position';
cbTabPos.OnChange := @cbTabPosChanged;
- CreateLabel(self, 390, 325, 'Height:');
+ lblHeight := CreateLabel(self, 390, 325, 'Height:');
+ lblHeight.Anchors := [anBottom, anLeft];
edtHeight := CreateEditInteger(self, 435, 320, 30, 24, False);
edtHeight.Value := 0;
+ edtHeight.Anchors := [anBottom, anLeft];
edtHeight.Hint := 'Tab height';
edtHeight.OnChange := @edtHeightChanged;
end;
diff --git a/extras/lazarus_ide/fpgui_ide.lpk b/extras/lazarus_ide/fpgui_ide.lpk
index 8343707b..22efe8db 100644
--- a/extras/lazarus_ide/fpgui_ide.lpk
+++ b/extras/lazarus_ide/fpgui_ide.lpk
@@ -1,23 +1,24 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
- <Package Version="3">
+ <Package Version="4">
<Name Value="fpgui_ide"/>
+ <Type Value="DesignTime"/>
+ <AddToProjectUsesSection Value="True"/>
<Author Value="Graeme Geldenhuys"/>
<CompilerOptions>
- <Version Value="5"/>
+ <Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
- <CodeGeneration>
- <Generate Value="Faster"/>
- </CodeGeneration>
- <Other>
- <CompilerPath Value="$(CompPath)"/>
- </Other>
+ <Parsing>
+ <SyntaxOptions>
+ <UseAnsiStrings Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
</CompilerOptions>
<Description Value="Adds a new project type in the Lazarus IDE. You can then create fpGUI based applications from the File | New dialog."/>
<License Value="GPL v2"/>
- <Version Minor="1"/>
+ <Version Minor="2"/>
<Files Count="1">
<Item1>
<Filename Value="fpguilazideintf.pas"/>
@@ -25,7 +26,6 @@
<UnitName Value="fpGUILazIDEIntf"/>
</Item1>
</Files>
- <Type Value="DesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="IDEIntf"/>
@@ -35,7 +35,7 @@
</Item2>
</RequiredPkgs>
<UsageOptions>
- <UnitPath Value="$(PkgOutDir)/"/>
+ <UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
diff --git a/extras/lazarus_ide/fpguilazideintf.pas b/extras/lazarus_ide/fpguilazideintf.pas
index 306d3d44..9c797ec2 100644
--- a/extras/lazarus_ide/fpguilazideintf.pas
+++ b/extras/lazarus_ide/fpguilazideintf.pas
@@ -1,5 +1,5 @@
{
- Copyright (C) 2009 by Graeme Geldenhuys
+ Copyright (C) 2009-2015 by Graeme Geldenhuys
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@@ -20,8 +20,9 @@
This unit adds a new project type to the Lazarus IDE.
New Project Type:
- fpGUI Application - A Free Pascal program for fpGUI Toolkit.
-
+ fpGUI Application - A pure fpGUI Toolkit based application.
+ fpGUI+Agg2D Application - An fpGUI application with a TAgg2D instance.
+
}
unit fpGUILazIDEIntf;
@@ -41,25 +42,38 @@ type
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function InitProject(AProject: TLazProject): TModalResult; override;
-// function CreateStartFiles(AProject: TLazProject): TModalResult; override;
end;
+ TfpGUIAgg2dApplicationDescriptor = class(TProjectDescriptor)
+ public
+ constructor Create; override;
+ function GetLocalizedName: string; override;
+ function GetLocalizedDescription: string; override;
+ function InitProject(AProject: TLazProject): TModalResult; override;
+ end;
var
ProjectDescriptorfpGUIApplication: TfpGUIApplicationDescriptor;
+ ProjectDescriptorfpGUIAgg2dApplication: TfpGUIAgg2dApplicationDescriptor;
+
procedure Register;
implementation
+const
+ le: string = LineEnding;
+
procedure Register;
begin
ProjectDescriptorfpGUIApplication := TfpGUIApplicationDescriptor.Create;
RegisterProjectDescriptor(ProjectDescriptorfpGUIApplication);
-end;
+ ProjectDescriptorfpGUIAgg2dApplication := TfpGUIAgg2dApplicationDescriptor.Create;
+ RegisterProjectDescriptor(ProjectDescriptorfpGUIAgg2dApplication);
+end;
{ TfpGUIApplicationDescriptor }
@@ -75,18 +89,13 @@ begin
end;
function TfpGUIApplicationDescriptor.GetLocalizedDescription: string;
-var
- le: string;
begin
- le := System.LineEnding;
Result := 'fpGUI Toolkit Application'+le+le
- +'An application based on the fpGUI Toolkit.'+le
- +'The program file is automatically maintained by Lazarus.';
+ +'An application based purely on the fpGUI Toolkit.';
end;
function TfpGUIApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
var
- le: string;
NewSource: String;
MainFile: TLazProjectFile;
begin
@@ -98,7 +107,6 @@ begin
AProject.MainFileID := 0;
// create program source
- le := LineEnding;
NewSource := 'program Project1;'+le
+le
+'{$mode objfpc}{$H+}'+le
@@ -143,7 +151,7 @@ begin
+' frm: TMainForm;'+le
+'begin'+le
+' fpgApplication.Initialize;'+le
- +' frm := TMainForm.Create(nil);'+le
+ +' fpgApplication.CreateForm(TMainForm, frm);'+le
+' try'+le
+' frm.Show;'+le
+' fpgApplication.Run;'+le
@@ -157,27 +165,162 @@ begin
+'end.'+le
+le;
-
AProject.MainFile.SetSourceText(NewSource);
-
- // add
AProject.AddPackageDependency('fpgui_toolkit');
-
// compiler options
AProject.LazCompilerOptions.UseLineInfoUnit := True;
-// AProject.LazCompilerOptions.CustomOptions := '-FUunits';
Result := mrOK;
end;
-{
-function TfpGUIApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
+{ TfpGUIAgg2dApplicationDescriptor }
+
+constructor TfpGUIAgg2dApplicationDescriptor.Create;
begin
- LazarusIDE.DoNewEditorFile(FileDescriptorfpGUIUnit,'','',
- [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
- Result:=mrOK;
+ inherited Create;
+ Name := 'fpGUI+Agg2D Application';
+end;
+
+function TfpGUIAgg2dApplicationDescriptor.GetLocalizedName: string;
+begin
+ Result := 'fpGUI+Agg2D Application';
+end;
+
+function TfpGUIAgg2dApplicationDescriptor.GetLocalizedDescription: string;
+begin
+ Result := 'fpGUI+Agg2D Application'+le+le
+ +'An application based on the fpGUI Toolkit'+le
+ +'and uses Agg2D to render to an image buffer. Great '
+ +'for quick demos.';
+end;
+
+function TfpGUIAgg2dApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
+var
+ NewSource: String;
+ MainFile: TLazProjectFile;
+begin
+ inherited InitProject(AProject);
+
+ MainFile := AProject.CreateProjectFile('project1.lpr');
+ MainFile.IsPartOfProject := true;
+ AProject.AddFile(MainFile, false);
+ AProject.MainFileID := 0;
+
+ // create program source
+ NewSource := 'program Project1;'+le
+ +le
+ +'uses'+le
+ +' {$IFDEF UNIX}{$IFDEF UseCThreads}'+le
+ +' cthreads,'+le
+ +' {$ENDIF}{$ENDIF}'+le
+ +' Classes, SysUtils,'+le
+ +' fpg_base, fpg_main, fpg_form, Agg2D;'+le
+ +le
+ +'type'+le
+ +''+le
+ +' TMainForm = class(TfpgForm)'+le
+ +' private'+le
+ +' {@VFD_HEAD_BEGIN: MainForm}'+le
+ +' {@VFD_HEAD_END: MainForm}'+le
+ +' FImg: TfpgImage;'+le
+ +' FAgg2D: TAgg2D;'+le
+ +' procedure InitComposedImage;'+le
+ +' procedure FormCreate(Sender: TObject);'+le
+ +' procedure DoAggPainting;'+le
+ +' procedure FormPaint(Sender: TObject);'+le
+ +' public'+le
+ +' destructor Destroy; override;'+le
+ +' procedure AfterCreate; override;'+le
+ +' end;'+le
+ +le
+ +'{@VFD_NEWFORM_DECL}'+le
+ +le
+ +le
+ +le
+ +'{@VFD_NEWFORM_IMPL}'+le
+ +''+le
+ +'procedure TMainForm.DoAggPainting;'+le
+ +'begin'+le
+ +' // **** DO YOUR AGG2D PAINTING HERE ****'+le
+ +le
+ +' // Paint composedimage white'+le
+ +' FAgg2D.ClearAll(255, 255, 255);'+le
+ +' // So some advanced painting to the ComposedImage'+le
+ +' FAgg2D.LineWidth(10);'+le
+ +' FAgg2D.LineColor($32, $cd, $32);'+le
+ +' FAgg2D.FillColor($ff, $d7, $00);'+le
+ +' FAgg2D.Star(100, 100, 30, 70, 55, 5);'+le
+ +'end;'+le
+ +le
+ +'procedure TMainForm.InitComposedImage;'+le
+ +'begin'+le
+ +' FImg := TfpgImage.Create;'+le
+ +' FImg.AllocateImage(32, Width, Height);'+le
+ +' FAgg2D.Attach(FImg);'+le
+ +'end;'+le
+ +le
+ +'procedure TMainForm.FormCreate(Sender: TObject);'+le
+ +'begin'+le
+ +' FAgg2D := TAgg2D.Create(self);'+le
+ +' InitComposedImage;'+le
+ +' DoAggPainting;'+le
+ +'end;'+le
+ +le
+ +'procedure TMainForm.FormPaint(Sender: TObject);'+le
+ +'begin'+le
+ +' // Finalise image internals, then paint it to the Window'+le
+ +' FImg.UpdateImage;'+le
+ +' Canvas.DrawImage(0, 0, FImg);'+le
+ +'end;'+le
+ +le
+ +'destructor TMainForm.Destroy;'+le
+ +'begin'+le
+ +' FAgg2D.Free;'+le
+ +' FImg.Free;'+le
+ +' inherited Destroy;'+le
+ +'end;'+le
+ +le
+ +'procedure TMainForm.AfterCreate;'+le
+ +'begin'+le
+ +' {%region ''Auto-generated GUI code''}'+le
+ +' {@VFD_BODY_BEGIN: MainForm}'+le
+ +' Name := ''MainForm'';'+le
+ +' SetPosition(316, 186, 501, 450);'+le
+ +' WindowTitle := ''TAgg2D.Attach() demo'';'+le
+ +' Hint := '''';'+le
+ +' WindowPosition := wpOneThirdDown;'+le
+ +' OnPaint := @FormPaint;'+le
+ +' OnCreate := @FormCreate;'+le
+ +' {@VFD_BODY_END: MainForm}'+le
+ +' {%endregion}'+le
+ +'end;'+le
+ +le
+ +le
+ +'procedure MainProc;'+le
+ +'var'+le
+ +' frm: TMainForm;'+le
+ +'begin'+le
+ +' fpgApplication.Initialize;'+le
+ +' fpgApplication.CreateForm(TMainForm, frm);'+le
+ +' try'+le
+ +' frm.Show;'+le
+ +' fpgApplication.Run;'+le
+ +' finally'+le
+ +' frm.Free;'+le
+ +' end;'+le
+ +'end;'+le
+ +le
+ +'begin'+le
+ +' MainProc;'+le
+ +'end.'+le;
+
+ AProject.MainFile.SetSourceText(NewSource);
+ AProject.AddPackageDependency('fpgui_toolkit');
+ // compiler options
+ AProject.LazCompilerOptions.UseLineInfoUnit := True;
+
+ Result := mrOK;
end;
-}
end.
diff --git a/extras/lazarus_ide/regfpguitestrunner.pas b/extras/lazarus_ide/regfpguitestrunner.pas
index 6c5806f2..7e978207 100644
--- a/extras/lazarus_ide/regfpguitestrunner.pas
+++ b/extras/lazarus_ide/regfpguitestrunner.pas
@@ -93,7 +93,7 @@ begin
Add('');
Add('begin');
Add(' fpgApplication.Initialize;');
- Add(' frm := TGUITestRunnerForm.Create(nil);');
+ Add(' fpgApplication.CreateForm(TGUITestRunnerForm, frm);');
Add(' try');
Add(' frm.Show;');
Add(' fpgApplication.Run;');
diff --git a/languages/fpgui.af.po b/languages/fpgui.af.po
index 98ac495d..f3e68625 100644
--- a/languages/fpgui.af.po
+++ b/languages/fpgui.af.po
@@ -48,6 +48,10 @@ msgstr "Alle Lettertipes"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr "Anti-aliasing"
@@ -84,6 +88,10 @@ msgstr ""
msgid "Bold"
msgstr "Vetdruk"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Kanselleer"
@@ -296,6 +304,14 @@ msgstr "Vr"
msgid "Friday"
msgstr "Vrydag"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.de.po b/languages/fpgui.de.po
index 09e4ae1a..0c08a4da 100644
--- a/languages/fpgui.de.po
+++ b/languages/fpgui.de.po
@@ -47,6 +47,10 @@ msgstr "Alle Schriften"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr "Antialiasing"
@@ -83,6 +87,10 @@ msgstr ""
msgid "Bold"
msgstr "Fett"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Abbrechen"
@@ -295,6 +303,14 @@ msgstr "Fre"
msgid "Friday"
msgstr "Freitag"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.en.po b/languages/fpgui.en.po
index 20f85e86..4a61a090 100644
--- a/languages/fpgui.en.po
+++ b/languages/fpgui.en.po
@@ -48,6 +48,10 @@ msgstr ""
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr ""
@@ -84,6 +88,10 @@ msgstr ""
msgid "Bold"
msgstr ""
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr ""
@@ -296,6 +304,14 @@ msgstr ""
msgid "Friday"
msgstr ""
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.es.po b/languages/fpgui.es.po
index 181fa6a3..72465dca 100644
--- a/languages/fpgui.es.po
+++ b/languages/fpgui.es.po
@@ -48,6 +48,10 @@ msgstr "Todas las Fuentes"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr ""
@@ -84,6 +88,10 @@ msgstr ""
msgid "Bold"
msgstr "Negrita"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Cancelar"
@@ -296,6 +304,14 @@ msgstr "Vie"
msgid "Friday"
msgstr "Viernes"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.fr.po b/languages/fpgui.fr.po
index 303891bb..70a5cd03 100644
--- a/languages/fpgui.fr.po
+++ b/languages/fpgui.fr.po
@@ -48,6 +48,10 @@ msgstr "Toutes les polices"
msgid "Alt+"
msgstr "Alt+"
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr "Anti alias"
@@ -74,16 +78,20 @@ msgstr "Août"
#: fpg_constants:rskeybksp
msgid "BkSp"
-msgstr ""
+msgstr "Retour"
#: fpg_constants:rscolorblue
msgid "Blue"
-msgstr ""
+msgstr "Bleu"
#: fpg_constants:rsbold
msgid "Bold"
msgstr "Gras"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr "Signets"
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Annuler"
@@ -106,7 +114,7 @@ msgstr "Table de caractères"
#: fpg_constants:rscolorpickerhint
msgid "Click on Picker and maintain click => release to get the color"
-msgstr ""
+msgstr "Cliquer le Picker et le maintenir => relacher pour avoir la couleur"
#: fpg_constants:rsclose
msgid "Close"
@@ -118,7 +126,7 @@ msgstr "Collection"
#: fpg_constants:rstabsheetcolorwheel
msgid "Color Wheel"
-msgstr ""
+msgstr "Roue des couleurs"
#: fpg_constants:rsconfigurebookmarks
msgid "Configure Bookmarks"
@@ -134,7 +142,7 @@ msgstr "Confirmation"
#: fpg_constants:rscontinuous
msgid "Continuous"
-msgstr ""
+msgstr "Continu"
#: fpg_constants:rscopy
msgid "Copy"
@@ -178,7 +186,7 @@ msgstr "Décembre"
#: fpg_constants:rskeydel
msgid "Del"
-msgstr ""
+msgstr "Suppr"
#: fpg_constants:rsdelete
msgid "Delete"
@@ -194,7 +202,7 @@ msgstr "Répertoire"
#: fpg_constants:rskeydown
msgid "Down"
-msgstr ""
+msgstr "Bas"
#: fpg_constants:rsdrive
msgid "Drive"
@@ -202,11 +210,11 @@ msgstr "Disque"
#: fpg_constants:rsedit
msgid "Edit"
-msgstr "Editer"
+msgstr "Éditer"
#: fpg_constants:rskeyend
msgid "End"
-msgstr ""
+msgstr "Fin"
#: fpg_constants:rslanguage
msgid "English"
@@ -214,7 +222,7 @@ msgstr "Français"
#: fpg_constants:rskeyenter
msgid "Enter"
-msgstr ""
+msgstr "Entrée"
#: fpg_constants:rsenternewdirectory
msgid "Enter new directory name"
@@ -226,7 +234,7 @@ msgstr "Erreur"
#: fpg_constants:rskeyesc
msgid "Esc"
-msgstr ""
+msgstr "Echap"
#: fpg_constants:rsexampletext
msgid "Example Text"
@@ -296,9 +304,17 @@ msgstr "Ven"
msgid "Friday"
msgstr "Vendredi"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr "Aller au répertoire parent"
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr "Aller au répertoire origine"
+
#: fpg_constants:rscolorgreen
msgid "Green"
-msgstr ""
+msgstr "Vert"
#: fpg_constants:rsfilegroup
msgid "Group"
@@ -310,11 +326,11 @@ msgstr "Aide"
#: fpg_constants:rshexadecimal
msgid "Hexadecimal"
-msgstr ""
+msgstr "Hexadécimal"
#: fpg_constants:rskeyhome
msgid "Home"
-msgstr ""
+msgstr "Début"
#: fpg_constants:rsignore
msgid "Ignore"
@@ -330,7 +346,7 @@ msgstr "Information"
#: fpg_constants:rskeyins
msgid "Ins"
-msgstr ""
+msgstr "Ins"
#: fpg_constants:rsinsert
msgid "Insert"
@@ -374,7 +390,7 @@ msgstr "Juin"
#: fpg_constants:rskeyleft
msgid "Left"
-msgstr ""
+msgstr "Gauche"
#: fpg_constants:rserrlistmustbeempty
msgid "List must be empty"
@@ -482,15 +498,15 @@ msgstr "Coller"
#: fpg_constants:rskeypgdn
msgid "PgDn"
-msgstr ""
+msgstr "PgBas"
#: fpg_constants:rskeypgup
msgid "PgUp"
-msgstr ""
+msgstr "PgHaut"
#: fpg_constants:rstabpredefined
msgid "Predefined"
-msgstr ""
+msgstr "Prédéfini"
#: fpg_constants:rsreportpreview
msgid "Preview"
@@ -502,7 +518,7 @@ msgstr "Récemment utilisé"
#: fpg_constants:rscolorred
msgid "Red"
-msgstr ""
+msgstr "Rouge"
#: fpg_constants:rsreplace
msgid "Replace"
@@ -514,7 +530,7 @@ msgstr "Retenter"
#: fpg_constants:rskeyright
msgid "Right"
-msgstr ""
+msgstr "Droit"
#: fpg_constants:rsfilerights
msgid "Rights"
@@ -574,7 +590,7 @@ msgstr "Serif"
#: fpg_constants:rskeyshift
msgid "Shift+"
-msgstr ""
+msgstr "Maj+"
#: fpg_constants:rsshowhidden
msgid "Show hidden files"
@@ -586,7 +602,7 @@ msgstr "Taille"
#: fpg_constants:rskeyspace
msgid "Space"
-msgstr ""
+msgstr "Espace"
#: fpg_constants:rsstyle
msgid "Style"
@@ -602,7 +618,7 @@ msgstr "Dimanche"
#: fpg_constants:rskeytab
msgid "Tab"
-msgstr ""
+msgstr "Tab"
#: fpg_constants:rstexttoinsert
msgid "Text to Insert"
@@ -650,7 +666,7 @@ msgstr "Souligné"
#: fpg_constants:rskeyup
msgid "Up"
-msgstr ""
+msgstr "Haut"
#: fpg_constants:rsusername
msgid "User name"
diff --git a/languages/fpgui.it.po b/languages/fpgui.it.po
index 795ed273..1efc1299 100644
--- a/languages/fpgui.it.po
+++ b/languages/fpgui.it.po
@@ -48,6 +48,10 @@ msgstr "Tutti i Fonts"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr "Anti aliasing"
@@ -84,6 +88,10 @@ msgstr ""
msgid "Bold"
msgstr "Grassetto"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Annulla"
@@ -296,6 +304,14 @@ msgstr "Ven"
msgid "Friday"
msgstr "Venerdì"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.po b/languages/fpgui.po
index 53eca15f..0a680649 100644
--- a/languages/fpgui.po
+++ b/languages/fpgui.po
@@ -70,6 +70,10 @@ msgstr ""
msgid "Bold"
msgstr ""
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr ""
@@ -210,6 +214,10 @@ msgstr ""
msgid "Error"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rskeyesc
msgid "Esc"
msgstr ""
@@ -282,6 +290,14 @@ msgstr ""
msgid "Friday"
msgstr ""
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.pt.po b/languages/fpgui.pt.po
index e3ea6725..5843ebd7 100644
--- a/languages/fpgui.pt.po
+++ b/languages/fpgui.pt.po
@@ -48,6 +48,10 @@ msgstr "Todas Fontes"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr ""
@@ -84,6 +88,10 @@ msgstr ""
msgid "Bold"
msgstr "Negrito"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Cancelar"
@@ -296,6 +304,14 @@ msgstr "Sex"
msgid "Friday"
msgstr "Sexta-feira"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/languages/fpgui.ru.po b/languages/fpgui.ru.po
index 2b501756..056b65f3 100644
--- a/languages/fpgui.ru.po
+++ b/languages/fpgui.ru.po
@@ -48,6 +48,10 @@ msgstr "Все шрифты"
msgid "Alt+"
msgstr ""
+#: fpg_constants:rserrunexpected
+msgid "An unexpected error occurred."
+msgstr ""
+
#: fpg_constants:rsantialiasing
msgid "Anti aliasing"
msgstr "Сглаживание"
@@ -84,6 +88,10 @@ msgstr "Синий"
msgid "Bold"
msgstr "Жирный"
+#: fpg_constants:rsbookmarks
+msgid "Bookmarks"
+msgstr ""
+
#: fpg_constants:rscancel
msgid "Cancel"
msgstr "Отмена"
@@ -296,6 +304,14 @@ msgstr "Пт"
msgid "Friday"
msgstr "Пятница"
+#: fpg_constants:rsgotoparentdirectory
+msgid "Go to parent directory"
+msgstr ""
+
+#: fpg_constants:rsgotohomedirectory
+msgid "Got to home directory"
+msgstr ""
+
#: fpg_constants:rscolorgreen
msgid "Green"
msgstr ""
diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc
index bac1d842..aeedab00 100644
--- a/src/VERSION_FILE.inc
+++ b/src/VERSION_FILE.inc
@@ -1 +1 @@
-FPGUI_VERSION = '1.4';
+FPGUI_VERSION = '1.4.1';
diff --git a/src/build.bat b/src/build.bat
index 741048db..20396172 100644
--- a/src/build.bat
+++ b/src/build.bat
@@ -18,5 +18,5 @@ echo "You've got the correct output lib directory"
:end
-fpc -dDEBUG -dGDI @extrafpc.cfg corelib\gdi\fpgui_toolkit.pas
+fpc -dGDI @extrafpc.cfg corelib\gdi\fpgui_toolkit.pas
diff --git a/src/build.sh b/src/build.sh
index 8a180ceb..61c6ac2b 100755
--- a/src/build.sh
+++ b/src/build.sh
@@ -13,7 +13,7 @@ if [ ! -d $libpath ]; then
fi
# Default build
-$fpcbin -dDEBUG -dX11 @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
+$fpcbin -dX11 @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
# experimental AggPas-enabled Canvas under X11
#$fpcbin -dDEBUG -dX11 -dAGGCanvas @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
diff --git a/src/build_wince.bat b/src/build_wince.bat
new file mode 100644
index 00000000..26223e34
--- /dev/null
+++ b/src/build_wince.bat
@@ -0,0 +1,22 @@
+@echo off
+
+rem We use FPC to found out the Platform and OS to create a lib output path
+fpc -Parm -Twince -iTP > tmpvar
+set /p myplatform= < tmpvar
+fpc -Parm -Twince -iTO > tmpvar
+set /p myos= < tmpvar
+del tmpvar
+
+if exist ..\lib\%myplatform%-%myos%\nul.x goto exists
+
+echo Creating missing directory ..\lib\%myplatform%-%myos%
+mkdir ..\lib\%myplatform%-%myos%
+goto end
+
+:exists
+echo "You've got the correct output lib directory"
+
+:end
+
+fpc -v0 -dGDI -Twince -Parm @extrafpc.cfg corelib\gdi\fpgui_toolkit.pas
+
diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index c110f3b0..9177e420 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.pas
@@ -123,7 +123,7 @@ const
var
- {$IFDEF MSWINDOWS}
+ {$IFDEF WINDOWS}
FPG_DEFAULT_FONT_DESC: string = 'Arial-8:antialias=true';
FPG_DEFAULT_SANS: string = 'Arial';
{$ENDIF}
diff --git a/src/corelib/fpg_imgfmt_png.pas b/src/corelib/fpg_imgfmt_png.pas
index 3148a5b4..c4ee504f 100644
--- a/src/corelib/fpg_imgfmt_png.pas
+++ b/src/corelib/fpg_imgfmt_png.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -32,7 +32,7 @@ uses
function LoadImage_PNG(const AFileName: TfpgString): TfpgImage; overload;
function LoadImage_PNG(AStream: TStream): TfpgImage; overload;
function LoadImage_PNG(const AImageData: Pointer; const AImageDataSize: LongWord): TfpgImage; overload;
-function LoadImage_PNG(AInstance: THandle; const AResName: String; AResType: PChar): TfpgImage; overload;
+function LoadImage_PNG(AInstance: THandle; const AResName: String; AResType: {$IFNDEF WINCE} PChar {$ELSE} PWideChar{$ENDIF}): TfpgImage; overload;
function LoadImage_PNGcrop(const AMaxWidth, AMaxHeight: integer; const AFileName: TfpgString): TfpgImage;
@@ -134,7 +134,7 @@ begin
end;
end;
-function LoadImage_PNG(AInstance: THandle; const AResName: String; AResType: PChar): TfpgImage;
+function LoadImage_PNG(AInstance: THandle; const AResName: String; AResType: {$IFNDEF WINCE} PChar {$ELSE} PWideChar{$ENDIF}): TfpgImage;
var
res: TResourceStream;
begin
diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas
index 1f063cb5..275543cf 100644
--- a/src/corelib/fpg_main.pas
+++ b/src/corelib/fpg_main.pas
@@ -1760,7 +1760,7 @@ end;
procedure TfpgApplication.ShowException(E: Exception);
begin
- TfpgMessageDialog.Critical('An unexpected error occurred.', E.Message);
+ TfpgMessageDialog.Critical(rsErrUnexpected, E.Message);
end;
procedure TfpgApplication.WaitWindowMessage(atimeoutms: integer);
diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index a1d314f6..e909782e 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -30,6 +30,14 @@ unit fpg_gdi;
{.$Define DND_DEBUG}
{.$Define DEBUGKEYS}
+// enable or disable DND support. Disabled by default while implementing AlienWindows.
+{$define HAS_DND}
+
+{$IFDEF WINCE}
+ // WinCE doesn't have DND support
+ {$undefine HAS_DND}
+{$ENDIF}
+
interface
uses
@@ -42,7 +50,9 @@ uses
{$IFDEF DEBUG}
,fpg_dbugintf
{$ENDIF DEBUG}
+ {$IFDEF HAS_DND}
,fpg_OLEDragDrop
+ {$ENDIF}
;
{ Constants missing on windows unit }
@@ -153,15 +163,19 @@ type
TfpgGDIWindow = class(TfpgWindowBase)
private
+ {$IFDEF HAS_DND}
FDropManager: TfpgOLEDropTarget;
+ {$ENDIF}
FDropPos: TPoint;
FUserMimeSelection: TfpgString;
FUserAcceptDrag: Boolean;
- function GetDropManager: TfpgOLEDropTarget;
+ {$IFDEF HAS_DND}
procedure HandleDNDLeave(Sender: TObject);
procedure HandleDNDEnter(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; var Effect: DWORD);
+ function GetDropManager: TfpgOLEDropTarget;
procedure HandleDNDPosition(Sender: TObject; KeyState: Longint; PT: TPoint; var Effect: TfpgOLEDragDropEffect);
procedure HandleDNDDrop(Sender: TObject; DataObj: IDataObject; KeyState: Longint; PT: TPoint; Effect: TfpgOLEDragDropEffect);
+ {$ENDIF}
private
FMouseInWindow: boolean;
FNonFullscreenRect: TfpgRect;
@@ -171,7 +185,9 @@ type
QueueAcceptDrops: boolean;
function DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
procedure WindowSetFullscreen(aFullScreen, aUpdate: boolean);
+ {$IFDEF HAS_DND}
property DropManager: TfpgOLEDropTarget read GetDropManager;
+ {$ENDIF}
protected
FWinHandle: TfpgWinHandle;
FModalForWin: TfpgGDIWindow;
@@ -1445,6 +1461,7 @@ var
// this are required for Windows MouseEnter & MouseExit detection.
uLastWindowHndl: TfpgWinHandle;
+{$IFDEF HAS_DND}
procedure TfpgGDIWindow.HandleDNDLeave(Sender: TObject);
var
wg: TfpgWidget;
@@ -1610,6 +1627,7 @@ begin
end;
Result := FDropManager;
end;
+{$ENDIF HAS_DND}
function TfpgGDIWindow.DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean;
var
@@ -2016,6 +2034,7 @@ end;
procedure TfpgGDIWindow.DoAcceptDrops(const AValue: boolean);
begin
+ {$IFDEF HAS_DND}
if AValue then
begin
if HasHandle then
@@ -2029,6 +2048,7 @@ begin
DropManager.RevokeDragDrop;
QueueAcceptDrops := False;
end;
+ {$ENDIF}
end;
procedure TfpgGDIWindow.DoDragStartDetected;
@@ -2066,7 +2086,9 @@ begin
else
begin
+ {$IFNDEF WINCE}
placement.length:= sizeof(placement);
+ // This Windows function doesn't exist in WinCE
if GetWindowPlacement(FWinHandle, placement) then
begin
case placement.ShowCmd of
@@ -2074,6 +2096,7 @@ begin
SW_SHOWMINIMIZED: result:= wsMinimized;
end;
end;
+ {$ENDIF}
end; { case..else }
end; { case }
end;
@@ -2082,7 +2105,9 @@ constructor TfpgGDIWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWinHandle := 0;
+ {$IFDEF HAS_DND}
FDropManager := nil;
+ {$ENDIF}
FDropPos.x := 0;
FDropPos.y := 0;
FFullscreenIsSet := false;
@@ -2092,8 +2117,10 @@ end;
destructor TfpgGDIWindow.Destroy;
begin
+ {$IFDEF HAS_DND}
if Assigned(FDropManager) then
FDropManager.Free;
+ {$ENDIF}
inherited Destroy;
end;
@@ -3027,10 +3054,13 @@ var
M: PStgMedium;
itm: TfpgMimeDataItem;
lEffects: DWORD;
+ {$IFDEF HAS_DND}
FDataObject: TfpgOLEDataObject;
FDropSource: TfpgOLEDropSource;
+ {$ENDIF}
lIsTranslated: boolean;
begin
+ {$IFDEF HAS_DND}
if FDragging then
begin
{$IFDEF DND_DEBUG}
@@ -3121,6 +3151,7 @@ begin
// (FDropSource as IUnknown)._Release;
// (FDataObject as IUnknown)._Release;
end;
+ {$ENDIF HAS_DND}
end;
{ TGDIDragManager }
@@ -3164,18 +3195,22 @@ end;
procedure TGDIDragManager.RegisterDragDrop;
begin
+ {$IFDEF HAS_DND}
Activex.RegisterDragDrop(TfpgWidget(FDropTarget).WinHandle, self as IDropTarget)
+ {$ENDIF}
end;
procedure TGDIDragManager.RevokeDragDrop;
begin
+ {$IFDEF HAS_DND}
ActiveX.RevokeDragDrop(TfpgWidget(FDropTarget).WinHandle);
+ {$ENDIF}
end;
{$IF FPC_FULLVERSION<20602}
procedure TimerCallBackProc(hWnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
{$ELSE}
-procedure TimerCallBackProc(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
+procedure TimerCallBackProc(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); {$IFNDEF WINCE} stdcall; {$ELSE} cdecl; {$ENDIF}
{$IFEND}
begin
{ idEvent contains the handle to the timer that got triggered }
@@ -3240,12 +3275,12 @@ end;
initialization
wapplication := nil;
MouseFocusedWH := 0;
- NeedToUnitialize := Succeeded(OleInitialize(nil));
{$IFDEF WinCE}
UnicodeEnabledOS := True;
FontSmoothingType := DEFAULT_QUALITY;
{$ELSE}
+ NeedToUnitialize := Succeeded(OleInitialize(nil));
WinVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(WinVersion);
UnicodeEnabledOS := (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) or
@@ -3256,11 +3291,11 @@ initialization
FontSmoothingType := CLEARTYPE_QUALITY
else
FontSmoothingType := ANTIALIASED_QUALITY;
-{$ENDIF}
finalization
if NeedToUnitialize then
OleUninitialize;
+{$ENDIF}
end.
diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index 3566dc09..e14414e4 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -30,7 +30,7 @@
</CompilerOptions>
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
- <Version Major="1" Minor="4"/>
+ <Version Major="1" Minor="4" Release="1"/>
<Files Count="107">
<Item1>
<Filename Value="..\stdimages.inc"/>
@@ -166,6 +166,7 @@
</Item33>
<Item34>
<Filename Value="fpg_oledragdrop.pas"/>
+ <AddToUsesPkgSection Value="False"/>
<UnitName Value="fpg_OLEDragDrop"/>
</Item34>
<Item35>
@@ -422,6 +423,7 @@
</Item97>
<Item98>
<Filename Value="..\render\software\Agg2D.pas"/>
+ <AddToUsesPkgSection Value="False"/>
<UnitName Value="Agg2D"/>
</Item98>
<Item99>
diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index 4704d56a..2cc8e7f0 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -2,27 +2,27 @@
This source is only used to compile and install the package.
}
-unit fpgui_toolkit;
+unit fpgui_toolkit;
interface
uses
- fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants,
+ fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants,
fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles,
fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations,
fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_impl, fpg_gdi,
- fpg_OLEDragDrop, fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox,
- fpg_combobox, fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit,
- fpg_form, fpg_gauge, fpg_grid, fpg_hyperlink, fpg_iniutils, fpg_label,
- fpg_listbox, fpg_listview, fpg_memo, fpg_menu, fpg_mru, fpg_panel,
- fpg_popupcalendar, fpg_progressbar, fpg_radiobutton, fpg_scrollbar,
- fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter,
- fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel,
- fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager,
- fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve,
+ fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox,
+ fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge,
+ fpg_grid, fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview,
+ fpg_memo, fpg_menu, fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar,
+ fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree,
+ fpgui_db, fpg_splitter, fpg_hint, fpg_spinedit, fpg_extgraphics,
+ fpg_ColorMapping, fpg_ColorWheel, fpg_interface, fpg_editbtn,
+ fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager, fpg_style_win2k,
+ fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve,
fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report,
- U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg,
- fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle,
+ U_ReportImages, U_Visu, fpg_trayicon, fpg_dbugintf, fpg_dbugmsg,
+ fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle,
fpg_StringGridBuilder, fpg_CSVParser;
implementation
diff --git a/src/corelib/lang_af.inc b/src/corelib/lang_af.inc
index 173dd6b2..f822e9dc 100644
--- a/src/corelib/lang_af.inc
+++ b/src/corelib/lang_af.inc
@@ -12,6 +12,7 @@ rsall = 'Alles';
rsallfiles = 'Alle Lêers';
rscollectionallfonts = 'Alle Lettertipes';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti-aliasing';
rsshortapr = 'Apr';
rslongapr = 'April';
@@ -21,6 +22,7 @@ rslongaug = 'Augustus';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Vetdruk';
+rsbookmarks = 'Bookmarks';
rscancel = 'Kanselleer';
rscannotcreatedir = 'Kan nie die lêergids skep nie';
rschange = 'Verander';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Font Kenname';
rserrreportfontfilemissing = 'Font lêer" <%s.fnt> is nie gevind nie';
rsshortfri = 'Vr';
rslongfri = 'Vrydag';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Groep';
rshelp = 'Help';
diff --git a/src/corelib/lang_de.inc b/src/corelib/lang_de.inc
index a261926f..18f96adb 100644
--- a/src/corelib/lang_de.inc
+++ b/src/corelib/lang_de.inc
@@ -12,6 +12,7 @@ rsall = 'Alle';
rsallfiles = 'Alle Dateien';
rscollectionallfonts = 'Alle Schriften';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Antialiasing';
rsshortapr = 'Apr';
rslongapr = 'April';
@@ -21,6 +22,7 @@ rslongaug = 'August';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Fett';
+rsbookmarks = 'Bookmarks';
rscancel = 'Abbrechen';
rscannotcreatedir = 'Kann Verzeichnis nicht anlegen';
rschange = 'Ändern';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Font-Aliase';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Fre';
rslongfri = 'Freitag';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Gruppe';
rshelp = 'Hilfe';
diff --git a/src/corelib/lang_en.inc b/src/corelib/lang_en.inc
index aec26b22..d1c1fcc4 100644
--- a/src/corelib/lang_en.inc
+++ b/src/corelib/lang_en.inc
@@ -12,6 +12,7 @@ rsall = 'All';
rsallfiles = 'All Files';
rscollectionallfonts = 'All Fonts';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti aliasing';
rsshortapr = 'Apr';
rslongapr = 'April';
@@ -21,6 +22,7 @@ rslongaug = 'August';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Bold';
+rsbookmarks = 'Bookmarks';
rscancel = 'Cancel';
rscannotcreatedir = 'Cannot create directory';
rschange = 'Change';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Fri';
rslongfri = 'Friday';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Group';
rshelp = 'Help';
diff --git a/src/corelib/lang_es.inc b/src/corelib/lang_es.inc
index f53ccb76..1c0ca2cd 100644
--- a/src/corelib/lang_es.inc
+++ b/src/corelib/lang_es.inc
@@ -12,6 +12,7 @@ rsall = 'Todos';
rsallfiles = 'Todos los Archivos';
rscollectionallfonts = 'Todas las Fuentes';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti aliasing';
rsshortapr = 'Apr';
rslongapr = 'April';
@@ -21,6 +22,7 @@ rslongaug = 'August';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Negrita';
+rsbookmarks = 'Bookmarks';
rscancel = 'Cancelar';
rscannotcreatedir = 'No se puede crear la carpeta';
rschange = 'Cambiar';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Aliases de Fuentes';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Vie';
rslongfri = 'Viernes';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Grupo';
rshelp = 'Ayuda';
diff --git a/src/corelib/lang_fr.inc b/src/corelib/lang_fr.inc
index 0a9a8e21..7ccad790 100644
--- a/src/corelib/lang_fr.inc
+++ b/src/corelib/lang_fr.inc
@@ -12,28 +12,30 @@ rsall = 'Tous';
rsallfiles = 'Tous les fichiers';
rscollectionallfonts = 'Toutes les polices';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti alias';
rsshortapr = 'Avr';
rslongapr = 'Avril';
rsfileattributes = 'Attributs';
rsshortaug = 'Aoû';
rslongaug = 'Août';
-rskeybksp = 'BkSp';
-rscolorblue = 'Blue';
+rskeybksp = 'Retour';
+rscolorblue = 'Bleu';
rsbold = 'Gras';
+rsbookmarks = 'Signets';
rscancel = 'Annuler';
rscannotcreatedir = 'Impossible de créer le répertoire';
rschange = 'Modifier';
rschangetitle = 'Changer le titre';
rscharactermap = 'Table de caractères';
-rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
+rscolorpickerhint = 'Cliquer le Picker et le maintenir => relacher pour avoir la couleur';
rsclose = 'Fermer';
rscollection = 'Collection';
-rstabsheetcolorwheel = 'Color Wheel';
+rstabsheetcolorwheel = 'Roue des couleurs';
rsconfigurebookmarks = 'Configurer les signets';
rsconfirm = 'Confirmer';
rsconfirmation = 'Confirmation';
-rscontinuous = 'Continuous';
+rscontinuous = 'Continu';
rscopy = 'Copier';
rserrcouldnotopendir = 'Le répertoire <%s> n''''a pas pu être ouvert';
rscreate = 'Créer';
@@ -44,19 +46,19 @@ rscut = 'Couper';
rsdatabase = 'Base de données';
rsshortdec = 'Déc';
rslongdec = 'Décembre';
-rskeydel = 'Del';
+rskeydel = 'Suppr';
rsdelete = 'Supprimer';
rsdirectories = 'Répertoires';
rsdirectory = 'Répertoire';
-rskeydown = 'Down';
+rskeydown = 'Bas';
rsdrive = 'Disque';
rsedit = 'Editer';
-rskeyend = 'End';
+rskeyend = 'Fin';
rslanguage = 'Français';
-rskeyenter = 'Enter';
+rskeyenter = 'Entrée';
rsenternewdirectory = 'Entrer le nom du nouveau répertoire';
rserror = 'Erreur';
-rskeyesc = 'Esc';
+rskeyesc = 'Echap';
rsexampletext = 'Texte exemple';
rsexit = 'Sortir';
rserrfailedtocreatedir = 'Le répertoire <%s> n''''a pas pu être ouvert';
@@ -74,11 +76,13 @@ rscollectionfontaliases = 'Alias';
rserrreportfontfilemissing = 'Fichier de police <%s.fnt> non trouvé';
rsshortfri = 'Ven';
rslongfri = 'Vendredi';
-rscolorgreen = 'Green';
+rsgotoparentdirectory = 'Aller au répertoire parent';
+rsgotohomedirectory = 'Aller au répertoire origine';
+rscolorgreen = 'Vert';
rsfilegroup = 'Groupe';
rshelp = 'Aide';
-rshexadecimal = 'Hexadecimal';
-rskeyhome = 'Home';
+rshexadecimal = 'Hexadécimal';
+rskeyhome = 'Début';
rsignore = 'Ignorer';
rserrreportimagefilemissing = 'Image <%s> introuvable';
rsinformation = 'Information';
@@ -93,7 +97,7 @@ rsshortjul = 'Jul';
rslongjul = 'Juillet';
rsshortjun = 'Jun';
rslongjun = 'Juin';
-rskeyleft = 'Left';
+rskeyleft = 'Gauche';
rserrlistmustbeempty = 'La liste doit être vide';
rsshortmar = 'Mar';
rslongmar = 'Mars';
@@ -121,15 +125,15 @@ rsfiletypepdf = 'Documents PDF';
rsreportpage = 'Page';
rspassword = 'Mot de passe';
rspaste = 'Coller';
-rskeypgdn = 'PgDn';
-rskeypgup = 'PgUp';
-rstabpredefined = 'Predefined';
+rskeypgdn = 'PgBas';
+rskeypgup = 'PgHaut';
+rstabpredefined = 'Prédéfini';
rsreportpreview = 'Prévisualisation';
rscollectionrecentlyused = 'Récemment utilisé';
-rscolorred = 'Red';
+rscolorred = 'Rouge';
rsreplace = 'Remplacer';
rsretry = 'Retenter';
-rskeyright = 'Right';
+rskeyright = 'Droit';
rsfilerights = 'Droits';
rscollectionsans = 'Sans';
rsshortsat = 'Sam';
@@ -144,10 +148,10 @@ rsselectafont = 'Choisir la police';
rsshortsep = 'Sep';
rslongsep = 'Septembre';
rscollectionserif = 'Serif';
-rskeyshift = 'Shift+';
+rskeyshift = 'Maj+';
rsshowhidden = 'Montrer les fichiers cachés';
rssize = 'Taille';
-rskeyspace = 'Space';
+rskeyspace = 'Espace';
rsstyle = 'Style';
rsshortsun = 'Dim';
rslongsun = 'Dimanche';
@@ -163,7 +167,7 @@ rslongtue = 'Mardi';
rsfiletype = 'Type de fichier';
rstypeface = 'Style';
rsunderscore = 'Souligné';
-rskeyup = 'Up';
+rskeyup = 'Haut';
rsusername = 'Nom utilisateur';
rswarning = 'Alerte';
rsshortwed = 'Mer';
diff --git a/src/corelib/lang_it.inc b/src/corelib/lang_it.inc
index 26eb36d8..e1df75f4 100644
--- a/src/corelib/lang_it.inc
+++ b/src/corelib/lang_it.inc
@@ -12,6 +12,7 @@ rsall = 'Tutto';
rsallfiles = 'Tutti i Files';
rscollectionallfonts = 'Tutti i Fonts';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti aliasing';
rsshortapr = 'Apr';
rslongapr = 'Aprile';
@@ -21,6 +22,7 @@ rslongaug = 'Agosto';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Grassetto';
+rsbookmarks = 'Bookmarks';
rscancel = 'Annulla';
rscannotcreatedir = 'Non riesco a creare la cartella';
rschange = 'Cambia';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Ven';
rslongfri = 'Venerdì';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Gruppo';
rshelp = 'Aiuto';
diff --git a/src/corelib/lang_pt.inc b/src/corelib/lang_pt.inc
index fb3dd92b..718137e5 100644
--- a/src/corelib/lang_pt.inc
+++ b/src/corelib/lang_pt.inc
@@ -12,6 +12,7 @@ rsall = 'Todos';
rsallfiles = 'Todos os arquivos';
rscollectionallfonts = 'Todas Fontes';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Anti aliasing';
rsshortapr = 'Abr';
rslongapr = 'Abril';
@@ -21,6 +22,7 @@ rslongaug = 'Agosto';
rskeybksp = 'BkSp';
rscolorblue = 'Blue';
rsbold = 'Negrito';
+rsbookmarks = 'Bookmarks';
rscancel = 'Cancelar';
rscannotcreatedir = 'Não foi possível criar diretório';
rschange = 'Editar';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Sex';
rslongfri = 'Sexta-feira';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Grupo';
rshelp = 'Ajuda';
diff --git a/src/corelib/lang_ru.inc b/src/corelib/lang_ru.inc
index ce5b753e..d720842b 100644
--- a/src/corelib/lang_ru.inc
+++ b/src/corelib/lang_ru.inc
@@ -12,6 +12,7 @@ rsall = 'Все';
rsallfiles = 'Все файлы';
rscollectionallfonts = 'Все шрифты';
rskeyalt = 'Alt+';
+rserrunexpected = 'An unexpected error occurred.';
rsantialiasing = 'Сглаживание';
rsshortapr = 'Апр';
rslongapr = 'Апрель';
@@ -21,6 +22,7 @@ rslongaug = 'Август';
rskeybksp = 'BkSp';
rscolorblue = 'Синий';
rsbold = 'Жирный';
+rsbookmarks = 'Bookmarks';
rscancel = 'Отмена';
rscannotcreatedir = 'Невозможно создать директорию';
rschange = 'Изменить';
@@ -74,6 +76,8 @@ rscollectionfontaliases = 'Псевдонимы шрифтов';
rserrreportfontfilemissing = 'Файл шрифта <%s.fnt> не найден';
rsshortfri = 'Пт';
rslongfri = 'Пятница';
+rsgotoparentdirectory = 'Go to parent directory';
+rsgotohomedirectory = 'Got to home directory';
rscolorgreen = 'Green';
rsfilegroup = 'Группа';
rshelp = 'Справка';
diff --git a/src/corelib/render/software/Agg2D.pas b/src/corelib/render/software/Agg2D.pas
index b77b9ce9..7cf9cb48 100644
--- a/src/corelib/render/software/Agg2D.pas
+++ b/src/corelib/render/software/Agg2D.pas
@@ -644,7 +644,7 @@ type
function BitmapAlphaTransparency(bitmap : TfpgImage; alpha : byte ) : boolean;
function fpgColor2AggColor(c: TfpgColor): TAggColor;
-
+
IMPLEMENTATION
@@ -995,7 +995,6 @@ end;
function fpgColor2AggColor(c: TfpgColor): TAggColor;
var
t: TRGBTriple;
- c1: TfpgColor;
begin
t := fpgColorToRGBTriple(c);
Result.Construct(t.Red, t.Green, t.Blue, t.Alpha);
@@ -1137,7 +1136,7 @@ begin
stride );
{ OK }
- result:=true;
+ result:=true;
end;
@@ -3569,7 +3568,6 @@ end;
{$ENDIF}
{$IFDEF UNIX}
var
- s: TfpgString;
i: integer;
fnt: TFontCacheItem;
lSize: double;
@@ -3841,4 +3839,4 @@ end;
end.
-
+
diff --git a/src/corelib/render/software/agg_color.pas b/src/corelib/render/software/agg_color.pas
index 3aadb4f4..05958f8d 100644
--- a/src/corelib/render/software/agg_color.pas
+++ b/src/corelib/render/software/agg_color.pas
@@ -244,13 +244,12 @@ end;
{ FROM_WAVELENGTH }
constructor aggclr.from_wavelength(wl ,gamma : double );
var
- tr ,tg ,tb ,ta ,s : double;
+ tr ,tg ,tb ,s : double;
begin
tr:=0;
tg:=0;
tb:=0;
- ta:=0;
if (wl >= 380.0 ) and
(wl <= 440.0 ) then
diff --git a/src/corelib/render/software/agg_scanline_storage_aa.pas b/src/corelib/render/software/agg_scanline_storage_aa.pas
index 1f1f4ab4..b625f097 100644
--- a/src/corelib/render/software/agg_scanline_storage_aa.pas
+++ b/src/corelib/render/software/agg_scanline_storage_aa.pas
@@ -1671,9 +1671,6 @@ end;
{ REWIND_SCANLINES }
function serialized_scanlines_adaptor_aa.rewind_scanlines;
-var
- x : int;
-
begin
m_ptr:=m_data;
diff --git a/src/corelib/render/software/fpg_fontcache.pas b/src/corelib/render/software/fpg_fontcache.pas
index 15f65e40..3de3a7f6 100644
--- a/src/corelib/render/software/fpg_fontcache.pas
+++ b/src/corelib/render/software/fpg_fontcache.pas
@@ -207,7 +207,6 @@ function TFontCacheList.BuildFontCacheItem(const AFontFile: TfpgString): TFontCa
var
face_ptr: FT_Face_ptr;
s: Ansistring;
- i: integer;
flags: integer;
begin
FT_New_Face(m_library, PChar(AFontFile), 0, face_ptr);
diff --git a/src/corelib/x11/fpg_netlayer_x11.pas b/src/corelib/x11/fpg_netlayer_x11.pas
index eb9207b0..0ba60a6b 100644
--- a/src/corelib/x11/fpg_netlayer_x11.pas
+++ b/src/corelib/x11/fpg_netlayer_x11.pas
@@ -601,8 +601,6 @@ begin
end;
procedure TNETWindowLayer.WindowSetSupportPING(const AWindow: TWindow);
-var
- WM_PROTOCOLS: TAtom;
begin
//WM_PROTOCOLS := XInternAtom(FDisplay, 'WM_PROTOCOLS', True);
WindowAddProtocol(AWindow, FNetAtoms[naWM_PING]);
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index ff6e7272..3d28a873 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -704,7 +704,6 @@ var
Data: Pointer;
xia_Atom_Pair: TAtom;
AtomPair: TAtomPair;
- i: Integer;
r: cint;
begin
@@ -1689,7 +1688,7 @@ begin
OnIdle(self);
fpFD_ZERO(rfds);
fpFD_SET(xfd, rfds);
- r := fpSelect(xfd + 1, @rfds, nil, nil, Min(atimeoutms, 50));
+ r := fpSelect(xfd + 1, @rfds, nil, nil, 10);
if r <> 0 then // We got a X event or the timeout happened
XNextEvent(display, @ev)
else
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index f53dd62e..52454211 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -23,12 +23,11 @@
</CodeGeneration>
<Other>
<CustomOptions Value="-dAggCanvasX"/>
- <CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
- <Version Major="1" Minor="4"/>
+ <Version Major="1" Minor="4" Release="1"/>
<Files Count="110">
<Item1>
<Filename Value="../stdimages.inc"/>
diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas
index 2df7b414..0524adac 100644
--- a/src/gui/fpg_basegrid.pas
+++ b/src/gui/fpg_basegrid.pas
@@ -696,7 +696,6 @@ var
cw: integer;
vl: integer;
i: integer;
- x: integer;
hmax: integer;
vmax: integer;
Hfits, showH : boolean;
@@ -929,7 +928,6 @@ var
rTop: integer;
firstcol, lastcol, firstrow, lastrow : integer;
cWidths: array of integer;
- rect: TRect;
begin
Canvas.ClearClipRect;
r.SetRect(0, 0, Width, Height);
@@ -1446,7 +1444,6 @@ end;
procedure TfpgBaseGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
var
- lColumn: integer;
hh: integer; { header height }
cLeft: integer; { column left }
c: integer;
@@ -1512,7 +1509,6 @@ var
hh: integer;
n: Integer;
cw: integer;
- nw: integer;
prow: Integer;
pcol: Integer;
c: integer;
diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas
index a2946c3c..d428ad55 100644
--- a/src/gui/fpg_checkbox.pas
+++ b/src/gui/fpg_checkbox.pas
@@ -189,7 +189,6 @@ procedure TfpgBaseCheckBox.HandlePaint;
var
r: TfpgRect;
ix: integer;
- img: TfpgImage;
LFlags: TfpgTextFlags;
begin
inherited HandlePaint;
diff --git a/src/gui/fpg_colormapping.pas b/src/gui/fpg_colormapping.pas
index a22b949e..9e736e4b 100644
--- a/src/gui/fpg_colormapping.pas
+++ b/src/gui/fpg_colormapping.pas
@@ -54,7 +54,7 @@ begin
hi := max(max(r, g), b);
lo := min(min(r, g), b);
d := hi - lo;
- Value := hi / 256;
+ Value := hi / 255;
if d > 0 then
begin
if r = hi then
diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas
index 42f4752c..0ceeaa13 100644
--- a/src/gui/fpg_dialogs.pas
+++ b/src/gui/fpg_dialogs.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -118,6 +118,7 @@ type
procedure SetupCaptions; virtual;
public
constructor Create(AOwner: TComponent); override;
+ procedure AfterCreate; override;
end;
@@ -202,6 +203,7 @@ type
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
procedure btnOKClick(Sender: TObject); override;
procedure SetCurrentDirectory(const ADir: string);
+ procedure SetupCaptions; override;
public
FileName: string;
constructor Create(AOwner: TComponent); override;
@@ -250,7 +252,7 @@ uses
fpg_widget,
fpg_utils,
fpg_stringutils
- {$IFDEF MSWINDOWS}
+ {$IFDEF WINDOWS}
,Windows // used by File Dialog & Select Dir Dialog
{$ENDIF}
,DateUtils
@@ -605,6 +607,12 @@ begin
btnOK.TabOrder := 1;
end;
+procedure TfpgBaseDialog.AfterCreate;
+begin
+ inherited AfterCreate;
+ SetupCaptions;
+end;
+
{ TfpgFontSelectDialog }
@@ -1101,6 +1109,8 @@ end;
procedure TfpgFileDialog.InitializeComponents;
begin
+ self.ShowHint := True;
+
chlDir := TfpgComboBox.Create(self);
with chlDir do
begin
@@ -1450,6 +1460,16 @@ begin
edFilename.Clear;
end;
+procedure TfpgFileDialog.SetupCaptions;
+begin
+ inherited SetupCaptions;
+ btnUpDir.Hint := rsGoToParentDirectory;
+ btnDirNew.Hint := rsCreateDirectory;
+ btnShowHidden.Hint := rsShowHidden;
+ btnGoHome.Hint := rsGoToHomeDirectory;
+ btnBookmark.Hint := rsBookmarks;
+end;
+
function TfpgFileDialog.HighlightFile(const AFilename: string): boolean;
var
n: integer;
@@ -1469,7 +1489,6 @@ end;
function TfpgFileDialog.CreatePopupMenu: TfpgPopupMenu;
var
i: integer;
- s: TfpgString;
lst: TStringList;
mi: TfpgMenuItem;
begin
diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas
index 6bc3cc7c..1ddce281 100644
--- a/src/gui/fpg_edit.pas
+++ b/src/gui/fpg_edit.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -933,8 +933,7 @@ begin
end;
end; { if }
- if not consumed then
- inherited HandleKeyPress(keycode, shiftstate, consumed);
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
if hasChanged then
DoOnChange;
diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas
index 12773d9b..a8bd30ed 100644
--- a/src/gui/fpg_editcombo.pas
+++ b/src/gui/fpg_editcombo.pas
@@ -441,9 +441,9 @@ begin
end;
procedure TfpgBaseEditCombo.SetDefaultPopupMenuItemsState;
-var
- i: integer;
- itm: TfpgMenuItem;
+//var
+ //i: integer;
+ //itm: TfpgMenuItem;
begin
//for i := 0 to FDefaultPopupMenu.ComponentCount-1 do
//begin
diff --git a/src/gui/fpg_iniutils.pas b/src/gui/fpg_iniutils.pas
index 6bbe83bd..144b007e 100644
--- a/src/gui/fpg_iniutils.pas
+++ b/src/gui/fpg_iniutils.pas
@@ -203,7 +203,7 @@ begin
// If the form is off screen (positioned outside all monitor screens) then
// center the form on screen.
- //{$IFDEF MSWINDOWS}
+ //{$IFDEF WINDOWS}
//if (AForm.FormStyle <> fsMDIChild) {$IFNDEF FPC} and tiFormOffScreen(AForm) {$ENDIF} then
//begin
//if Assigned(Application.MainForm) and (Application.MainForm <> AForm) then
@@ -211,7 +211,7 @@ begin
//else
//AForm.Position:= poScreenCenter;
//end;
- //{$ENDIF MSWINDOWS}
+ //{$ENDIF WINDOWS}
end;
// Do NOT localize
diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas
index d876a222..80c836a0 100644
--- a/src/gui/fpg_listbox.pas
+++ b/src/gui/fpg_listbox.pas
@@ -236,6 +236,8 @@ type
property Items;
property ParentShowHint;
property PopupFrame;
+ property ScrollBarPage;
+ property ScrollBarWidth;
property ShowColorNames;
property ShowHint;
property TabOrder;
diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas
index d02e6ec4..0e5079c1 100644
--- a/src/gui/fpg_memo.pas
+++ b/src/gui/fpg_memo.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -1108,8 +1108,7 @@ begin
RePaint;
end;
-procedure TfpgMemo.HandleKeyPress(var keycode: word;
- var shiftstate: TShiftState; var consumed: boolean);
+procedure TfpgMemo.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
var
cx: integer;
ls: string;
@@ -1347,14 +1346,14 @@ begin
end;
end;
- if Consumed then
- RePaint
- else
- inherited;
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
if hasChanged then
if Assigned(FOnChange) then
FOnChange(self);
+
+ if Consumed then
+ RePaint;
end;
procedure TfpgMemo.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
@@ -1706,7 +1705,6 @@ end;
procedure TfpgMemo.SetText(const AValue: TfpgString);
var
n: integer;
- c: TfpgChar;
s: TfpgString;
begin
FLines.Clear;
diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas
index 4779fe40..f1966759 100644
--- a/src/gui/fpg_menu.pas
+++ b/src/gui/fpg_menu.pas
@@ -1070,7 +1070,6 @@ procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect; AFlags: TfpgM
var
s: string;
x: integer;
- img: TfpgImage;
lFlags: TfpgMenuItemFlags;
begin
lFlags := AFlags;
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index fbe20006..69a85097 100644
--- a/src/gui/fpg_scrollbar.pas
+++ b/src/gui/fpg_scrollbar.pas
@@ -434,8 +434,6 @@ begin
end;
procedure TfpgScrollBar.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
-var
- lPos: TfpgCoord;
begin
inherited;
CaptureMouse;
diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas
index 008832ce..2355929e 100644
--- a/src/gui/fpg_scrollframe.pas
+++ b/src/gui/fpg_scrollframe.pas
@@ -161,7 +161,6 @@ var
c : TComponent;
max_w, max_h : integer;
this_need : integer;
- par : TfpgWidget;
begin
if ComponentCount=0 then
Exit;
@@ -217,8 +216,6 @@ end;
procedure TfpgScrollFrame.HandleMouseScroll(x, y: integer;
shiftstate: TShiftState; delta: smallint);
-var
- old_val, new_val : integer;
begin
inherited HandleMouseScroll(x, y, shiftstate, delta);
with FVScrollBar do
diff --git a/src/gui/fpg_spinedit.pas b/src/gui/fpg_spinedit.pas
index 6061eb3b..97de1027 100644
--- a/src/gui/fpg_spinedit.pas
+++ b/src/gui/fpg_spinedit.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -175,53 +175,53 @@ type
FValue: integer;
procedure EnableButtons;
protected
- function IsMinLimitReached: Boolean; override;
- function IsMaxLimitReached: Boolean; override;
- function GetEditBackgroundColor: TfpgColor;
- function GetTextColor: TfpgColor;
- function GetNegativeColor: TfpgColor;
- function GetFontDesc: string;
- procedure ResizeChildren; override;
- procedure SetEditBackgroundColor(const AValue: Tfpgcolor);
- procedure SetTextColor(const AValue: Tfpgcolor); override;
- procedure SetNegativeColor(const AValue: Tfpgcolor);
- procedure SetFontDesc(const AValue: string);
- procedure SetMaxValue(const AValue: integer);
- procedure SetMinValue(const AValue: integer);
- procedure SetIncrement(const AValue: integer);
- procedure SetLargeIncrement(const AValue: integer);
- procedure SetValue(const AValue: integer);
- procedure SetHint(const AValue: TfpgString); override;
- procedure ButtonUpClick(Sender: TObject);
- procedure ButtonDownClick(Sender: TObject);
- procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean);
- procedure EditExit(Sender: TObject);
- procedure MouseEnter(Sender: TObject);
- procedure MouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint);
- procedure MouseExit(Sender: TObject);
- procedure TimerStep(Sender: TObject);
+ function IsMinLimitReached: Boolean; override;
+ function IsMaxLimitReached: Boolean; override;
+ function GetEditBackgroundColor: TfpgColor;
+ function GetTextColor: TfpgColor;
+ function GetNegativeColor: TfpgColor;
+ function GetFontDesc: string;
+ procedure ResizeChildren; override;
+ procedure SetEditBackgroundColor(const AValue: Tfpgcolor);
+ procedure SetTextColor(const AValue: Tfpgcolor); override;
+ procedure SetNegativeColor(const AValue: Tfpgcolor);
+ procedure SetFontDesc(const AValue: string);
+ procedure SetMaxValue(const AValue: integer);
+ procedure SetMinValue(const AValue: integer);
+ procedure SetIncrement(const AValue: integer);
+ procedure SetLargeIncrement(const AValue: integer);
+ procedure SetValue(const AValue: integer);
+ procedure SetHint(const AValue: TfpgString); override;
+ procedure ButtonUpClick(Sender: TObject);
+ procedure ButtonDownClick(Sender: TObject);
+ procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean);
+ procedure EditExit(Sender: TObject);
+ procedure MouseEnter(Sender: TObject);
+ procedure MouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint);
+ procedure MouseExit(Sender: TObject);
+ procedure TimerStep(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
published
- property EditBackgroundColor: Tfpgcolor read GetEditBackgroundColor write SetEditBackgroundColor default clBoxColor;
- property ButtonsBackgroundColor;
- property ButtonWidth;
- property TextColor: Tfpgcolor read GetTextColor write SetTextColor;
- property NegativeColor: TfpgColor read GetNegativeColor write SetNegativeColor;
- property ArrowUpColor;
- property ArrowDownColor;
- property FontDesc: string read GetFontDesc write SetFontDesc;
- property MaxValue: integer read FMaxValue write SetMaxValue default 100;
- property MinValue: integer read FMinValue write SetMinValue default 0;
- property Increment: integer read FIncrement write SetIncrement default 1;
- property LargeIncrement: integer read FLargeIncrement write SetLargeIncrement default 10;
- property Value: integer read FValue write SetValue default 0;
- property Hint;
- property TabOrder;
+ property EditBackgroundColor: Tfpgcolor read GetEditBackgroundColor write SetEditBackgroundColor default clBoxColor;
+ property ButtonsBackgroundColor;
+ property ButtonWidth;
+ property TextColor: Tfpgcolor read GetTextColor write SetTextColor;
+ property NegativeColor: TfpgColor read GetNegativeColor write SetNegativeColor;
+ property ArrowUpColor;
+ property ArrowDownColor;
+ property FontDesc: string read GetFontDesc write SetFontDesc;
+ property MaxValue: integer read FMaxValue write SetMaxValue default 100;
+ property MinValue: integer read FMinValue write SetMinValue default 0;
+ property Increment: integer read FIncrement write SetIncrement default 1;
+ property LargeIncrement: integer read FLargeIncrement write SetLargeIncrement default 10;
+ property Value: integer read FValue write SetValue default 0;
+ property Hint;
+ property TabOrder;
property OnChange;
property OnEnter;
property OnExit;
@@ -238,7 +238,8 @@ function CreateSpinEditFloat(AOwner: TComponent; x, y, w, h: TfpgCoord;
AFixedDecimals: integer = 1; AValue: extended = 0; ADecimals: integer = -1): TfpgSpinEditFloat;
function CreateSpinEdit(AOwner: TComponent; x, y, w, h: TfpgCoord; AMinValue: integer = 0;
AMaxValue: integer = 100; AIncrement: integer = 1; ALargeIncrement: integer = 10;
- AValue: integer = 0): TfpgSpinEdit;
+ AValue: integer = 0): TfpgSpinEdit; overload;
+function CreateSpinEdit(AOwner: TComponent; x, y, w: TfpgCoord; AOnChangeEvent: TNotifyEvent = nil): TfpgSpinEdit; overload;
implementation
@@ -299,6 +300,15 @@ begin
Result.Value := AValue;
end;
+function CreateSpinEdit(AOwner: TComponent; x, y, w: TfpgCoord; AOnChangeEvent: TNotifyEvent): TfpgSpinEdit;
+begin
+ Result := TfpgSpinEdit.Create(AOwner);
+ Result.SetPosition(x, y, w, Result.Height);
+ if Assigned(AOnChangeEvent) then
+ Result.OnChange := AOnChangeEvent;
+ Result.UpdateWindowPosition;
+end;
+
{ TfpgAbstractSpinEdit }
@@ -427,6 +437,7 @@ end;
constructor TfpgAbstractSpinEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
+ FHeight := 24;
FButtonWidth := 13; // width of spin buttons
Shape := bsSpacer;
diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas
index 8846a7e1..5f0e7fbf 100644
--- a/src/gui/fpg_tab.pas
+++ b/src/gui/fpg_tab.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -55,6 +55,8 @@ type
FPageControl: TfpgPageControl;
FText: string;
FTabVisible: boolean;
+ FTabColor: TfpgColor;
+ FTabTextColor: TfpgColor;
function GetPageControl: TfpgPageControl;
function GetPageIndex: Integer;
function GetText: string;
@@ -72,6 +74,8 @@ type
property PageIndex: Integer read GetPageIndex write SetPageIndex;
property PageControl: TfpgPageControl read FPageControl write SetPageControl;
property TabVisible: boolean read FTabVisible write FTabVisible;
+ property TabColor: Tfpgcolor read FTabColor write FTabColor;
+ property TabTextColor: TfpgColor read FTabTextColor write FTabTextColor;
published
property BackgroundColor;
property Enabled;
@@ -105,6 +109,7 @@ type
FLastRClickPos: TfpgPoint;
FUpdateCount: Integer;
FActiveTabColor: TfpgColor;
+ FActiveTabTextColor: TfpgColor;
function GetActivePageIndex: integer;
function GetPage(AIndex: integer): TfpgTabSheet;
function GetPageCount: Integer;
@@ -130,10 +135,12 @@ type
procedure SetTabPosition(const AValue: TfpgTabPosition);
procedure DoPageChange(ATabSheet: TfpgTabSheet);
procedure DoTabSheetClosing(ATabSheet: TfpgTabSheet);
- function DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+ function DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
procedure pmCloseTab(Sender: TObject);
function GetActiveTabColor: TfpgColor;
procedure SetActiveTabColor(AValue: TfpgColor);
+ function GetActiveTabTextColor: TfpgColor;
+ procedure SetActiveTabTextColor(AValue: TfpgColor);
protected
procedure SetBackgroundColor(const AValue: TfpgColor); override;
procedure OrderSheets; // currently using bubblesort
@@ -159,7 +166,8 @@ type
property OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet;
published
property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex default 0;
- property ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clWindowBackground;
+ property ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clDefault;
+ property ActiveTabTextColor: TfpgColor read GetActiveTabTextColor write SetActiveTabTextColor default clDefault;
property Align;
property BackgroundColor;
property Enabled;
@@ -183,11 +191,6 @@ implementation
uses
fpg_stringutils;
-const
- DFL_TAB_HEIGHT = 21;
- DFL_TAB_WIDTH = 0;
-
-
// compare function used by FPages.Sort
function SortCompare(Item1, Item2: Pointer): integer;
@@ -262,6 +265,7 @@ begin
FTabVisible:= True;
FFocusable := True;
FBackgroundColor := Parent.BackgroundColor;
+ FTabColor := Parent.BackgroundColor;
FTextColor := Parent.TextColor;
FIsContainer := True;
end;
@@ -409,7 +413,6 @@ var
wd: integer; { width delta }
h: integer;
hd: integer; { height delta }
- msg: TfpgMessageParams;
begin
// PageControl has bevelled edges in some themes
r := fpgStyle.GetControlFrameBorders;
@@ -662,10 +665,22 @@ begin
end;
{ Mode = 1 means the background tabs. Mode = 2 means the Active Tab }
-function TfpgPageControl.DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+function TfpgPageControl.DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False;
+ const Mode: Integer = 1): TfpgRect;
var
r: TfpgRect;
+
+ procedure ApplyCorrectTabColorToCanvas;
+ begin
+ if ActiveTabColor = clDefault then
+ Canvas.SetColor(ATabSheet.TabColor)
+ else
+ Canvas.SetColor(ActiveTabColor);
+ end;
+
begin
+ if not Assigned(ATabSheet) then
+ raise Exception.Create('DrawTab parameter error. ATabSheet may not be nil.');
r := rect;
if Selected then
begin
@@ -679,10 +694,10 @@ begin
r.Height -= 1;
if TabPosition = tpBottom then
r.Top += 1;
- Canvas.SetColor(ActiveTabColor);
+ ApplyCorrectTabColorToCanvas;
end
else
- Canvas.SetColor(BackgroundColor);
+ Canvas.SetColor(ATabSheet.TabColor);
case TabPosition of
tpTop:
@@ -714,7 +729,7 @@ begin
Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top-1); // right outer edge
if Mode = 2 then { selected tab }
begin
- Canvas.SetColor(ActiveTabColor);
+ ApplyCorrectTabColorToCanvas;
Canvas.DrawLine(r.Left+1, r.Top-1, r.Right-1, r.Top-1);
end;
end;
@@ -794,6 +809,20 @@ begin
end;
end;
+function TfpgPageControl.GetActiveTabTextColor: TfpgColor;
+begin
+ Result := FActiveTabTextColor;
+end;
+
+procedure TfpgPageControl.SetActiveTabTextColor(AValue: TfpgColor);
+begin
+ if FActiveTabTextColor <> AValue then
+ begin
+ FActiveTabTextColor := AValue;
+ RePaint;
+ end;
+end;
+
procedure TfpgPageControl.SetBackgroundColor(const AValue: TfpgColor);
var
lWasMatch: boolean;
@@ -820,10 +849,17 @@ var
h: TfpgTabSheet;
lp: integer;
toffset: integer;
- TextLeft, TextTop: Integer;
- dx: integer;
lTxtFlags: TfpgTextFlags;
ActivePageVisible: Boolean;
+
+ procedure ApplyCorrectTabTextColorToCanvas(ATab: TfpgTabSheet);
+ begin
+ if ActiveTabTextColor = clDefault then
+ Canvas.SetTextColor(ATab.TabTextColor)
+ else
+ Canvas.SetTextColor(ActiveTabTextColor);
+ end;
+
begin
if not HasHandle then
Exit; //==>
@@ -831,10 +867,10 @@ begin
if PageCount = 0 then
Exit; //==>
- TabW:=FixedTabWidth;
- TabH:=FixedTabHeight;
+ TabW := FixedTabWidth;
+ TabH := FixedTabHeight;
ActivePageVisible := false;
- If TabH = 0 then
+ if TabH <= 1 then
TabH := TAB_HEIGHT;
h := TfpgTabSheet(FPages.First);
if h = nil then
@@ -845,7 +881,6 @@ begin
if not Enabled then
Include(lTxtFlags, txtDisabled);
-
if TabPosition in [tpTop, tpBottom] then
begin
if MaxButtonWidthSum > (Width-(FMargin*2)) then
@@ -944,12 +979,14 @@ begin
end;
// paint tab button
r2.Width := ButtonWidth(h.Text);
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
Height-TabH+toffset, GetTabText(h.Text), lTxtFlags);
-
+ end;
r2.Left := r2.Left + r2.Width;
lp := lp + ButtonWidth(h.Text);
if h <> TfpgTabSheet(FPages.Last) then
@@ -963,8 +1000,11 @@ begin
r2.Width := Width;
r2.Height := Height - TabH;
Canvas.DrawButtonFace(r2, []);
+
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.Left+4, r3.Top+5, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -988,11 +1028,14 @@ begin
end;
// paint tab button
r2.Width := ButtonWidth(h.Text);
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
FMargin+toffset, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Left := r2.Left + r2.Width;
lp := lp + ButtonWidth(h.Text);
if h <> TfpgTabSheet(FPages.Last) then
@@ -1008,7 +1051,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -1033,11 +1078,14 @@ begin
h.SetPosition(FMargin+2, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
end;
// paint tab button
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Top += r2.Height;
lp := r2.Top;
if h <> TfpgTabSheet(FPages.Last) then
@@ -1053,7 +1101,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -1078,11 +1128,14 @@ begin
h.SetPosition(FMargin+2+TabW, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
end;
// paint tab button
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Top += r2.Height;
lp := r2.Top;
if h <> TfpgTabSheet(FPages.Last) then
@@ -1098,7 +1151,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
end; { case }
@@ -1188,26 +1243,24 @@ var
i: integer;
begin
i := ActivePageIndex;
- if ssAlt in shiftstate then
- case keycode of
- keyLeft:
- begin
- if ActivePage <> TfpgTabSheet(FPages.First) then
- begin
- ActivePage := TfpgTabSheet(FPages[i-1]);
- consumed := True;
- end;
- end;
- keyRight:
- begin
- if ActivePage <> TfpgTabSheet(FPages.Last) then
- begin
- ActivePage := TfpgTabSheet(FPages[i+1]);
- consumed := True;
- end;
- end;
- end; { case/else }
+ if (shiftstate = [ssCtrl]) and (keycode = keyTab) then
+ begin
+ consumed := True;
+ if ActivePage <> TfpgTabSheet(FPages.Last) then
+ ActivePage := TfpgTabSheet(FPages[i+1])
+ else
+ ActivePage := TfpgTabSheet(FPages.First); // loop back to the front
+ end
+ else if (shiftstate = [ssCtrl, ssShift]) and (keycode = keyTab) then
+ begin
+ consumed := True;
+ if ActivePage <> TfpgTabSheet(FPages.First) then
+ ActivePage := TfpgTabSheet(FPages[i-1])
+ else
+ ActivePage := TfpgTabSheet(FPages.Last); // loop back to the end
+ end;
+
if not consumed then
inherited HandleKeyPress(keycode, shiftstate, consumed);
end;
@@ -1231,7 +1284,8 @@ begin
FTextColor := Parent.TextColor;
FBackgroundColor := Parent.BackgroundColor;
- FActiveTabColor := FBackgroundColor;
+ FActiveTabColor := clDefault;
+ FActiveTabTextColor := clDefault;
FFocusable := True;
FOnChange := nil;
FFixedTabWidth := 0;
diff --git a/src/gui/fpg_trackbar.pas b/src/gui/fpg_trackbar.pas
index 32da0b99..752ae132 100644
--- a/src/gui/fpg_trackbar.pas
+++ b/src/gui/fpg_trackbar.pas
@@ -480,7 +480,7 @@ var
d: integer;
area: integer;
newp: integer;
- ppos: integer;
+ //ppos: integer;
tw: TfpgCoord;
begin
inherited HandleMouseMove(x, y, btnstate, shiftstate);
@@ -506,7 +506,7 @@ begin
area := Width - FSliderLength-4-tw;
end;
- ppos := FSliderPos;
+ //ppos := FSliderPos;
FSliderPos := FSliderDragStart + d;
if FSliderPos < 0 then
diff --git a/src/gui/messagedialog.inc b/src/gui/messagedialog.inc
index db894f6d..7fea78e8 100644
--- a/src/gui/messagedialog.inc
+++ b/src/gui/messagedialog.inc
@@ -260,7 +260,6 @@ var
logo: TfpgImage;
i: integer;
y: integer;
- tw: integer;
begin
inherited HandlePaint;
case FDialogType of
diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc
index 063c7972..857fb0a2 100644
--- a/src/gui/selectdirdialog.inc
+++ b/src/gui/selectdirdialog.inc
@@ -197,7 +197,6 @@ var
s: TfpgString;
dir: TfpgString;
i: integer;
- p: integer;
prevn, nextn: TfpgTreeNode;
begin
if AValue = '' then
diff --git a/src/reportengine/u_command.pas b/src/reportengine/u_command.pas
index c6746d0d..8d3deaab 100644
--- a/src/reportengine/u_command.pas
+++ b/src/reportengine/u_command.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
diff --git a/src/reportengine/u_pdf.pas b/src/reportengine/u_pdf.pas
index f6222cf2..0c9917ea 100644
--- a/src/reportengine/u_pdf.pas
+++ b/src/reportengine/u_pdf.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -32,127 +32,120 @@ uses
fpg_base;
type
- TPdfObjet = class(TObject)
+ TPdfObject = class(TObject)
public
constructor Create; virtual;
destructor Destroy; override;
end;
- TPdfBoolean = class(TPdfObjet)
+ TPdfBoolean = class(TPdfObject)
private
FValue: Boolean;
protected
- procedure WriteBoolean(const AFlux: TStream);
+ procedure WriteBoolean(const AStream: TStream);
public
constructor CreateBoolean(const AValue: Boolean);
- destructor Destroy; override;
end;
- TPdfInteger = class(TPdfObjet)
+ TPdfInteger = class(TPdfObject)
private
FValue: integer;
protected
- procedure WriteInteger(const AFlux: TStream);
+ procedure WriteInteger(const AStream: TStream);
procedure IncrementeInteger;
property Value: integer read FValue write FValue;
public
constructor CreateInteger(const AValue: integer);
- destructor Destroy; override;
end;
- TPdfReference = class(TPdfObjet)
+ TPdfReference = class(TPdfObject)
private
FValue: integer;
protected
- procedure WriteReference(const AFlux: TStream);
+ procedure WriteReference(const AStream: TStream);
public
constructor CreateReference(const AValue: integer);
- destructor Destroy; override;
end;
- TPdfName = class(TPdfObjet)
+ TPdfName = class(TPdfObject)
private
FValue: string;
protected
- procedure WriteName(const AFlux: TStream);
+ procedure WriteName(const AStream: TStream);
public
constructor CreateName(const AValue: string);
- destructor Destroy; override;
end;
- TPdfString = class(TPdfObjet)
+ TPdfString = class(TPdfObject)
private
FValue: string;
protected
- procedure WriteString(const AFlux: TStream);
+ procedure Write(const AStream: TStream);
public
constructor CreateString(const AValue: string);
- destructor Destroy; override;
end;
- TPdfArray = class(TPdfObjet)
+ TPdfArray = class(TPdfObject)
private
FArray: TList;
protected
- procedure WriteArray(const AFlux: TStream);
- procedure AddItem(const AValue: TPdfObjet);
+ procedure WriteArray(const AStream: TStream);
+ procedure AddItem(const AValue: TPdfObject);
public
constructor CreateArray;
destructor Destroy; override;
end;
- TPdfStream = class(TPdfObjet)
+ TPdfStream = class(TPdfObject)
private
FStream: TList;
protected
- procedure WriteStream(const AFlux: TStream);
- procedure AddItem(const AValue: TPdfObjet);
+ procedure WriteStream(const AStream: TStream);
+ procedure AddItem(const AValue: TPdfObject);
public
constructor CreateStream;
destructor Destroy; override;
end;
- TPdfFonte = class(TPdfObjet)
+ TPdfEmbeddedFont = class(TPdfObject)
private
FTxtFont: integer;
FTxtSize: string;
protected
- procedure WriteFonte(const AFlux: TStream);
- function WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): int64;
+ procedure WriteFont(const AStream: TStream);
+ function WriteEmbeddedFont(const ASrcStream: TMemoryStream; const AStream: TStream): int64;
public
- constructor CreateFonte(const AFont: integer; const ASize: string);
- destructor Destroy; override;
+ constructor CreateFont(const AFont: integer; const ASize: string);
end;
- TPdfText = class(TPdfObjet)
+ TPdfText = class(TPdfObject)
private
FTxtPosX: single;
FTxtPosY: single;
FTxtText: TPdfString;
protected
- procedure WriteText(const AFlux: TStream);
+ procedure WriteText(const AStream: TStream);
public
constructor CreateText(const APosX, APosY: single; const AText: string);
destructor Destroy; override;
end;
- TPdfLigne = class(TPdfObjet)
+ TPdfLineSegment = class(TPdfObject)
private
- FEpais: single;
- FStaX: single;
- FStaY: single;
- FEndX: single;
- FEndY: single;
+ FWidth: single;
+ FX1: single;
+ FY1: single;
+ FX2: single;
+ FY2: single;
protected
- procedure WriteLigne(const AFlux: TStream);
+ procedure WriteLineSegment(const AStream: TStream);
public
- constructor CreateLigne(const AEpais, AStaX, AStaY, AEndX, AEndY: single);
- destructor Destroy; override;
+ constructor CreateLineSegment(const AWidth, AX1, AY1, AX2, AY2: single);
end;
- TPdfRectangle = class(TPdfObjet)
+ TPdfRectangle = class(TPdfObject)
private
- FEpais: single;
+ FLineWidth: single;
FRecX: single;
FRecY: single;
FRecW: single;
@@ -160,10 +153,9 @@ type
FFill: Boolean;
FStroke: Boolean;
protected
- procedure WriteRectangle(const AFlux: TStream);
+ procedure WriteRectangle(const AStream: TStream);
public
- constructor CreateRectangle(const AEpais, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean);
- destructor Destroy; override;
+ constructor CreateRectangle(const ALineWidth, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean);
end;
TRefPos = record
@@ -173,17 +165,16 @@ type
T_Points = array of TRefPos;
- TPdfSurface = class(TPdfObjet)
+ TPdfSurface = class(TPdfObject)
private
FPoints: T_Points;
protected
- procedure WriteSurface(const AFlux: TStream);
+ procedure WriteSurface(const AStream: TStream);
public
constructor CreateSurface(const APoints: T_Points);
- destructor Destroy; override;
end;
- TPdfImage = class(TPdfObjet)
+ TPdfImage = class(TPdfObject)
private
FNumber: integer;
FLeft: single;
@@ -191,55 +182,52 @@ type
FWidth: integer;
FHeight: integer;
protected
- function WriteImageStream(const ANumber: integer; AFlux: TStream): int64;
- procedure WriteImage(const AFlux: TStream);
+ function WriteImageStream(const ANumber: integer; AStream: TStream): int64;
+ procedure WriteImage(const AStream: TStream);
public
constructor CreateImage(const ALeft, ABottom: single; AWidth, AHeight, ANumber: integer);
- destructor Destroy; override;
end;
- TPdfLineStyle = class(TPdfObjet)
+ TPdfLineStyle = class(TPdfObject)
private
FDash: TfpgLineStyle;
FPhase: integer;
protected
- procedure WriteLineStyle(const AFlux: TStream);
+ procedure WriteLineStyle(const AStream: TStream);
public
constructor CreateLineStyle(ADash: TfpgLineStyle; APhase: integer);
- destructor Destroy; override;
end;
- TPdfColor = class(TPdfObjet)
+ TPdfColor = class(TPdfObject)
private
FRed: string;
FGreen: string;
FBlue: string;
FStroke: Boolean;
protected
- procedure WriteColor(const AFlux: TStream);
+ procedure WriteColor(const AStream: TStream);
public
constructor CreateColor(const AStroke: Boolean; AColor: TfpgColor);
- destructor Destroy; override;
end;
TPdfDicElement = class(TObject)
private
FKey: TPdfName;
- FValue: TPdfObjet;
+ FValue: TPdfObject;
protected
- procedure WriteDicElement(const AFlux: TStream);
+ procedure WriteDicElement(const AStream: TStream);
public
- constructor CreateDicElement(const AKey: string; const AValue: TPdfObjet);
+ constructor CreateDicElement(const AKey: string; const AValue: TPdfObject);
destructor Destroy; override;
end;
- TPdfDictionary = class(TPdfObjet)
+ TPdfDictionary = class(TPdfObject)
private
FElement: TList; // list of TPdfDicElement
protected
- procedure AddElement(const AKey: string; const AValue: TPdfObjet);
+ procedure AddElement(const AKey: string; const AValue: TPdfObject);
function ElementParCle(const AValue: string): integer;
- procedure WriteDictionary(const AObjet: integer; const AFlux: TStream);
+ procedure WriteDictionary(const AObjet: integer; const AStream: TStream);
public
constructor CreateDictionary;
destructor Destroy; override;
@@ -248,14 +236,15 @@ type
TPdfXRef = class(TObject)
private
FOffset: integer;
- FObjet: TPdfDictionary;
+ FDict: TPdfDictionary;
FStream: TPdfStream;
protected
- procedure WriteXRef(const AFlux: TStream);
+ procedure WriteXRef(const AStream: TStream);
public
constructor CreateXRef;
destructor Destroy; override;
property Offset: integer read FOffset write FOffset;
+ Property Dict: TPdfDictionary read FDict;
end;
TPageLayout = (lSingle, lTwo, lContinuous);
@@ -265,11 +254,11 @@ type
FPreferences: Boolean;
FPageLayout: TPageLayout;
FZoomValue: string;
- FXRefObjets: TList; // list of TPdfXRef
+ FGlobalXRefs: TList; // list of TPdfXRef
protected
function ElementParNom(const AValue: string): integer;
- procedure WriteXRefTable(const AFlux: TStream);
- procedure WriteObjet(const AObjet: integer; const AFlux: TStream);
+ procedure WriteXRefTable(const AStream: TStream);
+ procedure WriteObject(const AObject: integer; const AStream: TStream);
procedure CreateRefTable;
procedure CreateTrailer;
function CreateCatalog: integer;
@@ -280,19 +269,19 @@ type
function CreateOutlines: integer;
function CreateOutline(Parent, SectNo, PageNo: integer; SectTitre: string): integer;
procedure CreateStdFont(NomFonte: string; NumFonte: integer);
- function LoadFont(NomFonte: string): string;
+ function LoadFont(AFontName: string): string;
procedure CreateTtfFont(const NumFonte: integer);
procedure CreateTp1Font(const NumFonte: integer);
procedure CreateFontDescriptor(const NumFonte: integer);
procedure CreateFontWidth;
procedure CreateFontFile(const NumFonte: integer);
- procedure CreateImage(ImgWidth, ImgHeight, NumImg: integer);
+ procedure CreateImage(ImgWidth, ImgHeight, ImgNumber: integer);
function CreateContents: integer;
procedure CreateStream(NumeroPage, PageNum: integer);
public
constructor CreateDocument(const ALayout: TPageLayout = lSingle; const AZoom: string = '100'; const APreferences: Boolean = True);
destructor Destroy; override;
- procedure WriteDocument(const AFlux: TStream);
+ procedure WriteDocument(const AStream: TStream);
property PageLayout: TPageLayout read FPageLayout write FPageLayout default lSingle;
end;
@@ -320,7 +309,7 @@ const
PDF_FILE_END = '%%EOF';
PDF_MAX_GEN_NUM = 65535;
PDF_UNICODE_HEADER = 'FEFF001B%s001B';
- PDF_LANG_STRING = 'fr';
+ PDF_LANG_STRING = 'en';
var
Document: TPdfDocument;
@@ -339,67 +328,47 @@ uses
U_Command;
var
- Trailer: TPdfDictionary;
- CurrentColor: string;
- CurrentWidth: string;
- Catalogue: integer;
- FontDef: TFontDef;
- Flux: TMemoryStream;
- FontFiles: array of string;
+ uDictionary: TPdfDictionary;
+ uCurrentColor: string;
+ uCurrentWidth: string;
+ uCatalogue: integer;
+ uFontDef: TFontDef;
+ uStream: TMemoryStream;
+ uFontFiles: array of string;
// utility functions
function InsertEscape(const AValue: string): string;
var
- Chaine: string;
+ S: string;
begin
Result := '';
- Chaine := AValue;
- if Pos('\', Chaine) > 0 then
- Chaine := AnsiReplaceStr(Chaine, '\', '\\');
- if Pos('(', Chaine) > 0 then
- Chaine := AnsiReplaceStr(Chaine, '(', '\(');
- if Pos(')', Chaine) > 0 then
- Chaine := AnsiReplaceStr(Chaine, ')', '\)');
- Result := Chaine;
- //while Pos('\',Chaine)> 0 do
- // begin
- // Result:= Result+Copy(Chaine,1,Pred(Pos('\',Chaine)))+'\\';
- // Chaine:= Copy(Chaine,Succ(Pos('\',Chaine)),Length(Chaine)-Pos('\',Chaine));
- // end;
- //Chaine:= Result+Chaine;
- //Result:= '';
- //while Pos('(',Chaine)> 0 do
- // begin
- // Result:= Result+Copy(Chaine,1,Pred(Pos('(',Chaine)))+'\(';
- // Chaine:= Copy(Chaine,Succ(Pos('(',Chaine)),Length(Chaine)-Pos('(',Chaine));
- // end;
- //Chaine:= Result+Chaine;
- //Result:= '';
- //while Pos(')',Chaine)> 0 do
- // begin
- // Result:= Result+Copy(Chaine,1,Pred(Pos(')',Chaine)))+'\)';
- // Chaine:= Copy(Chaine,Succ(Pos(')',Chaine)),Length(Chaine)-Pos(')',Chaine));
- // end;
- //Result:= Result+Chaine;
-end;
-
-procedure WriteChaine(const Valeur: string; AFlux: TStream);
-begin
- AFlux.Write(PChar(Valeur)^, Length(Valeur));
-end;
-
-function IntToChaine(const Valeur: integer; const Long: integer): string;
+ S := AValue;
+ if Pos('\', S) > 0 then
+ S := AnsiReplaceStr(S, '\', '\\');
+ if Pos('(', S) > 0 then
+ S := AnsiReplaceStr(S, '(', '\(');
+ if Pos(')', S) > 0 then
+ S := AnsiReplaceStr(S, ')', '\)');
+ Result := S;
+end;
+
+procedure WriteString(const AValue: string; AStream: TStream);
+begin
+ AStream.Write(PChar(AValue)^, Length(AValue));
+end;
+
+function IntToString(const AValue: integer; const ALength: integer): string;
var
- Chaine: string;
+ S: string;
Cpt: integer;
begin
Result := '';
- Chaine := IntToStr(Valeur);
- if Length(Chaine) < Long then
- for Cpt := Succ(Length(Chaine)) to Long do
+ S := IntToStr(AValue);
+ if Length(S) < ALength then
+ for Cpt := Succ(Length(S)) to ALength do
Result := Result + '0';
- Result := Result + Chaine;
+ Result := Result + S;
end;
function DateToPdfDate(const ADate: TDateTime): string;
@@ -431,22 +400,22 @@ end;
// object methods
-constructor TPdfObjet.Create;
+constructor TPdfObject.Create;
begin
- // to be implemented by descendents
+ // to be implemented by descendants
end;
-destructor TPdfObjet.Destroy;
+destructor TPdfObject.Destroy;
begin
inherited;
end;
-procedure TPdfBoolean.WriteBoolean(const AFlux: TStream);
+procedure TPdfBoolean.WriteBoolean(const AStream: TStream);
begin
if FValue then
- WriteChaine('true', AFlux)
+ WriteString('true', AStream)
else
- WriteChaine('false', AFlux);
+ WriteString('false', AStream);
end;
constructor TPdfBoolean.CreateBoolean(const AValue: Boolean);
@@ -455,14 +424,9 @@ begin
FValue := AValue;
end;
-destructor TPdfBoolean.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfInteger.WriteInteger(const AFlux: TStream);
+procedure TPdfInteger.WriteInteger(const AStream: TStream);
begin
- WriteChaine(IntToStr(FValue), AFlux);
+ WriteString(IntToStr(FValue), AStream);
end;
procedure TPdfInteger.IncrementeInteger;
@@ -476,14 +440,9 @@ begin
FValue := AValue;
end;
-destructor TPdfInteger.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfReference.WriteReference(const AFlux: TStream);
+procedure TPdfReference.WriteReference(const AStream: TStream);
begin
- WriteChaine(IntToStr(FValue) + ' 0 R', AFlux);
+ WriteString(IntToStr(FValue) + ' 0 R', AStream);
end;
constructor TPdfReference.CreateReference(const AValue: integer);
@@ -492,18 +451,13 @@ begin
FValue := AValue;
end;
-destructor TPdfReference.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfName.WriteName(const AFlux: TStream);
+procedure TPdfName.WriteName(const AStream: TStream);
begin
if FValue <> '' then
if Pos('Length1', FValue) > 0 then
- WriteChaine('/Length1', AFlux)
+ WriteString('/Length1', AStream)
else
- WriteChaine('/' + FValue, AFlux);
+ WriteString('/' + FValue, AStream);
end;
constructor TPdfName.CreateName(const AValue: string);
@@ -512,14 +466,9 @@ begin
FValue := AValue;
end;
-destructor TPdfName.Destroy;
+procedure TPdfString.Write(const AStream: TStream);
begin
- inherited;
-end;
-
-procedure TPdfString.WriteString(const AFlux: TStream);
-begin
- WriteChaine('(' + Utf8ToAnsi(FValue) + ')', AFlux);
+ WriteString('(' + Utf8ToAnsi(FValue) + ')', AStream);
end;
constructor TPdfString.CreateString(const AValue: string);
@@ -530,31 +479,26 @@ begin
FValue := InsertEscape(FValue);
end;
-destructor TPdfString.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfArray.WriteArray(const AFlux: TStream);
+procedure TPdfArray.WriteArray(const AStream: TStream);
var
Cpt: integer;
begin
- WriteChaine('[', AFlux);
+ WriteString('[', AStream);
for Cpt := 0 to Pred(FArray.Count) do
begin
if Cpt > 0 then
- WriteChaine(' ', AFlux);
- if TPdfObjet(FArray[Cpt]) is TPdfInteger then
- TPdfInteger(FArray[Cpt]).WriteInteger(AFlux);
- if TPdfObjet(FArray[Cpt]) is TPdfReference then
- TPdfReference(FArray[Cpt]).WriteReference(AFlux);
- if TPdfObjet(FArray[Cpt]) is TPdfName then
- TPdfName(FArray[Cpt]).WriteName(AFlux);
+ WriteString(' ', AStream);
+ if TPdfObject(FArray[Cpt]) is TPdfInteger then
+ TPdfInteger(FArray[Cpt]).WriteInteger(AStream);
+ if TPdfObject(FArray[Cpt]) is TPdfReference then
+ TPdfReference(FArray[Cpt]).WriteReference(AStream);
+ if TPdfObject(FArray[Cpt]) is TPdfName then
+ TPdfName(FArray[Cpt]).WriteName(AStream);
end;
- WriteChaine(']', AFlux);
+ WriteString(']', AStream);
end;
-procedure TPdfArray.AddItem(const AValue: TPdfObjet);
+procedure TPdfArray.AddItem(const AValue: TPdfObject);
begin
FArray.Add(AValue);
end;
@@ -571,42 +515,42 @@ var
begin
if FArray.Count > 0 then
for Cpt := 0 to Pred(FArray.Count) do
- if TPdfObjet(FArray[Cpt]) is TPdfInteger then
+ if TPdfObject(FArray[Cpt]) is TPdfInteger then
TPdfInteger(FArray[Cpt]).Free
- else if TPdfObjet(FArray[Cpt]) is TPdfReference then
+ else if TPdfObject(FArray[Cpt]) is TPdfReference then
TPdfReference(FArray[Cpt]).Free
- else if TPdfObjet(FArray[Cpt]) is TPdfName then
+ else if TPdfObject(FArray[Cpt]) is TPdfName then
TPdfName(FArray[Cpt]).Free;
FArray.Free;
inherited;
end;
-procedure TPdfStream.WriteStream(const AFlux: TStream);
+procedure TPdfStream.WriteStream(const AStream: TStream);
var
Cpt: integer;
begin
for Cpt := 0 to Pred(FStream.Count) do
begin
- if TPdfObjet(FStream[Cpt]) is TPdfFonte then
- TPdfFonte(FStream[Cpt]).WriteFonte(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfColor then
- TPdfColor(FStream[Cpt]).WriteColor(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfText then
- TPdfText(FStream[Cpt]).WriteText(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfRectangle then
- TPdfRectangle(FStream[Cpt]).WriteRectangle(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfLigne then
- TPdfLigne(FStream[Cpt]).WriteLigne(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfLineStyle then
- TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfSurface then
- TPdfSurface(FStream[Cpt]).WriteSurface(AFlux);
- if TPdfObjet(FStream[Cpt]) is TPdfImage then
- TPdfImage(FStream[Cpt]).WriteImage(AFlux);
+ if TPdfObject(FStream[Cpt]) is TPdfEmbeddedFont then
+ TPdfEmbeddedFont(FStream[Cpt]).WriteFont(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfColor then
+ TPdfColor(FStream[Cpt]).WriteColor(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfText then
+ TPdfText(FStream[Cpt]).WriteText(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfRectangle then
+ TPdfRectangle(FStream[Cpt]).WriteRectangle(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfLineSegment then
+ TPdfLineSegment(FStream[Cpt]).WriteLineSegment(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfLineStyle then
+ TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfSurface then
+ TPdfSurface(FStream[Cpt]).WriteSurface(AStream);
+ if TPdfObject(FStream[Cpt]) is TPdfImage then
+ TPdfImage(FStream[Cpt]).WriteImage(AStream);
end;
end;
-procedure TPdfStream.AddItem(const AValue: TPdfObjet);
+procedure TPdfStream.AddItem(const AValue: TPdfObject);
begin
FStream.Add(AValue);
end;
@@ -625,21 +569,21 @@ begin
begin
for Cpt := 0 to Pred(FStream.Count) do
begin
- if TPdfObjet(FStream[Cpt]) is TPdfFonte then
- TPdfFonte(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfColor then
+ if TPdfObject(FStream[Cpt]) is TPdfEmbeddedFont then
+ TPdfEmbeddedFont(FStream[Cpt]).Free
+ else if TPdfObject(FStream[Cpt]) is TPdfColor then
TPdfColor(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfText then
+ else if TPdfObject(FStream[Cpt]) is TPdfText then
TPdfText(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfRectangle then
+ else if TPdfObject(FStream[Cpt]) is TPdfRectangle then
TPdfRectangle(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfLigne then
- TPdfLigne(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfLineStyle then
+ else if TPdfObject(FStream[Cpt]) is TPdfLineSegment then
+ TPdfLineSegment(FStream[Cpt]).Free
+ else if TPdfObject(FStream[Cpt]) is TPdfLineStyle then
TPdfLineStyle(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfSurface then
+ else if TPdfObject(FStream[Cpt]) is TPdfSurface then
TPdfSurface(FStream[Cpt]).Free
- else if TPdfObjet(FStream[Cpt]) is TPdfImage then
+ else if TPdfObject(FStream[Cpt]) is TPdfImage then
TPdfImage(FStream[Cpt]).Free;
end;
end;
@@ -647,43 +591,38 @@ begin
inherited;
end;
-procedure TPdfFonte.WriteFonte(const AFlux: TStream);
+procedure TPdfEmbeddedFont.WriteFont(const AStream: TStream);
begin
- WriteChaine('/F' + IntToStr(FTxtFont) + ' ' + FTxtSize + ' Tf' + CRLF, AFlux);
+ WriteString('/F' + IntToStr(FTxtFont) + ' ' + FTxtSize + ' Tf' + CRLF, AStream);
end;
-function TPdfFonte.WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): int64;
+function TPdfEmbeddedFont.WriteEmbeddedFont(const ASrcStream: TMemoryStream; const AStream: TStream): int64;
var
BeginFlux, EndFlux: int64;
begin
- WriteChaine(CRLF + 'stream' + CRLF, AFlux);
- BeginFlux := AFlux.Position;
- FFlux.SaveToStream(AFlux);
- EndFlux := AFlux.Position;
+ WriteString(CRLF + 'stream' + CRLF, AStream);
+ BeginFlux := AStream.Position;
+ ASrcStream.SaveToStream(AStream);
+ EndFlux := AStream.Position;
Result := EndFlux - BeginFlux;
- WriteChaine(CRLF, AFlux);
- WriteChaine('endstream', AFlux);
+ WriteString(CRLF, AStream);
+ WriteString('endstream', AStream);
end;
-constructor TPdfFonte.CreateFonte(const AFont: integer; const ASize: string);
+constructor TPdfEmbeddedFont.CreateFont(const AFont: integer; const ASize: string);
begin
inherited Create;
FTxtFont := AFont;
FTxtSize := ASize;
end;
-destructor TPdfFonte.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfText.WriteText(const AFlux: TStream);
+procedure TPdfText.WriteText(const AStream: TStream);
begin
- WriteChaine('BT' + CRLF, AFlux);
- WriteChaine(FormatFloat('0.##', FTxtPosX) + ' ' + FormatFloat('0.##', FTxtPosY) + ' Td' + CRLF, AFlux);
- TPdfString(FTxtText).WriteString(AFlux);
- WriteChaine(' Tj' + CRLF, AFlux);
- WriteChaine('ET' + CRLF, AFlux);
+ WriteString('BT' + CRLF, AStream);
+ WriteString(FormatFloat('0.##', FTxtPosX) + ' ' + FormatFloat('0.##', FTxtPosY) + ' Td' + CRLF, AStream);
+ TPdfString(FTxtText).Write(AStream);
+ WriteString(' Tj' + CRLF, AStream);
+ WriteString('ET' + CRLF, AStream);
end;
constructor TPdfText.CreateText(const APosX, APosY: single; const AText: string);
@@ -700,56 +639,51 @@ begin
inherited;
end;
-procedure TPdfLigne.WriteLigne(const AFlux: TStream);
+procedure TPdfLineSegment.WriteLineSegment(const AStream: TStream);
begin
- if (FormatFloat('0.##', FEpais) + ' w') <> CurrentWidth then
+ if (FormatFloat('0.##', FWidth) + ' w') <> uCurrentWidth then
begin
- WriteChaine('1 J' + CRLF, AFlux);
- WriteChaine(FormatFloat('0.##', FEpais) + ' w' + CRLF, AFlux);
- CurrentWidth := FormatFloat('0.##', FEpais) + ' w';
+ WriteString('1 J' + CRLF, AStream);
+ WriteString(FormatFloat('0.##', FWidth) + ' w' + CRLF, AStream);
+ uCurrentWidth := FormatFloat('0.##', FWidth) + ' w';
end;
- WriteChaine(FormatFloat('0.##', FStaX) + ' ' + FormatFloat('0.##', FStaY) + ' m' + CRLF, AFlux);
- WriteChaine(FormatFloat('0.##', FEndX) + ' ' + FormatFloat('0.##', FEndY) + ' l' + CRLF, AFlux);
- WriteChaine('S' + CRLF, AFlux);
+ WriteString(FormatFloat('0.##', FX1) + ' ' + FormatFloat('0.##', FY1) + ' m' + CRLF, AStream);
+ WriteString(FormatFloat('0.##', FX2) + ' ' + FormatFloat('0.##', FY2) + ' l' + CRLF, AStream);
+ WriteString('S' + CRLF, AStream);
end;
-constructor TPdfLigne.CreateLigne(const AEpais, AStaX, AStaY, AEndX, AEndY: single);
+constructor TPdfLineSegment.CreateLineSegment(const AWidth, AX1, AY1, AX2, AY2: single);
begin
inherited Create;
- FEpais := AEpais;
- FStaX := AStaX;
- FStaY := AStaY;
- FEndX := AEndX;
- FEndY := AEndY;
+ FWidth := AWidth;
+ FX1 := AX1;
+ FY1 := AY1;
+ FX2 := AX2;
+ FY2 := AY2;
end;
-destructor TPdfLigne.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfRectangle.WriteRectangle(const AFlux: TStream);
+procedure TPdfRectangle.WriteRectangle(const AStream: TStream);
begin
if FStroke then
begin
- if (FormatFloat('0.##', FEpais) + ' w') <> CurrentWidth then
+ if (FormatFloat('0.##', FLineWidth) + ' w') <> uCurrentWidth then
begin
- WriteChaine('1 J' + CRLF, AFlux);
- WriteChaine(FormatFloat('0.##', FEpais) + ' w' + CRLF, AFlux);
- CurrentWidth := FormatFloat('0.##', FEpais) + ' w';
+ WriteString('1 J' + CRLF, AStream);
+ WriteString(FormatFloat('0.##', FLineWidth) + ' w' + CRLF, AStream);
+ uCurrentWidth := FormatFloat('0.##', FLineWidth) + ' w';
end;
end;
- WriteChaine(FormatFloat('0.##', FRecX) + ' ' + FormatFloat('0.##', FRecY) + ' ' + FormatFloat('0.##', FRecW) + ' ' + FormatFloat('0.##', FRecH) + ' re' + CRLF, AFlux);
+ WriteString(FormatFloat('0.##', FRecX) + ' ' + FormatFloat('0.##', FRecY) + ' ' + FormatFloat('0.##', FRecW) + ' ' + FormatFloat('0.##', FRecH) + ' re' + CRLF, AStream);
if FStroke then
- WriteChaine('S' + CRLF, AFlux);
+ WriteString('S' + CRLF, AStream);
if FFill then
- WriteChaine('f' + CRLF, AFlux);
+ WriteString('f' + CRLF, AStream);
end;
-constructor TPdfRectangle.CreateRectangle(const AEpais, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean);
+constructor TPdfRectangle.CreateRectangle(const ALineWidth, APosX, APosY, AWidth, AHeight: single; const AFill, AStroke: Boolean);
begin
inherited Create;
- FEpais := AEpais;
+ FLineWidth := ALineWidth;
FRecX := APosX;
FRecY := APosY;
FRecW := AWidth;
@@ -758,20 +692,15 @@ begin
FStroke := AStroke;
end;
-destructor TPdfRectangle.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfSurface.WriteSurface(const AFlux: TStream);
+procedure TPdfSurface.WriteSurface(const AStream: TStream);
var
Cpt: integer;
begin
- WriteChaine(FormatFloat('0.##', FPoints[0].X) + ' ' + FormatFloat('0.##', FPoints[0].Y) + ' m' + CRLF, AFlux);
+ WriteString(FormatFloat('0.##', FPoints[0].X) + ' ' + FormatFloat('0.##', FPoints[0].Y) + ' m' + CRLF, AStream);
for Cpt := 1 to Pred(Length(FPoints)) do
- WriteChaine(FormatFloat('0.##', FPoints[Cpt].X) + ' ' + FormatFloat('0.##', FPoints[Cpt].Y) + ' l' + CRLF, AFlux);
- WriteChaine('h' + CRLF, AFlux);
- WriteChaine('f' + CRLF, AFlux);
+ WriteString(FormatFloat('0.##', FPoints[Cpt].X) + ' ' + FormatFloat('0.##', FPoints[Cpt].Y) + ' l' + CRLF, AStream);
+ WriteString('h' + CRLF, AStream);
+ WriteString('f' + CRLF, AStream);
end;
constructor TPdfSurface.CreateSurface(const APoints: T_Points);
@@ -780,39 +709,34 @@ begin
FPoints := APoints;
end;
-destructor TPdfSurface.Destroy;
-begin
- inherited;
-end;
-
-function TPdfImage.WriteImageStream(const ANumber: integer; AFlux: TStream): int64;
+function TPdfImage.WriteImageStream(const ANumber: integer; AStream: TStream): int64;
var
CptW, CptH: integer;
BeginFlux, EndFlux: int64;
begin
- WriteChaine(CRLF + 'stream' + CRLF, AFlux);
- BeginFlux := AFlux.Position;
+ WriteString(CRLF + 'stream' + CRLF, AStream);
+ BeginFlux := AStream.Position;
for CptH := 0 to Pred(TfpgImage(Images[ANumber]).Height) do
begin
for CptW := 0 to Pred(TfpgImage(Images[ANumber]).Width) do
begin
- AFlux.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
- AFlux.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
- AFlux.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
+ AStream.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
+ AStream.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
+ AStream.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW, CptH]));
end;
end;
- EndFlux := AFlux.Position;
+ EndFlux := AStream.Position;
Result := EndFlux - BeginFlux;
- WriteChaine(CRLF, AFlux);
- WriteChaine('endstream', AFlux);
+ WriteString(CRLF, AStream);
+ WriteString('endstream', AStream);
end;
-procedure TPdfImage.WriteImage(const AFlux: TStream);
+procedure TPdfImage.WriteImage(const AStream: TStream);
begin
- WriteChaine('q' + CRLF, AFlux);
- WriteChaine(IntToStr(FWidth) + ' 0 0 ' + IntToStr(FHeight) + ' ' + FormatFloat('0.##', FLeft) + ' ' + FormatFloat('0.##', FBottom) + ' cm' + CRLF, AFlux);
- WriteChaine('/I' + IntToStr(FNumber) + ' Do ' + CRLF, AFlux);
- WriteChaine('Q' + CRLF, AFlux);
+ WriteString('q' + CRLF, AStream);
+ WriteString(IntToStr(FWidth) + ' 0 0 ' + IntToStr(FHeight) + ' ' + FormatFloat('0.##', FLeft) + ' ' + FormatFloat('0.##', FBottom) + ' cm' + CRLF, AStream);
+ WriteString('/I' + IntToStr(FNumber) + ' Do ' + CRLF, AStream);
+ WriteString('Q' + CRLF, AStream);
end;
constructor TPdfImage.CreateImage(const ALeft, ABottom: single; AWidth, AHeight, ANumber: integer);
@@ -825,25 +749,20 @@ begin
FHeight := AHeight;
end;
-destructor TPdfImage.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfLineStyle.WriteLineStyle(const AFlux: TStream);
+procedure TPdfLineStyle.WriteLineStyle(const AStream: TStream);
begin
- WriteChaine('[', AFlux);
+ WriteString('[', AStream);
case FDash of
lsDash:
- WriteChaine('5 5', AFlux);
+ WriteString('5 5', AStream);
lsDot:
- WriteChaine('2 2', AFlux);
+ WriteString('2 2', AStream);
lsDashDot:
- WriteChaine('5 2 2 2', AFlux);
+ WriteString('5 2 2 2', AStream);
lsDashDotDot:
- WriteChaine('5 2 2 2 2 2', AFlux);
+ WriteString('5 2 2 2 2 2', AStream);
end;
- WriteChaine('] ' + IntToStr(FPhase) + ' d' + CRLF, AFlux);
+ WriteString('] ' + IntToStr(FPhase) + ' d' + CRLF, AStream);
end;
constructor TPdfLineStyle.CreateLineStyle(ADash: TfpgLineStyle; APhase: integer);
@@ -853,25 +772,20 @@ begin
FPhase := APhase;
end;
-destructor TPdfLineStyle.Destroy;
-begin
- inherited;
-end;
-
-procedure TPdfColor.WriteColor(const AFlux: TStream);
+procedure TPdfColor.WriteColor(const AStream: TStream);
begin
if FStroke then
begin
- if (FRed + ' ' + FGreen + ' ' + FBlue + ' rg') <> CurrentColor then
+ if (FRed + ' ' + FGreen + ' ' + FBlue + ' rg') <> uCurrentColor then
begin
- WriteChaine(FRed + ' ' + FGreen + ' ' + FBlue + ' rg' + CRLF, AFlux);
- CurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' rg';
+ WriteString(FRed + ' ' + FGreen + ' ' + FBlue + ' rg' + CRLF, AStream);
+ uCurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' rg';
end;
end
- else if (FRed + ' ' + FGreen + ' ' + FBlue + ' RG') <> CurrentColor then
+ else if (FRed + ' ' + FGreen + ' ' + FBlue + ' RG') <> uCurrentColor then
begin
- WriteChaine(FRed + ' ' + FGreen + ' ' + FBlue + ' RG' + CRLF, AFlux);
- CurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' RG';
+ WriteString(FRed + ' ' + FGreen + ' ' + FBlue + ' RG' + CRLF, AStream);
+ uCurrentColor := FRed + ' ' + FGreen + ' ' + FBlue + ' RG';
end;
end;
@@ -884,33 +798,28 @@ begin
FStroke := AStroke;
end;
-destructor TPdfColor.Destroy;
+procedure TPdfDicElement.WriteDicElement(const AStream: TStream);
begin
- inherited;
-end;
-
-procedure TPdfDicElement.WriteDicElement(const AFlux: TStream);
-begin
- FKey.WriteName(AFlux);
- WriteChaine(' ', AFlux);
+ FKey.WriteName(AStream);
+ WriteString(' ', AStream);
if FValue is TPdfBoolean then
- TPdfBoolean(FValue).WriteBoolean(AFlux);
+ TPdfBoolean(FValue).WriteBoolean(AStream);
if FValue is TPdfInteger then
- TPdfInteger(FValue).WriteInteger(AFlux);
+ TPdfInteger(FValue).WriteInteger(AStream);
if FValue is TPdfReference then
- TPdfReference(FValue).WriteReference(AFlux);
+ TPdfReference(FValue).WriteReference(AStream);
if FValue is TPdfName then
- TPdfName(FValue).WriteName(AFlux);
+ TPdfName(FValue).WriteName(AStream);
if FValue is TPdfString then
- TPdfString(FValue).WriteString(AFlux);
+ TPdfString(FValue).Write(AStream);
if FValue is TPdfArray then
- TPdfArray(FValue).WriteArray(AFlux);
+ TPdfArray(FValue).WriteArray(AStream);
if FValue is TPdfDictionary then
- TPdfDictionary(FValue).WriteDictionary(-1, AFlux);
- WriteChaine(CRLF, AFlux);
+ TPdfDictionary(FValue).WriteDictionary(-1, AStream);
+ WriteString(CRLF, AStream);
end;
-constructor TPdfDicElement.CreateDicElement(const AKey: string; const AValue: TPdfObjet);
+constructor TPdfDicElement.CreateDicElement(const AKey: string; const AValue: TPdfObject);
begin
inherited Create;
FKey := TPdfName.CreateName(AKey);
@@ -937,7 +846,7 @@ begin
inherited;
end;
-procedure TPdfDictionary.AddElement(const AKey: string; const AValue: TPdfObjet);
+procedure TPdfDictionary.AddElement(const AKey: string; const AValue: TPdfObject);
var
DicElement: TPdfDicElement;
begin
@@ -958,20 +867,20 @@ begin
end;
end;
-procedure TPdfDictionary.WriteDictionary(const AObjet: integer; const AFlux: TStream);
+procedure TPdfDictionary.WriteDictionary(const AObjet: integer; const AStream: TStream);
var
Long: TPdfInteger;
Cpt, NumImg, NumFnt: integer;
Value: string;
begin
if TPdfName(TPdfDicElement(FElement[0]).FKey).FValue = '' then
- TPdfDicElement(FElement[0]).WriteDicElement(AFlux) // write a charwidth array of a font
+ TPdfDicElement(FElement[0]).WriteDicElement(AStream) // write a charwidth array of a font
else
begin
- WriteChaine('<<' + CRLF, AFlux);
+ WriteString('<<' + CRLF, AStream);
if FElement.Count > 0 then
for Cpt := 0 to Pred(FElement.Count) do
- TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux);
+ TPdfDicElement(FElement[Cpt]).WriteDicElement(AStream);
NumImg := -1;
NumFnt := -1;
if FElement.Count > 0 then
@@ -982,41 +891,41 @@ begin
begin
if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue = 'Name') then
begin
- if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1] = 'I') then
+ if (TPdfObject(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1] = 'I') then
begin
NumImg := StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue, 2, Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue) - 1));
- Flux := TMemoryStream.Create;
- Flux.Position := 0;
+ uStream := TMemoryStream.Create;
+ uStream.Position := 0;
// write image stream length in xobject dictionary
- Long := TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg, Flux));
- TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length', Long);
- TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux);
- Flux.Free;
- WriteChaine('>>', AFlux);
+ Long := TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FGlobalXRefs[AObjet]).FDict).WriteImageStream(NumImg, uStream));
+ TPdfDictionary(TPdfXRef(Document.FGlobalXRefs[AObjet]).FDict).AddElement('Length', Long);
+ TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AStream);
+ uStream.Free;
+ WriteString('>>', AStream);
// write image stream in xobject dictionary
- TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg, AFlux);
+ TPdfImage(TPdfXRef(Document.FGlobalXRefs[AObjet]).FDict).WriteImageStream(NumImg, AStream);
end;
end;
if Pos('Length1', TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue) > 0 then
begin
- Flux := TMemoryStream.Create;
+ uStream := TMemoryStream.Create;
Value := TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue;
NumFnt := StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
- Flux.LoadFromFile(FontFiles[NumFnt]);
+ uStream.LoadFromFile(uFontFiles[NumFnt]);
// write fontfile stream length in xobject dictionary
- Long := TPdfInteger.CreateInteger(Flux.Size);
- TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length', Long);
- TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux);
- WriteChaine('>>', AFlux);
+ Long := TPdfInteger.CreateInteger(uStream.Size);
+ TPdfDictionary(TPdfXRef(Document.FGlobalXRefs[AObjet]).FDict).AddElement('Length', Long);
+ TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AStream);
+ WriteString('>>', AStream);
// write fontfile stream in xobject dictionary
- TPdfFonte(TPdfXRef(Document.FXRefObjets[NumFnt]).FObjet).WriteFonteStream(Flux, AFlux);
- Flux.Free;
+ TPdfEmbeddedFont(TPdfXRef(Document.FGlobalXRefs[NumFnt]).FDict).WriteEmbeddedFont(uStream, AStream);
+ uStream.Free;
end;
end;
end; { for Cpt... }
end; { if FElement.Count... }
if (NumImg = -1) and (NumFnt = -1) then
- WriteChaine('>>', AFlux);
+ WriteString('>>', AStream);
end; { if/else }
end;
@@ -1037,22 +946,22 @@ begin
inherited;
end;
-procedure TPdfXRef.WriteXRef(const AFlux: TStream);
+procedure TPdfXRef.WriteXRef(const AStream: TStream);
begin
- WriteChaine(IntToChaine(FOffset, 10) + ' ' + IntToChaine(0, 5) + ' n' + CRLF, AFlux);
+ WriteString(IntToString(FOffset, 10) + ' ' + IntToString(0, 5) + ' n' + CRLF, AStream);
end;
constructor TPdfXRef.CreateXRef;
begin
inherited Create;
FOffset := 0;
- FObjet := TpdfDictionary.CreateDictionary;
+ FDict := TpdfDictionary.CreateDictionary;
FStream := nil;
end;
destructor TPdfXRef.Destroy;
begin
- FObjet.Free;
+ FDict.Free;
FStream.Free;
inherited;
end;
@@ -1061,68 +970,68 @@ function TPdfDocument.ElementParNom(const AValue: string): integer;
var
Cpt: integer;
begin
- for Cpt := 1 to Pred(FXRefObjets.Count) do
- if TPdfName(TPdfDicElement(TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet).FElement[0]).FValue).FValue = AValue then
+ for Cpt := 1 to Pred(FGlobalXRefs.Count) do
+ if TPdfName(TPdfDicElement(TPdfDictionary(TPdfXRef(FGlobalXRefs[Cpt]).FDict).FElement[0]).FValue).FValue = AValue then
Result := Cpt;
end;
-procedure TPdfDocument.WriteXRefTable(const AFlux: TStream);
+procedure TPdfDocument.WriteXRefTable(const AStream: TStream);
var
Cpt: integer;
begin
- if FXRefObjets.Count > 1 then
- for Cpt := 1 to Pred(FXRefObjets.Count) do
- TPdfXRef(FXRefObjets[Cpt]).WriteXRef(AFlux);
+ if FGlobalXRefs.Count > 1 then
+ for Cpt := 1 to Pred(FGlobalXRefs.Count) do
+ TPdfXRef(FGlobalXRefs[Cpt]).WriteXRef(AStream);
end;
-procedure TPdfDocument.WriteObjet(const AObjet: integer; const AFlux: TStream);
+procedure TPdfDocument.WriteObject(const AObject: integer; const AStream: TStream);
var
Long: TPdfInteger;
Flux: TMemoryStream;
begin
- WriteChaine(IntToStr(AObjet) + ' 0 obj' + CRLF, AFlux);
- if TPdfXRef(FXRefObjets[AObjet]).FStream = nil then
- TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).WriteDictionary(AObjet, AFlux)
+ WriteString(IntToStr(AObject) + ' 0 obj' + CRLF, AStream);
+ if TPdfXRef(FGlobalXRefs[AObject]).FStream = nil then
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[AObject]).FDict).WriteDictionary(AObject, AStream)
else
begin
Flux := TMemoryStream.Create;
Flux.Position := 0;
- CurrentColor := '';
- CurrentWidth := '';
- TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(Flux);
+ uCurrentColor := '';
+ uCurrentWidth := '';
+ TPdfXRef(FGlobalXRefs[AObject]).FStream.WriteStream(Flux);
// write stream length element in contents dictionary
Long := TPdfInteger.CreateInteger(Flux.Size);
- TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).AddElement('Length', Long);
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[AObject]).FDict).AddElement('Length', Long);
Flux.Free;
- TPdfXRef(FXRefObjets[AObjet]).FObjet.WriteDictionary(-1, AFlux);
+ TPdfXRef(FGlobalXRefs[AObject]).FDict.WriteDictionary(-1, AStream);
// write stream in contents dictionary
- CurrentColor := '';
- CurrentWidth := '';
- WriteChaine(CRLF + 'stream' + CRLF, AFlux);
- TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(AFlux);
- WriteChaine('endstream', AFlux);
+ uCurrentColor := '';
+ uCurrentWidth := '';
+ WriteString(CRLF + 'stream' + CRLF, AStream);
+ TPdfXRef(FGlobalXRefs[AObject]).FStream.WriteStream(AStream);
+ WriteString('endstream', AStream);
end;
- WriteChaine(CRLF + 'endobj' + CRLF + CRLF, AFlux);
+ WriteString(CRLF + 'endobj' + CRLF + CRLF, AStream);
end;
procedure TPdfDocument.CreateRefTable;
var
XRefObjet: TPdfXRef;
begin
- FXRefObjets := TList.Create;
+ FGlobalXRefs := TList.Create;
// add first xref entry
XRefObjet := TPdfXRef.CreateXRef;
- FXRefObjets.Add(XRefObjet);
+ FGlobalXRefs.Add(XRefObjet);
end;
procedure TPdfDocument.CreateTrailer;
var
XRefObjets: TPdfInteger;
begin
- Trailer := TPdfDictionary.CreateDictionary;
- // add size trailer element
- XRefObjets := TPdfInteger.CreateInteger(FXRefObjets.Count);
- Trailer.AddElement('Size', XRefObjets);
+ uDictionary := TPdfDictionary.CreateDictionary;
+ // add size uDictionary element
+ XRefObjets := TPdfInteger.CreateInteger(FGlobalXRefs.Count);
+ uDictionary.AddElement('Size', XRefObjets);
end;
function TPdfDocument.CreateCatalog: integer;
@@ -1134,13 +1043,13 @@ var
begin
// add xref entry
Catalog := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Catalog);
- // add root trailer element
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Trailer.AddElement('Root', XRefObjets);
+ FGlobalXRefs.Add(Catalog);
+ // add root uDictionary element
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ uDictionary.AddElement('Root', XRefObjets);
// add type element to catalog dictionary
Nom := TPdfName.CreateName('Catalog');
- Catalog.FObjet.AddElement('Type', Nom);
+ Catalog.FDict.AddElement('Type', Nom);
// add pagelayout element to catalog dictionary
case FPageLayout of
lSingle:
@@ -1150,111 +1059,111 @@ begin
lContinuous:
Nom := TPdfName.CreateName('OneColumn');
end;
- Catalog.FObjet.AddElement('PageLayout', Nom);
+ Catalog.FDict.AddElement('PageLayout', Nom);
// add openaction element to catalog dictionary
Table := TPdfArray.CreateArray;
- Catalog.FObjet.AddElement('OpenAction', Table);
- Result := Pred(FXRefObjets.Count);
+ Catalog.FDict.AddElement('OpenAction', Table);
+ Result := Pred(FGlobalXRefs.Count);
end;
procedure TPdfDocument.CreateInfo;
var
Info: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfString;
+ lName: TPdfString;
begin
// add xref entry
Info := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Info);
- // add info trailer element
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Trailer.AddElement('Info', XRefObjets);
- TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue := FXRefObjets.Count;
+ FGlobalXRefs.Add(Info);
+ // add info uDictionary element
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ uDictionary.AddElement('Info', XRefObjets);
+ TPdfInteger(TPdfDicElement(uDictionary.FElement[uDictionary.ElementParCle('Size')]).FValue).FValue := FGlobalXRefs.Count;
// add title element to info dictionary
- Nom := TPdfString.CreateString(Infos.Titre);
- Info.FObjet.AddElement('Title', Nom);
+ lName := TPdfString.CreateString(Infos.Title);
+ Info.FDict.AddElement('Title', lName);
// add author element to info dictionary
- Nom := TPdfString.CreateString(Infos.Auteur);
- Info.FObjet.AddElement('Author', Nom);
+ lName := TPdfString.CreateString(Infos.Author);
+ Info.FDict.AddElement('Author', lName);
// add creator element to info dictionary
- Nom := TPdfString.CreateString(ApplicationName);
- Info.FObjet.AddElement('Creator', Nom);
+ lName := TPdfString.CreateString(ApplicationName);
+ Info.FDict.AddElement('Creator', lName);
// add producer element to info dictionary
- Nom := TPdfString.CreateString(fpGUIName + ' ' + FPGUI_VERSION);
- Info.FObjet.AddElement('Producer', Nom);
+ lName := TPdfString.CreateString(fpGUIName + ' ' + FPGUI_VERSION);
+ Info.FDict.AddElement('Producer', lName);
// add creationdate element to info dictionary
- Nom := TPdfString.CreateString(DateToPdfDate(Now));
- Info.FObjet.AddElement('CreationDate', Nom);
+ lName := TPdfString.CreateString(DateToPdfDate(Now));
+ Info.FDict.AddElement('CreationDate', lName);
end;
procedure TPdfDocument.CreatePreferences;
var
Viewer: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Preference: TPdfBoolean;
begin
// add xref entry
Viewer := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Viewer);
+ FGlobalXRefs.Add(Viewer);
// add type element to preferences dictionary
- Nom := TPdfName.CreateName('ViewerPreferences');
- Viewer.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('ViewerPreferences');
+ Viewer.FDict.AddElement('Type', lName);
// add preference element to preferences dictionary
Preference := TPdfBoolean.CreateBoolean(True);
- Viewer.FObjet.AddElement('FitWindow', Preference);
+ Viewer.FDict.AddElement('FitWindow', Preference);
// add preferences reference to catalog dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('ViewerPreferences', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[ElementParNom('Catalog')]).FDict).AddElement('ViewerPreferences', XRefObjets);
end;
function TPdfDocument.CreatePages(Parent: integer): integer;
var
Pages: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Dictionaire: TPdfDictionary;
Table: TPdfArray;
Count: TPdfInteger;
begin
// add xref entry
Pages := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Pages);
+ FGlobalXRefs.Add(Pages);
// add type element to pages dictionary
- Nom := TPdfName.CreateName('Pages');
- Pages.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('Pages');
+ Pages.FDict.AddElement('Type', lName);
// add parent reference to pages dictionary if pages is not the root of the page tree
if Parent > 0 then
begin
XRefObjets := TPdfReference.CreateReference(Parent);
- Pages.FObjet.AddElement('Parent', XRefObjets);
+ Pages.FDict.AddElement('Parent', XRefObjets);
// increment count in parent pages dictionary
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[Parent]).FDict);
TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
// add kid reference in parent pages dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets);
end
else
begin
// add pages reference to catalog dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('Pages', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[ElementParNom('Catalog')]).FDict).AddElement('Pages', XRefObjets);
end;
// add kids element to pages dictionary
Table := TPdfArray.CreateArray;
- Pages.FObjet.AddElement('Kids', Table);
+ Pages.FDict.AddElement('Kids', Table);
// add count element to pages dictionary
Count := TPdfInteger.CreateInteger(0);
- Pages.FObjet.AddElement('Count', Count);
- Result := Pred(FXRefObjets.Count);
+ Pages.FDict.AddElement('Count', Count);
+ Result := Pred(FGlobalXRefs.Count);
end;
function TPdfDocument.CreatePage(Parent, Haut, Larg, PageNum: integer): integer;
var
Page: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Dictionaire: TPdfDictionary;
Table: TPdfArray;
Coord: TPdfInteger;
@@ -1262,24 +1171,24 @@ var
begin
// add xref entry
Page := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Page);
+ FGlobalXRefs.Add(Page);
// add type element to page dictionary
- Nom := TPdfName.CreateName('Page');
- Page.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('Page');
+ Page.FDict.AddElement('Type', lName);
// add parent reference to page dictionary
XRefObjets := TPdfReference.CreateReference(Parent);
- Page.FObjet.AddElement('Parent', XRefObjets);
+ Page.FDict.AddElement('Parent', XRefObjets);
// increment count in parent pages dictionary
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[Parent]).FDict);
TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
// add kid reference in parent pages dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets);
// add mediabox element to page dictionary
Table := TPdfArray.CreateArray;
- Page.FObjet.AddElement('MediaBox', Table);
+ Page.FDict.AddElement('MediaBox', Table);
// add coordinates in page mediabox
- Dictionaire := TPdfDictionary(TPdfXRef(Page).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(Page).FDict);
Coord := TPdfInteger.CreateInteger(0);
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
Coord := TPdfInteger.CreateInteger(0);
@@ -1290,15 +1199,15 @@ begin
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
// add resources element to page dictionary
Dictionaire := TPdfDictionary.CreateDictionary;
- Page.FObjet.AddElement('Resources', Dictionaire);
+ Page.FDict.AddElement('Resources', Dictionaire);
// add procset element in resources element to page dictionary
Table := TPdfArray.CreateArray;
- TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('ProcSet', Table);
+ TPdfDictionary(TPdfDicElement(Page.FDict.FElement[Pred(Page.FDict.FElement.Count)]).FValue).AddElement('ProcSet', Table);
// add font element in resources element to page dictionary
if Fonts.Count > 0 then
begin
Dictionaire := TPdfDictionary.CreateDictionary;
- TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font', Dictionaire);
+ TPdfDictionary(TPdfDicElement(Page.FDict.FElement[Pred(Page.FDict.FElement.Count)]).FValue).AddElement('Font', Dictionaire);
end;
for Cpt := 0 to Pred(PdfPage.Count) do
begin
@@ -1308,40 +1217,40 @@ begin
begin
// add xobject element in resources element to page dictionary
Dictionaire := TPdfDictionary.CreateDictionary;
- TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('XObject', Dictionaire);
+ TPdfDictionary(TPdfDicElement(Page.FDict.FElement[Pred(Page.FDict.FElement.Count)]).FValue).AddElement('XObject', Dictionaire);
Break;
end;
end;
end;
// add pdf element in procset array to page dictionary
- Dictionaire := TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue);
- Nom := TPdfName.CreateName('PDF');
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
+ Dictionaire := TPdfDictionary(TPdfDicElement(Page.FDict.FElement[Pred(Page.FDict.FElement.Count)]).FValue);
+ lName := TPdfName.CreateName('PDF');
+ TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(lName);
// add text element in procset array to page dictionary
- Nom := TPdfName.CreateName('Text');
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
+ lName := TPdfName.CreateName('Text');
+ TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(lName);
// add image element in procset array to page dictionary
- Nom := TPdfName.CreateName('ImageC');
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
- Result := Pred(FXRefObjets.Count);
+ lName := TPdfName.CreateName('ImageC');
+ TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(lName);
+ Result := Pred(FGlobalXRefs.Count);
end;
function TPdfDocument.CreateOutlines: integer;
var
Outlines: TPdfXRef;
- Nom: TPdfName;
+ lName: TPdfName;
Count: TPdfInteger;
begin
// add xref entry
Outlines := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Outlines);
+ FGlobalXRefs.Add(Outlines);
// add type element to outlines dictionary
- Nom := TPdfName.CreateName('Outlines');
- Outlines.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('Outlines');
+ Outlines.FDict.AddElement('Type', lName);
// add count element to outlines dictionary
Count := TPdfInteger.CreateInteger(0);
- Outlines.FObjet.AddElement('Count', Count);
- Result := Pred(FXRefObjets.Count);
+ Outlines.FDict.AddElement('Count', Count);
+ Result := Pred(FGlobalXRefs.Count);
end;
function TPdfDocument.CreateOutline(Parent, SectNo, PageNo: integer; SectTitre: string): integer;
@@ -1354,7 +1263,7 @@ var
begin
// add xref entry
Outline := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Outline);
+ FGlobalXRefs.Add(Outline);
// add title element to outline dictionary
if PageNo > -1 then
begin
@@ -1370,24 +1279,24 @@ begin
else
Titre := TPdfString.CreateString('Section ' + IntToStr(SectNo));
end;
- Outline.FObjet.AddElement('Title', Titre);
+ Outline.FDict.AddElement('Title', Titre);
// add parent reference to outline dictionary
XRefObjets := TPdfReference.CreateReference(Parent);
- Outline.FObjet.AddElement('Parent', XRefObjets);
+ Outline.FDict.AddElement('Parent', XRefObjets);
// add count element to outline dictionary
Count := TPdfInteger.CreateInteger(0);
- Outline.FObjet.AddElement('Count', Count);
+ Outline.FDict.AddElement('Count', Count);
// add dest element to outline dictionary
Table := TPdfArray.CreateArray;
- Outline.FObjet.AddElement('Dest', Table);
- Result := Pred(FXRefObjets.Count);
+ Outline.FDict.AddElement('Dest', Table);
+ Result := Pred(FGlobalXRefs.Count);
end;
procedure TPdfDocument.CreateStdFont(NomFonte: string; NumFonte: integer);
var
Fontes: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Dictionaire: TPdfDictionary;
Cpt: integer;
begin
@@ -1396,151 +1305,151 @@ begin
// AnsiReplaceText(NomFonte,'Italic','Oblique');
// add xref entry
Fontes := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Fontes);
+ FGlobalXRefs.Add(Fontes);
// add type element to font dictionary
- Nom := TPdfName.CreateName('Font');
- Fontes.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('Font');
+ Fontes.FDict.AddElement('Type', lName);
// add subtype element to font dictionary
- Nom := TPdfName.CreateName('Type1');
- Fontes.FObjet.AddElement('Subtype', Nom);
+ lName := TPdfName.CreateName('Type1');
+ Fontes.FDict.AddElement('Subtype', lName);
// add encoding element to font dictionary
- Nom := TPdfName.CreateName('WinAnsiEncoding');
- Fontes.FObjet.AddElement('Encoding', Nom);
+ lName := TPdfName.CreateName('WinAnsiEncoding');
+ Fontes.FDict.AddElement('Encoding', lName);
// add firstchar element to font dictionary
- Nom := TPdfName.CreateName('32');
- //Nom:= TPdfName.CreateName('0');
- Fontes.FObjet.AddElement('FirstChar', Nom);
+ lName := TPdfName.CreateName('32');
+ //lName:= TPdfName.CreateName('0');
+ Fontes.FDict.AddElement('FirstChar', lName);
// add lastchar element to font dictionary
- Nom := TPdfName.CreateName('255');
- Fontes.FObjet.AddElement('LastChar', Nom);
+ lName := TPdfName.CreateName('255');
+ Fontes.FDict.AddElement('LastChar', lName);
// add basefont element to font dictionary
- Nom := TPdfName.CreateName(NomFonte);
- Fontes.FObjet.AddElement('BaseFont', Nom);
+ lName := TPdfName.CreateName(NomFonte);
+ Fontes.FDict.AddElement('BaseFont', lName);
// add name element to font dictionary
- Nom := TPdfName.CreateName('F' + IntToStr(NumFonte));
- Fontes.FObjet.AddElement('Name', Nom);
+ lName := TPdfName.CreateName('F' + IntToStr(NumFonte));
+ Fontes.FDict.AddElement('Name', lName);
// add font reference to all page dictionary
- for Cpt := 1 to Pred(FXRefObjets.Count) do
+ for Cpt := 1 to Pred(FGlobalXRefs.Count) do
begin
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[Cpt]).FDict);
if Dictionaire.FElement.Count > 0 then
if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then
begin
Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue);
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ Dictionaire.AddElement(TPdfName(lName).FValue, XRefObjets);
end;
end;
- SetLength(FontFiles, Succ(Length(FontFiles)));
- FontFiles[NumFonte] := '';
+ SetLength(uFontFiles, Succ(Length(uFontFiles)));
+ uFontFiles[NumFonte] := '';
end;
-function TPdfDocument.LoadFont(NomFonte: string): string;
+function TPdfDocument.LoadFont(AFontName: string): string;
var
FileTxt: TextFile;
- Ligne: WideString;
+ lLine: WideString;
begin
- if fpgFileExists(FontDirectory + NomFonte + '.fnt') then
+ if fpgFileExists(FontDirectory + AFontName + '.fnt') then
begin
- AssignFile(FileTxt, FontDirectory + NomFonte + '.fnt');
+ AssignFile(FileTxt, FontDirectory + AFontName + '.fnt');
Reset(FileTxt);
while not EOF(FileTxt) do
begin
- Readln(FileTxt, Ligne);
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontType' then
- FontDef.FType := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontName' then
- FontDef.FName := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Ascent' then
- FontDef.FAscent := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Descent' then
- FontDef.FDescent := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'CapHeight' then
- FontDef.FCapHeight := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Flags' then
- FontDef.FFlags := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontBBox' then
- FontDef.FFontBBox := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'ItalicAngle' then
- FontDef.FItalicAngle := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'StemV' then
- FontDef.FStemV := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'MissingWidth' then
- FontDef.FMissingWidth := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Encoding' then
- FontDef.FEncoding := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'FontFile' then
- FontDef.FFile := FontDirectory + Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'OriginalSize' then
- FontDef.FOriginalSize := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'Diffs' then
- FontDef.FDiffs := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
- if Copy(Ligne, 1, Pred(Pos('=', Ligne))) = 'CharWidth' then
- FontDef.FCharWidth := Copy(Ligne, Succ(Pos('=', Ligne)), Length(Ligne) - Pos('=', Ligne));
+ Readln(FileTxt, lLine);
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'FontType' then
+ uFontDef.FType := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'FontName' then
+ uFontDef.FName := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'Ascent' then
+ uFontDef.FAscent := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'Descent' then
+ uFontDef.FDescent := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'CapHeight' then
+ uFontDef.FCapHeight := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'Flags' then
+ uFontDef.FFlags := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'FontBBox' then
+ uFontDef.FFontBBox := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'ItalicAngle' then
+ uFontDef.FItalicAngle := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'StemV' then
+ uFontDef.FStemV := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'MissingWidth' then
+ uFontDef.FMissingWidth := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'Encoding' then
+ uFontDef.FEncoding := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'FontFile' then
+ uFontDef.FFile := FontDirectory + Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'OriginalSize' then
+ uFontDef.FOriginalSize := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'Diffs' then
+ uFontDef.FDiffs := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
+ if Copy(lLine, 1, Pred(Pos('=', lLine))) = 'CharWidth' then
+ uFontDef.FCharWidth := Copy(lLine, Succ(Pos('=', lLine)), Length(lLine) - Pos('=', lLine));
end;
- Result := FontDef.FType;
+ Result := uFontDef.FType;
end
else
- ShowMessage(Format(rsErrReportFontFileMissing, [NomFonte]));
+ ShowMessage(Format(rsErrReportFontFileMissing, [AFontName]));
end;
procedure TPdfDocument.CreateTtfFont(const NumFonte: integer);
var
Fontes: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Dictionaire: TPdfDictionary;
Value: TPdfInteger;
Cpt: integer;
begin
// add xref entry
Fontes := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Fontes);
+ FGlobalXRefs.Add(Fontes);
// add type element to font dictionary
- Nom := TPdfName.CreateName('Font');
- Fontes.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('Font');
+ Fontes.FDict.AddElement('Type', lName);
// add subtype element to font dictionary
- Nom := TPdfName.CreateName(FontDef.FType);
- Fontes.FObjet.AddElement('Subtype', Nom);
+ lName := TPdfName.CreateName(uFontDef.FType);
+ Fontes.FDict.AddElement('Subtype', lName);
// add encoding element to font dictionary
- Nom := TPdfName.CreateName('WinAnsiEncoding');
- Fontes.FObjet.AddElement('Encoding', Nom);
+ lName := TPdfName.CreateName('WinAnsiEncoding');
+ Fontes.FDict.AddElement('Encoding', lName);
// add firstchar element to font dictionary
Value := TPdfInteger.CreateInteger(32);
- Fontes.FObjet.AddElement('FirstChar', Value);
+ Fontes.FDict.AddElement('FirstChar', Value);
// add lastchar element to font dictionary
Value := TPdfInteger.CreateInteger(255);
- Fontes.FObjet.AddElement('LastChar', Value);
+ Fontes.FDict.AddElement('LastChar', Value);
// add basefont element to font dictionary
- Nom := TPdfName.CreateName(FontDef.FName);
- Fontes.FObjet.AddElement('BaseFont', Nom);
+ lName := TPdfName.CreateName(uFontDef.FName);
+ Fontes.FDict.AddElement('BaseFont', lName);
// add name element to font dictionary
- Nom := TPdfName.CreateName('F' + IntToStr(NumFonte));
- Fontes.FObjet.AddElement('Name', Nom);
+ lName := TPdfName.CreateName('F' + IntToStr(NumFonte));
+ Fontes.FDict.AddElement('Name', lName);
// add font reference to all page dictionary
- for Cpt := 1 to Pred(FXRefObjets.Count) do
+ for Cpt := 1 to Pred(FGlobalXRefs.Count) do
begin
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[Cpt]).FDict);
if Dictionaire.FElement.Count > 0 then
if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then
begin
Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue);
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ Dictionaire.AddElement(TPdfName(lName).FValue, XRefObjets);
end;
end;
CreateFontDescriptor(NumFonte);
// add fontdescriptor reference to font dictionary
- XRefObjets := TPdfReference.CreateReference(FXRefObjets.Count - 2);
- Fontes.FObjet.AddElement('FontDescriptor', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(FGlobalXRefs.Count - 2);
+ Fontes.FDict.AddElement('FontDescriptor', XRefObjets);
CreateFontWidth;
// add fontwidth reference to font dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Fontes.FObjet.AddElement('Widths', XRefObjets);
- SetLength(FontFiles, Succ(Length(FontFiles)));
- FontFiles[NumFonte] := FontDef.FFile;
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ Fontes.FDict.AddElement('Widths', XRefObjets);
+ SetLength(uFontFiles, Succ(Length(uFontFiles)));
+ uFontFiles[NumFonte] := uFontDef.FFile;
end;
procedure TPdfDocument.CreateTp1Font(const NumFonte: integer);
@@ -1552,56 +1461,56 @@ procedure TPdfDocument.CreateFontDescriptor(const NumFonte: integer);
var
FtDesc: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
+ lName: TPdfName;
Value: TPdfInteger;
Table: TPdfArray;
Dictionaire: TPdfDictionary;
begin
// add xref entry
FtDesc := TPdfXRef.CreateXRef;
- FXRefObjets.Add(FtDesc);
+ FGlobalXRefs.Add(FtDesc);
// add type element to fontdescriptor dictionary
- Nom := TPdfName.CreateName('FontDescriptor');
- FtDesc.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('FontDescriptor');
+ FtDesc.FDict.AddElement('Type', lName);
// add fontname element to fontdescriptor dictionary
- Nom := TPdfName.CreateName(FontDef.FName);
- FtDesc.FObjet.AddElement('FontName', Nom);
+ lName := TPdfName.CreateName(uFontDef.FName);
+ FtDesc.FDict.AddElement('FontName', lName);
// add ascent element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FAscent));
- FtDesc.FObjet.AddElement('Ascent', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FAscent));
+ FtDesc.FDict.AddElement('Ascent', Value);
// add descent element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FDescent));
- FtDesc.FObjet.AddElement('Descent', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FDescent));
+ FtDesc.FDict.AddElement('Descent', Value);
// add capheight element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FCapHeight));
- FtDesc.FObjet.AddElement('CapHeight', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FCapHeight));
+ FtDesc.FDict.AddElement('CapHeight', Value);
// add flags element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FFlags));
- FtDesc.FObjet.AddElement('Flags', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FFlags));
+ FtDesc.FDict.AddElement('Flags', Value);
// add fontbbox element to fontdescriptor dictionary
Table := TPdfArray.CreateArray;
- FtDesc.FObjet.AddElement('FontBBox', Table);
+ FtDesc.FDict.AddElement('FontBBox', Table);
// add coordinates in page fontbbox
- while Pos(' ', FontDef.FFontBBox) > 0 do
+ while Pos(' ', uFontDef.FFontBBox) > 0 do
begin
- Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FObjet);
- Value := TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FFontBBox, 1, Pred(Pos(' ', FontDef.FFontBBox)))));
+ Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FDict);
+ Value := TPdfInteger.CreateInteger(StrToInt(Copy(uFontDef.FFontBBox, 1, Pred(Pos(' ', uFontDef.FFontBBox)))));
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('FontBBox')]).FValue).AddItem(Value);
- FontDef.FFontBBox := Copy(FontDef.FFontBBox, Succ(Pos(' ', FontDef.FFontBBox)), Length(FontDef.FFontBBox) - Pos(' ', FontDef.FFontBBox));
+ uFontDef.FFontBBox := Copy(uFontDef.FFontBBox, Succ(Pos(' ', uFontDef.FFontBBox)), Length(uFontDef.FFontBBox) - Pos(' ', uFontDef.FFontBBox));
end;
// add italicangle element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FItalicAngle));
- FtDesc.FObjet.AddElement('ItalicAngle', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FItalicAngle));
+ FtDesc.FDict.AddElement('ItalicAngle', Value);
// add stemv element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FStemV));
- FtDesc.FObjet.AddElement('StemV', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FStemV));
+ FtDesc.FDict.AddElement('StemV', Value);
// add missingwidth element to fontdescriptor dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FMissingWidth));
- FtDesc.FObjet.AddElement('MissingWidth', Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FMissingWidth));
+ FtDesc.FDict.AddElement('MissingWidth', Value);
CreateFontFile(NumFonte);
// add fontfilereference to fontdescriptor dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- FtDesc.FObjet.AddElement('FontFile2', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ FtDesc.FDict.AddElement('FontFile2', XRefObjets);
end;
procedure TPdfDocument.CreateFontWidth;
@@ -1613,84 +1522,84 @@ var
begin
// add xref entry
FtDesc := TPdfXRef.CreateXRef;
- FXRefObjets.Add(FtDesc);
+ FGlobalXRefs.Add(FtDesc);
// add element to fontwidth dictionary
Table := TPdfArray.CreateArray;
- FtDesc.FObjet.AddElement('', Table);
+ FtDesc.FDict.AddElement('', Table);
// add width values in fontwidth array
- while Pos(' ', FontDef.FCharWidth) > 0 do
+ while Pos(' ', uFontDef.FCharWidth) > 0 do
begin
- Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FObjet);
- Value := TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FCharWidth, 1, Pred(Pos(' ', FontDef.FCharWidth)))));
+ Dictionaire := TPdfDictionary(TPdfXRef(FtDesc).FDict);
+ Value := TPdfInteger.CreateInteger(StrToInt(Copy(uFontDef.FCharWidth, 1, Pred(Pos(' ', uFontDef.FCharWidth)))));
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('')]).FValue).AddItem(Value);
- FontDef.FCharWidth := Copy(FontDef.FCharWidth, Succ(Pos(' ', FontDef.FCharWidth)), Length(FontDef.FCharWidth) - Pos(' ', FontDef.FCharWidth));
+ uFontDef.FCharWidth := Copy(uFontDef.FCharWidth, Succ(Pos(' ', uFontDef.FCharWidth)), Length(uFontDef.FCharWidth) - Pos(' ', uFontDef.FCharWidth));
end;
end;
procedure TPdfDocument.CreateFontFile(const NumFonte: integer);
var
FtDesc: TPdfXRef;
- Nom: TPdfName;
+ lName: TPdfName;
Value: TPdfInteger;
begin
// add xref entry
FtDesc := TPdfXRef.CreateXRef;
- FXRefObjets.Add(FtDesc);
+ FGlobalXRefs.Add(FtDesc);
// add filter element to fontfile dictionary
- Nom := TPdfName.CreateName('FlateDecode');
- FtDesc.FObjet.AddElement('Filter', Nom);
+ lName := TPdfName.CreateName('FlateDecode');
+ FtDesc.FDict.AddElement('Filter', lName);
// add length1 element to fontfile dictionary
- Value := TPdfInteger.CreateInteger(StrToInt(FontDef.FOriginalSize));
- FtDesc.FObjet.AddElement('Length1 ' + IntToStr(NumFonte), Value);
+ Value := TPdfInteger.CreateInteger(StrToInt(uFontDef.FOriginalSize));
+ FtDesc.FDict.AddElement('Length1 ' + IntToStr(NumFonte), Value);
end;
-procedure TPdfDocument.CreateImage(ImgWidth, ImgHeight, NumImg: integer);
+procedure TPdfDocument.CreateImage(ImgWidth, ImgHeight, ImgNumber: integer);
var
Images: TPdfXRef;
XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
+ lName: TPdfName;
+ lDictionary: TPdfDictionary;
Long: TPdfInteger;
- Cpt: integer;
+ i: integer;
begin
// add xref entry
Images := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Images);
+ FGlobalXRefs.Add(Images);
// add type element to image dictionary
- Nom := TPdfName.CreateName('XObject');
- Images.FObjet.AddElement('Type', Nom);
+ lName := TPdfName.CreateName('XObject');
+ Images.FDict.AddElement('Type', lName);
// add subtype element to image dictionary
- Nom := TPdfName.CreateName('Image');
- Images.FObjet.AddElement('Subtype', Nom);
+ lName := TPdfName.CreateName('Image');
+ Images.FDict.AddElement('Subtype', lName);
// add width element to image dictionary
Long := TPdfInteger.CreateInteger(ImgWidth);
- Images.FObjet.AddElement('Width', Long);
+ Images.FDict.AddElement('Width', Long);
// add height element to image dictionary
Long := TPdfInteger.CreateInteger(ImgHeight);
- Images.FObjet.AddElement('Height', Long);
+ Images.FDict.AddElement('Height', Long);
// add color space element to image dictionary
- Nom := TPdfName.CreateName('DeviceRGB');
- Images.FObjet.AddElement('ColorSpace', Nom);
+ lName := TPdfName.CreateName('DeviceRGB');
+ Images.FDict.AddElement('ColorSpace', lName);
// add bits per component element to image dictionary
Long := TPdfInteger.CreateInteger(8);
- Images.FObjet.AddElement('BitsPerComponent', Long);
+ Images.FDict.AddElement('BitsPerComponent', Long);
// add name element to image dictionary
- Nom := TPdfName.CreateName('I' + IntToStr(NumImg));
- Images.FObjet.AddElement('Name', Nom);
+ lName := TPdfName.CreateName('I' + IntToStr(ImgNumber));
+ Images.FDict.AddElement('Name', lName);
// add image reference to page dictionary
- for Cpt := 1 to Pred(FXRefObjets.Count) do
+ for i := 1 to Pred(FGlobalXRefs.Count) do
begin
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
- if Dictionaire.FElement.Count > 0 then
+ lDictionary := TPdfDictionary(TPdfXRef(FGlobalXRefs[i]).FDict);
+ if lDictionary.FElement.Count > 0 then
begin
- if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue = 'Page' then
+ if TPdfName(TPdfDicElement(lDictionary.FElement[0]).FValue).FValue = 'Page' then
begin
- Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
- if Dictionaire.ElementParCle('XObject') > -1 then
+ lDictionary := TPdfDictionary(TPdfDicElement(lDictionary.FElement[lDictionary.ElementParCle('Resources')]).FValue);
+ if lDictionary.ElementParCle('XObject') > -1 then
begin
- Dictionaire := TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('XObject')]).FValue);
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue, XRefObjets);
+ lDictionary := TPdfDictionary(TPdfDicElement(lDictionary.FElement[lDictionary.ElementParCle('XObject')]).FValue);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ lDictionary.AddElement(TPdfName(lName).FValue, XRefObjets);
end;
end;
end;
@@ -1705,107 +1614,107 @@ var
begin
// add xref entry
Contents := TPdfXRef.CreateXRef;
- FXRefObjets.Add(Contents);
+ FGlobalXRefs.Add(Contents);
Stream := TPdfStream.CreateStream;
- TPdfXRef(FXRefObjets[Pred(FXRefObjets.Count)]).FStream := Stream;
+ TPdfXRef(FGlobalXRefs[Pred(FGlobalXRefs.Count)]).FStream := Stream;
// add contents reference to page dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[Pred(Pred(FXRefObjets.Count))]).FObjet).AddElement('Contents', XRefObjets);
- Result := Pred(FXRefObjets.Count);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[Pred(Pred(FGlobalXRefs.Count))]).FDict).AddElement('Contents', XRefObjets);
+ Result := Pred(FGlobalXRefs.Count);
end;
procedure TPdfDocument.CreateStream(NumeroPage, PageNum: integer);
var
- Cpt: integer;
+ i: integer;
Txt: TPdfText;
Clr: TPdfColor;
- Fnt: TPdfFonte;
+ Fnt: TPdfEmbeddedFont;
Rct: TPdfRectangle;
- Lin: TPdfLigne;
+ Lin: TPdfLineSegment;
Srf: TPdfSurface;
Sty: TPdfLineStyle;
Img: TPdfImage;
begin
- for Cpt := 0 to Pred(PdfPage.Count) do
+ for i := 0 to Pred(PdfPage.Count) do
begin
- if TPdfElement(PdfPage[Cpt]) is TPdfTexte then
+ if TPdfElement(PdfPage[i]) is TPdfTexte then
begin
- if TPdfTexte(PdfPage[Cpt]).PageId = NumeroPage then
+ if TPdfTexte(PdfPage[i]).PageId = NumeroPage then
begin
- with TPdfTexte(PdfPage[Cpt]) do
+ with TPdfTexte(PdfPage[i]) do
begin
if FontName > -1 then
begin
- Fnt := TPdfFonte.CreateFonte(FontName, FontSize);
+ Fnt := TPdfEmbeddedFont.CreateFont(FontName, FontSize);
// adjust font size to display device
Fnt.FTxtSize := IntToStr(Round((StrToInt(FontSize) * fpgApplication.Screen_dpi_y) div 72));
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Fnt);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Fnt);
Clr := TPdfColor.CreateColor(True, Couleur);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Clr);
end;
Txt := TPdfText.CreateText(TextPosX, TextPosY, Writting);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Txt);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Txt);
end;
end;
end;
- if TPdfElement(PdfPage[Cpt]) is TPdfRect then
+ if TPdfElement(PdfPage[i]) is TPdfRect then
begin
- if TPdfRect(PdfPage[Cpt]).PageId = NumeroPage then
+ if TPdfRect(PdfPage[i]).PageId = NumeroPage then
begin
- with TPdfRect(PdfPage[Cpt]) do
+ with TPdfRect(PdfPage[i]) do
begin
Clr := TPdfColor.CreateColor(True, RectColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Clr);
if RectStroke then
begin
Sty := TPdfLineStyle.CreateLineStyle(RectLineStyle, 0);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Sty);
end;
Rct := TPdfRectangle.CreateRectangle(RectThickness, RectLeft, RectBottom, RectWidth, RectHeight, RectFill, RectStroke);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Rct);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Rct);
end;
end;
end;
- if TPdfElement(PdfPage[Cpt]) is TPdfLine then
+ if TPdfElement(PdfPage[i]) is TPdfLine then
begin
- if TPdfLine(PdfPage[Cpt]).PageId = NumeroPage then
+ if TPdfLine(PdfPage[i]).PageId = NumeroPage then
begin
- with TPdfLine(PdfPage[Cpt]) do
+ with TPdfLine(PdfPage[i]) do
begin
Clr := TPdfColor.CreateColor(False, LineColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Clr);
Sty := TPdfLineStyle.CreateLineStyle(LineStyle, 0);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty);
- Lin := TPdfLigne.CreateLigne(LineThikness, LineBeginX, LineBeginY, LineEndX, LineEndY);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Lin);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Sty);
+ Lin := TPdfLineSegment.CreateLineSegment(LineThikness, LineBeginX, LineBeginY, LineEndX, LineEndY);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Lin);
end;
end;
end;
- if TPdfElement(PdfPage[Cpt]) is TPdfSurf then
+ if TPdfElement(PdfPage[i]) is TPdfSurf then
begin
- if TPdfSurf(PdfPage[Cpt]).PageId = NumeroPage then
+ if TPdfSurf(PdfPage[i]).PageId = NumeroPage then
begin
- with TPdfSurf(PdfPage[Cpt]) do
+ with TPdfSurf(PdfPage[i]) do
begin
Clr := TPdfColor.CreateColor(True, SurfColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Clr);
Srf := TPdfSurface.CreateSurface(Points);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Srf);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Srf);
end;
end;
end;
- if TPdfElement(PdfPage[Cpt]) is TPdfImg then
+ if TPdfElement(PdfPage[i]) is TPdfImg then
begin
- if TPdfImg(PdfPage[Cpt]).PageId = NumeroPage then
+ if TPdfImg(PdfPage[i]).PageId = NumeroPage then
begin
- with TPdfImg(PdfPage[Cpt]) do
+ with TPdfImg(PdfPage[i]) do
begin
Img := TPdfImage.CreateImage(ImgLeft, ImgBottom, ImgWidth, ImgHeight, ImgNumber);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Img);
+ TPdfStream(TPdfXRef(FGlobalXRefs[PageNum]).FStream).AddItem(Img);
end;
end;
end;
- end; { for Cpt... }
+ end; { for i... }
end;
constructor TPdfDocument.CreateDocument(const ALayout: TPageLayout; const AZoom: string; const APreferences: Boolean);
@@ -1823,7 +1732,7 @@ begin
FZoomValue := AZoom;
CreateRefTable;
CreateTrailer;
- Catalogue := CreateCatalog;
+ uCatalogue := CreateCatalog;
CreateInfo;
CreatePreferences;
ParentPage := 0;
@@ -1834,11 +1743,11 @@ begin
begin
OutlineRoot := CreateOutlines;
// add outline reference to catalog dictionary
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('Outlines', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[uCatalogue]).FDict).AddElement('Outlines', XRefObjets);
// add useoutline element to catalog dictionary
Nom := TPdfName.CreateName('UseOutlines');
- TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('PageMode', Nom);
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[uCatalogue]).FDict).AddElement('PageMode', Nom);
end;
TreeRoot := CreatePages(ParentPage);
end;
@@ -1850,29 +1759,29 @@ begin
if Outline then
begin
ParentOutline := CreateOutline(OutlineRoot, Succ(CptSect), -1, T_Section(Sections[CptSect]).Title);
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[OutlineRoot]).FDict);
TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
if CptSect = 0 then
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('First', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[OutlineRoot]).FDict).AddElement('First', XRefObjets);
NextSect := ParentOutline;
- PrevSect := Pred(FXRefObjets.Count);
+ PrevSect := Pred(FGlobalXRefs.Count);
end
else
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[NextSect]).FObjet).AddElement('Next', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[NextSect]).FDict).AddElement('Next', XRefObjets);
XRefObjets := TPdfReference.CreateReference(PrevSect);
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Prev', XRefObjets);
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[ParentOutline]).FDict).AddElement('Prev', XRefObjets);
NextSect := ParentOutline;
if CptSect < Pred(Sections.Count) then
- PrevSect := Pred(FXRefObjets.Count);
+ PrevSect := Pred(FGlobalXRefs.Count);
end;
if CptSect = Pred(Sections.Count) then
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('Last', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[OutlineRoot]).FDict).AddElement('Last', XRefObjets);
end;
end;
ParentPage := CreatePages(TreeRoot);
@@ -1886,8 +1795,8 @@ begin
// add zoom factor to catalog dictionary
if (CptSect = 0) and (CptPage = 0) then
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[ElementParNom('Catalog')]).FDict);
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(XRefObjets);
Nom := TPdfName.CreateName('XYZ null null ' + FormatFloat('0.##', StrToInt(FZoomValue) / 100));
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(Nom);
@@ -1898,10 +1807,10 @@ begin
if (Sections.Count > 1) and Outline then
begin
PageOutline := CreateOutline(ParentOutline, Succ(CptSect), Succ(Cptpage), T_Section(Sections[CptSect]).Title);
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[ParentOutline]).FDict);
TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
// add page reference to outline destination
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[PageOutline]).FDict);
XRefObjets := TPdfReference.CreateReference(NewPage);
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets);
// add display control name to outline destination
@@ -1909,12 +1818,12 @@ begin
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom);
if CptPage = 0 then
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('First', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[ParentOutline]).FDict).AddElement('First', XRefObjets);
NextOutline := PageOutline;
- PrevOutline := Pred(FXRefObjets.Count);
+ PrevOutline := Pred(FGlobalXRefs.Count);
// add page reference to parent outline destination
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[ParentOutline]).FDict);
XRefObjets := TPdfReference.CreateReference(NewPage);
TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets);
// add display control name to outline destination
@@ -1923,18 +1832,18 @@ begin
end
else
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[NextOutline]).FObjet).AddElement('Next', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[NextOutline]).FDict).AddElement('Next', XRefObjets);
XRefObjets := TPdfReference.CreateReference(PrevOutline);
- TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet).AddElement('Prev', XRefObjets);
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[PageOutline]).FDict).AddElement('Prev', XRefObjets);
NextOutline := PageOutline;
if CptPage < Pred(T_Section(Sections[CptSect]).Pages.Count) then
- PrevOutline := Pred(FXRefObjets.Count);
+ PrevOutline := Pred(FGlobalXRefs.Count);
end;
if CptPage = Pred(T_Section(Sections[CptSect]).Pages.Count) then
begin
- XRefObjets := TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Last', XRefObjets);
+ XRefObjets := TPdfReference.CreateReference(Pred(FGlobalXRefs.Count));
+ TPdfDictionary(TPdfXRef(FGlobalXRefs[ParentOutline]).FDict).AddElement('Last', XRefObjets);
end;
end;
end;
@@ -1942,7 +1851,7 @@ begin
if Sections.Count > 1 then
begin
// update count in root parent pages dictionary
- Dictionaire := TPdfDictionary(TPdfXRef(FXRefObjets[TreeRoot]).FObjet);
+ Dictionaire := TPdfDictionary(TPdfXRef(FGlobalXRefs[TreeRoot]).FDict);
TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).Value := T_Section(Sections[CptSect]).TotPages;
end;
if FontDirectory = '' then
@@ -1973,46 +1882,46 @@ begin
if Images.Count > 0 then
for Cpt := 0 to Pred(Images.Count) do
CreateImage(TfpgImage(Images[Cpt]).Width, TfpgImage(Images[Cpt]).Height, Cpt);
- TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue := FXRefObjets.Count;
+ TPdfInteger(TPdfDicElement(uDictionary.FElement[uDictionary.ElementParCle('Size')]).FValue).FValue := FGlobalXRefs.Count;
end;
destructor TPdfDocument.Destroy;
var
Cpt: integer;
begin
- Trailer.Free;
- if FXRefObjets.Count > 0 then
- for Cpt := 0 to Pred(FXRefObjets.Count) do
- TPdfXRef(FXRefObjets[Cpt]).Free;
- FXRefObjets.Free;
+ uDictionary.Free;
+ if FGlobalXRefs.Count > 0 then
+ for Cpt := 0 to Pred(FGlobalXRefs.Count) do
+ TPdfXRef(FGlobalXRefs[Cpt]).Free;
+ FGlobalXRefs.Free;
inherited;
end;
-procedure TPdfDocument.WriteDocument(const AFlux: TStream);
+procedure TPdfDocument.WriteDocument(const AStream: TStream);
var
Cpt, XRefPos: integer;
begin
- AFlux.Position := 0;
- WriteChaine(PDF_VERSION + CRLF, AFlux);
+ AStream.Position := 0;
+ WriteString(PDF_VERSION + CRLF, AStream);
// write numbered indirect objects
- for Cpt := 1 to Pred(FXRefObjets.Count) do
+ for Cpt := 1 to Pred(FGlobalXRefs.Count) do
begin
- XRefPos := AFlux.Position;
- WriteObjet(Cpt, AFlux);
- TPdfXRef(FXRefObjets[Cpt]).Offset := XRefPos;
+ XRefPos := AStream.Position;
+ WriteObject(Cpt, AStream);
+ TPdfXRef(FGlobalXRefs[Cpt]).Offset := XRefPos;
end;
- XRefPos := AFlux.Position;
+ XRefPos := AStream.Position;
// write xref table
- WriteChaine('xref' + CRLF + '0 ' + IntToStr(FXRefObjets.Count) + CRLF, AFlux);
- with TPdfXRef(FXRefObjets[0]) do
- WriteChaine(IntToChaine(Offset, 10) + ' ' + IntToChaine(PDF_MAX_GEN_NUM, 5) + ' f' + CRLF, AFlux);
- WriteXRefTable(AFlux);
- // write trailer
- WriteChaine('trailer' + CRLF, AFlux);
- Trailer.WriteDictionary(-1, AFlux);
+ WriteString('xref' + CRLF + '0 ' + IntToStr(FGlobalXRefs.Count) + CRLF, AStream);
+ with TPdfXRef(FGlobalXRefs[0]) do
+ WriteString(IntToString(Offset, 10) + ' ' + IntToString(PDF_MAX_GEN_NUM, 5) + ' f' + CRLF, AStream);
+ WriteXRefTable(AStream);
+ // write uDictionary
+ WriteString('trailer' + CRLF, AStream);
+ uDictionary.WriteDictionary(-1, AStream);
// write offset of last xref table
- WriteChaine(CRLF + 'startxref' + CRLF + IntToStr(XRefPos) + CRLF, AFlux);
- WriteChaine(PDF_FILE_END, AFlux);
+ WriteString(CRLF + 'startxref' + CRLF + IntToStr(XRefPos) + CRLF, AStream);
+ WriteString(PDF_FILE_END, AStream);
end;
end.
diff --git a/src/reportengine/u_report.pas b/src/reportengine/u_report.pas
index 0a6a8a3e..0dfee3d6 100644
--- a/src/reportengine/u_report.pas
+++ b/src/reportengine/u_report.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -465,8 +465,8 @@ type
var
Infos: record
- Titre: string;
- Auteur: string;
+ Title: string;
+ Author: string;
end;
PdfPage: TList;