diff options
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; |