diff options
324 files changed, 22122 insertions, 2546 deletions
diff --git a/.gitattributes b/.gitattributes index cfc91c5c..5e785c0f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ -# Set default behaviour, in case users don't have core.autorclf set. +# Set default behaviour, in case users don't have core.autocrlf set. * text=auto # Explicitly set some EOL styles and preferred diff style @@ -15,7 +15,7 @@ # declare files that must always have specific EOL style *.dez text eol=crlf -# True binary files that should not be modify (just for safety sake) +# True binary files that should not be modified (just for safety sake) *.jpg binary *.png binary *.bmp binary @@ -2,4 +2,5 @@ *.ppu *.lps *.compiled -*.bak*
\ No newline at end of file +*.bak* +*.exe diff --git a/AUTHORS.txt b/AUTHORS.txt index d61ab73e..3f5a6bfc 100644 --- a/AUTHORS.txt +++ b/AUTHORS.txt @@ -10,23 +10,24 @@ Graeme Geldenhuys <graemeg@gmail.com> Implementation inspired by works from ------------------------------------- -Sebastian Guenther -Viktor Nagy +Sebastian Guenther for the very first fpGUI implementation +Viktor Nagy for ideas from the LPTK project Milan Marusinec (Milano) for the AggPas port Contributors ------------ -Felipe Monteiro de Carvalho +Alexsander Rosa Andrew Haines -Giuliano Colla -Jean-Marc Levecque Antonio Sanguigni -Vladimir Zhirov -Alexsander Rosa +David Laurence Emerson +Felipe Monteiro de Carvalho +Giuliano Colla Horacio Jamilis -Michael van Canneyt +Jean-Marc Levecque Jean-Pierre Anghel +Michael van Canneyt +Vladimir Zhirov ______________.o0O0o.______________ diff --git a/docs/build_html.sh b/docs/build_html.sh index fd36b7bf..b43cdd63 100755 --- a/docs/build_html.sh +++ b/docs/build_html.sh @@ -15,20 +15,12 @@ $app \ --input='-Fi../src/corelib ../src/corelib/x11/fpg_x11.pas' --descr=xml/corelib/x11/fpg_x11.xml \ --input='-Fi../src/corelib ../src/corelib/gdi/fpg_gdi.pas' --descr=xml/corelib/gdi/fpg_gdi.xml \ --input='-Fi../src/corelib -Fi../src ../src/corelib/fpg_main.pas' --descr=xml/corelib/fpg_main.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_cmdlineparams.pas' --descr=xml/corelib/fpg_cmdlineparams.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_extinterpolation.pas' --descr=xml/corelib/fpg_extinterpolation.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_imgfmt_bmp.pas' --descr=xml/corelib/fpg_imgfmt_bmp.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stdimages.pas' --descr=xml/corelib/fpg_stdimages.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringutils.pas' --descr=xml/corelib/fpg_stringutils.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_widget.pas' --descr=xml/corelib/fpg_widget.xml \ --input='-Fi../src/corelib -Fi../src/corelib/x11 ../src/corelib/fpg_utils.pas' --descr=xml/corelib/fpg_utils.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_popupwindow.pas' --descr=xml/corelib/fpg_popupwindow.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_wuline.pas' --descr=xml/corelib/fpg_wuline.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_imagelist.pas' --descr=xml/corelib/fpg_imagelist.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_constants.pas' --descr=xml/corelib/fpg_constants.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_pofiles.pas' --descr=xml/corelib/fpg_pofiles.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_translations.pas' --descr=xml/corelib/fpg_translations.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringhashlist.pas' --descr=xml/corelib/fpg_stringhashlist.xml \ --input='-Fi../src -Fu../src/corelib/x11/ -Fi../src/corelib/x11/ -Fu../src/gui/ -Fu../src/corelib/ ../src/corelib/fpg_command_intf.pas' --descr=xml/corelib/fpg_command_intf.xml \ --input='-Fi../src/gui ../src/gui/fpg_dialogs.pas' --descr=xml/gui/fpg_dialogs.xml \ --input='-Fi../src/gui ../src/gui/fpg_hyperlink.pas' --descr=xml/gui/fpg_hyperlink.xml \ diff --git a/docs/build_ipf.sh b/docs/build_ipf.sh index 14b0693c..bdb841b1 100755 --- a/docs/build_ipf.sh +++ b/docs/build_ipf.sh @@ -14,20 +14,12 @@ $app \ --input='-Fi../src/corelib ../src/corelib/x11/fpg_x11.pas' --descr=xml/corelib/x11/fpg_x11.xml \ --input='-Fi../src/corelib ../src/corelib/gdi/fpg_gdi.pas' --descr=xml/corelib/gdi/fpg_gdi.xml \ --input='-Fi../src/corelib -Fi../src ../src/corelib/fpg_main.pas' --descr=xml/corelib/fpg_main.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_cmdlineparams.pas' --descr=xml/corelib/fpg_cmdlineparams.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_extinterpolation.pas' --descr=xml/corelib/fpg_extinterpolation.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_imgfmt_bmp.pas' --descr=xml/corelib/fpg_imgfmt_bmp.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stdimages.pas' --descr=xml/corelib/fpg_stdimages.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringutils.pas' --descr=xml/corelib/fpg_stringutils.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_widget.pas' --descr=xml/corelib/fpg_widget.xml \ --input='-Fi../src/corelib -Fi../src/corelib/x11 ../src/corelib/fpg_utils.pas' --descr=xml/corelib/fpg_utils.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_popupwindow.pas' --descr=xml/corelib/fpg_popupwindow.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_wuline.pas' --descr=xml/corelib/fpg_wuline.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_imagelist.pas' --descr=xml/corelib/fpg_imagelist.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_constants.pas' --descr=xml/corelib/fpg_constants.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_pofiles.pas' --descr=xml/corelib/fpg_pofiles.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_translations.pas' --descr=xml/corelib/fpg_translations.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringhashlist.pas' --descr=xml/corelib/fpg_stringhashlist.xml \ --input='-Fi../src -Fu../src/corelib/x11/ -Fi../src/corelib/x11/ -Fu../src/gui/ -Fu../src/corelib/ ../src/corelib/fpg_command_intf.pas' --descr=xml/corelib/fpg_command_intf.xml \ --input='-Fi../src/gui ../src/gui/fpg_dialogs.pas' --descr=xml/gui/fpg_dialogs.xml \ --input='-Fi../src/gui ../src/gui/fpg_hyperlink.pas' --descr=xml/gui/fpg_hyperlink.xml \ diff --git a/docs/build_rtf.sh b/docs/build_rtf.sh index eb879f05..33b1825e 100755 --- a/docs/build_rtf.sh +++ b/docs/build_rtf.sh @@ -13,20 +13,13 @@ $app \ --input='-Fi../src/corelib ../src/corelib/x11/fpg_x11.pas' --descr=xml/corelib/x11/fpg_x11.xml \ --input='-Fi../src/corelib ../src/corelib/gdi/fpg_gdi.pas' --descr=xml/corelib/gdi/fpg_gdi.xml \ --input='-Fi../src/corelib -Fi../src ../src/corelib/fpg_main.pas' --descr=xml/corelib/fpg_main.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_cmdlineparams.pas' --descr=xml/corelib/fpg_cmdlineparams.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_extinterpolation.pas' --descr=xml/corelib/fpg_extinterpolation.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_imgfmt_bmp.pas' --descr=xml/corelib/fpg_imgfmt_bmp.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stdimages.pas' --descr=xml/corelib/fpg_stdimages.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringutils.pas' --descr=xml/corelib/fpg_stringutils.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_widget.pas' --descr=xml/corelib/fpg_widget.xml \ --input='-Fi../src/corelib -Fi../src/corelib/x11 ../src/corelib/fpg_utils.pas' --descr=xml/corelib/fpg_utils.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_popupwindow.pas' --descr=xml/corelib/fpg_popupwindow.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_wuline.pas' --descr=xml/corelib/fpg_wuline.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_imagelist.pas' --descr=xml/corelib/fpg_imagelist.xml \ --input='-Fi../src/corelib ../src/corelib/fpg_constants.pas' --descr=xml/corelib/fpg_constants.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_pofiles.pas' --descr=xml/corelib/fpg_pofiles.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_translations.pas' --descr=xml/corelib/fpg_translations.xml \ - --input='-Fi../src/corelib ../src/corelib/fpg_stringhashlist.pas' --descr=xml/corelib/fpg_stringhashlist.xml \ + --input='-Fi../src -Fu../src/corelib/x11/ -Fi../src/corelib/x11/ -Fu../src/gui/ -Fu../src/corelib/ ../src/corelib/fpg_command_intf.pas' --descr=xml/corelib/fpg_command_intf.xml \ --input='-Fi../src/gui ../src/gui/fpg_dialogs.pas' --descr=xml/gui/fpg_dialogs.xml \ --input='-Fi../src/gui ../src/gui/fpg_hyperlink.pas' --descr=xml/gui/fpg_hyperlink.xml \ --input='-Fi../src/gui ../src/gui/fpg_colormapping.pas' --descr=xml/gui/fpg_colormapping.xml \ diff --git a/docs/fpGUIHelpIntegration.lpk b/docs/fpGUIHelpIntegration.lpk index 7d02a4e4..81c16ce8 100644 --- a/docs/fpGUIHelpIntegration.lpk +++ b/docs/fpGUIHelpIntegration.lpk @@ -24,7 +24,7 @@ "/> <License Value="LGPL "/> - <Version Minor="3"/> + <Version Major="1" Minor="2"/> <Files Count="1"> <Item1> <Filename Value="pkghelpfpGUI.pas"/> diff --git a/docs/fpGUI_tech_ref.tex b/docs/fpGUI_tech_ref.tex deleted file mode 100644 index b62c959b..00000000 --- a/docs/fpGUI_tech_ref.tex +++ /dev/null @@ -1,243 +0,0 @@ -\documentclass[a4paper,11pt]{report} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Edited: 2010-02-23 -% NOTE: -% THIS DOCUMENT IS OUTDATED. IT WAS BASED ON THE fpGUI v0.4 DESIGN. -% -% This file remains in the repository for historic purposes only. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% Define the title -\author{Graeme Geldenhuys} -\title{fpGUI - A technical reference} - -% Some custom settings -\setlength{\parindent}{0pt} -\setlength{\parskip}{1ex plus 0.5ex minus 0.2ex} - -\begin{document} - -% generates the title -\maketitle -\newpage - -% insert the table of contents -\tableofcontents -\newpage - -% ******************************************************************* -\chapter{Introduction} -After developing many cross platform applications with Kylix and Delphi -I started getting very frustrated with the differences between the look and -behavior of the applications under Linux and Windows. The code was also -riddled with IFDEF statements. - -Then I stumbled across the Free Pascal and Lazarus projects. I thought this -is it, the answer to all my cross platform development problems. Unfortunately -after working with Lazarus for a few months I started finding more and more -issues with the widget sets, though the IDE was great. - -The Lazarus LCL is a wrapper for each platforms native widget set. This -brought with it the same issues I experienced with Kylix and Delphi. This got -me thinking about how I could resolve this issue. - -Then it hit me - implement the widget set myself using Free Pascal! Painting -the widgets myself to get a consistent look and implementing a consistent -behaviour. Instead of reinventing the wheel, I thought I would do some searching -to see if there is another project I can contribute to or help by giving me -a head start. - -The first version of my widget set was based around a heavily modified version -of the Light Pascal Toolkit\footnote{http://sourceforge.net/projects/lptk}. -I then discovered the discontinued fpGUI and fpGFX projects. I tried -to contact the original author to no avail. The fpGUI code hasn't been -touched in four years (since early 2002). After studying the code for a -few weeks, I came to the conclusion that fpGUI is much closer to what I strived -to accomplish with my modified LPTK. A lot was still missing from fpGUI though. - -After thinking long and hard, I decided to start my widget set again, but -this time based on the work done in fpGUI and fpGFX. I also added to the -mix some good ideas I saw in Qt 4.1. So far I have completed quite a few things -missing in fpGUI, but I still need to do a lot to get to the point where I -can test drive it in a commercial application. I set myself a list of -things outstanding which should get it to a usable level. I also added a -lot of documentation as I went as there was no documentation included with -the original fpGUI and fpGFX projects. Documentation is important -to attract other developers in using the widget set. - - - -% ******************************************************************* -\chapter{GUI and Events} -This chapter is currently a copy and paste of an email I wrote explaining -how the events work. The difference between the GFX events and the GUI events. -Soon I will rewrite this chapter and add a lot more detail. Here follows the email -text for now. - -The GFX part gets events from the windowing system, be that X11 or -GDI. That means that TFCustomWindow gets all the events from the -windowing system. - -Now the GUI part. Every widget is \emph{not} a TFCustomWindow, so every -widget doesn't have a Handle. The GUI is implemented with only one -handle per Form (TFForm). All widgets are just painted onto the canvas -of the TFForm. - -If you look at the TFCustomForm you will see it has a instance of -TFCustomWindow stored in FWnd. That instance gets all the events from -the windowing system. So to let the widgets also get events we have to -implement our own event system. The TFCustomForm will then send those -custom events (TEventObj descendants) by translating the windowing -events into our custom GUI events. - -For example:\\ -Lets say we have a Form with a Button on it. Now we want to handle a -OnMouseMove event on the Button. The flow of events will go as follows: - -\begin{itemize} - \item TFCustomForm.Wnd will receive the OnMouseMove from the windowing -system and process it in the WndMouseMoved() method. - - \item WndMouseMoved() will translate that windowing system event into -whatever GUI events are needed and start sending them. - - \item Any TWidget descendant handles events in the ProcessEvent() method. -TWidget being the big one. - - \item Because TFCustomForm is a TFContainerWidget descendant, it means it -can contain other widgets. So it starts distributing the GUI events to -the children. Distribution is done by the DistributeEvent() method. - - \item If TFCustomButton needed to do any special processing with the GUI -event, it would handle it in its ProcessEvent() method. -TWidget.ProcessEvent normally does most of the generic work. - - \item As an example of a widget that does custom processing, have a -look at the TFMenuItem.ProcessEvent(). In this case it handles the -TMouseEnterEventObj and TMouseLeaveEventObj events so it can changes -it's look when the mouse enters a menu item or leaves a menu item. -\end{itemize} - -So as a summary:\\ -TFCustomForm contains a instance of a GFX window. Translates all the -GFX events (underlying windowing events) to GUI events (TEventObj -descendants) and distributes them to the children of the Form. - - -% ******************************************************************* -\chapter{Layout Algorithm} - -\section{Initialisation of a window (form)} -If a window presents itself for the first time, and no standard size was - given, then it must compute these. - This is a recursive process, with which the event TCalcSizesEventObj is - set for all children of the window from top to bottom in the Widget tree - (beginning with the window). - TWidget reacts to the receipt of this event as follows (in TWidget.EvCalcSizes): - -\begin{itemize} - \item The event is passed on with TWidget.DistributeEvent to all children. - - \item The virtual protected method TWidget.DoCalcSizes is called. - Again derived Widgets overwrites this method, in order to compute its sizes - of (minimum, maximum, optimum). - - \item The results of DoCalcSizes are if necessary corrected, e.g. - the maximum size may not be smaller than the minimum size. - - \item If the code for the window finished the dispatch of this event, all Widgets - in the window has valid statements of size. - Now it can do its own, initials size sets (this is the before computed - optimum size of the window). - This is accomplished by TWidget.SetBounds. -\end{itemize} - -... to be continued ... - - -% ******************************************************************* -\chapter{Single vs Multi handle decision} - -... to be written ... - -What follows below are just some snippets from the newsgroup and mailing -lists that I want to reorganise into a chapter. These are things that -were discussed that I don't want to forget. - -\section{Notes from the newsgroup} -One handle per Form. Widgets are just painted onto the Form canvas. This -will support the most platforms and give us a consistent behavior. - -See the /prototype/multihandle directory. - -I spoke to Martin Schreiber (MSEgui author) about this as well and the -better way seems to be to have one handle per Form (window) and do you -own custom events. Implementing as much as you can yourself, will give -you a consistent behavior on all platforms and make it more portable. - -Martin also tried to implement one handle per widget and came to the -following conclusion with makes sense. If you want you GUI Framework to -work the same across multiple platforms, you cannot rely on specific -behavior on a platform. With one handle per widget you are relying on -the underling windowing systems event handling and may very well differ -from another platform (which it normally does). This is what Martin -experienced, and the only way to get consistent event handling was to do -if yourself. Clipping regions was another issue Martin mentioned. - -All his points made perfect sense to me, so I continued with the fpGUI -based on one handle per Form and will guarantee that all events, and -clipping regions will work exactly the same on all platforms. Just -creating the simple prototype I already experienced different behaviors -between Windows and Linux. - -See the thread titled "Comments from Martin Schreiber" dated 2006-12-07. -There I posted some of the discussions with Martin. - -But then I remembered a very strong argument for one handle per window: -Some platforms I would like to see fpGUI running on the future simply don't support one window inside another. Like Linux Framebuffer for example. I'm not sure about Symbian OS UIQ 3, but I think too. - - -\section{Email from Martin Schreiber} -Pro's for to have a window handle for every widget: -It is possible to use more code from the operating system (clipping, -focus handling, mouse enter/leave... - -Con's: -The functionality of your widgets depends on the OS. It is not easy to -achieve the same behavior with different systems. -You have less control over the behavior of the widgets. -If there are very much widgets in a application there can be performance -and resource problems (in win95/98 the maximal count of gdi objects and -window handles is limited). -You probably need to implement simplified widgets without handles too -(TGraphicControl) which brakes orthogonality. - -I did three attempts to develop a GUI environment, the first approach -was based on VCL, the second on CLX and now MSEgui which is done from -scratch. -With VCL and CLX I needed very much time to find workarounds to change -their behavior, some things where simply not possible to realize. -With about the same expenditure of time I have reached in MSEgui a -really enjoyable level. -As an example, the implementation of transparent widgets took me weeks -in VCL/CLX, semi-transparency was almost unreachable. -In MSEgui I could implement transparent widgets in 10 minutes because my -self developed clipping handling was flexible enough. - -So my tip is to do as much as possible by your self, at the end you will -need less time and the quality will be much better. -But don't underestimate the expenditure of the project. -For comparison: I invested about 10'000 hours into the development of -MSEide+MSEgui up to now. - -Martin - -% ******************************************************************* -\chapter{Database Components} - -... to be written ... - - -\end{document} diff --git a/docs/fpc_lang_ref.ipf b/docs/fpc_lang_ref.ipf index c6440957..abe951e9 100644 --- a/docs/fpc_lang_ref.ipf +++ b/docs/fpc_lang_ref.ipf @@ -5003,7 +5003,7 @@ internally to denote 'nodefault'. :p. aoeu .* START HERE !!!!!!!!!!!!!!!!!!!!!! - +:h5.*** START HERE *** .* ============================================================== :h2 name=interfaces.Interfaces @@ -5156,7 +5156,7 @@ used by a program or another unit. The syntax for a unit is as follows: &ra.─────┬────────────────────────────────────────────┬─ :hp2.end:ehp2. ── . ─────────────────&ra.&la. ├─ initialization part ─┬───────────────────┬┤ │ â”” finalization part ┘│ - └─ :hp2.begin:ehp2. ─── statement ─┬───────────────────┘ + └─ :hp2.begin:ehp2. ─┬─ statement ─┬───────────────────┘ ^───── ; ─────┘ &ra.&ra.─── unit header ── :hp2.unit:ehp2. ── unit identifier ── ; ──────────────────────────────&ra.&la. diff --git a/docs/fpgui-docs-project.xml b/docs/fpgui-docs-project.xml index c4758228..48395aba 100644 --- a/docs/fpgui-docs-project.xml +++ b/docs/fpgui-docs-project.xml @@ -45,6 +45,8 @@ <unit file="../src/gui/fpg_tree.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <!-- undocumented units --> + <unit file="../src/corelib/fpg_dbugintf.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> + <unit file="../src/corelib/fpg_dbugmsg.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_animation.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_checkbox.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_combobox.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> @@ -69,14 +71,18 @@ <unit file="../src/gui/fpg_radiobutton.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_readonly.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_scrollbar.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> + <unit file="../src/gui/fpg_scrollframe.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_spinedit.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_splitter.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style_bitmap.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style_bluecurve.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> + <unit file="../src/gui/fpg_style_carbon.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style_clearlooks.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style_motif.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> + <unit file="../src/gui/fpg_style_plastic.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_style_win2k.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> + <unit file="../src/gui/fpg_style_win8.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_stylemanager.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_tab.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> <unit file="../src/gui/fpg_trackbar.pas" options="-Fi../src -Fu../src/gui/ -Fu../src/corelib/"/> @@ -133,15 +139,20 @@ and value as on the actual command-line. Boolean options must have a value of 'true', '1' or 'yes' --> <option name="format" value="ipf"/> + <option name="hide-protected" value="true"/> + <option name="duplinkeddoc" value="true"/> <!-- + ## Various output formats <option name="format" value="ipf"/> <option name="format" value="html"/> <option name="format" value="rtf"/> <option name="format" value="chm"/> ---> + + ## Options for IPF output <option name="hide-protected" value="true"/> <option name="duplinkeddoc" value="true"/> -<!-- + + ## Options for HTML output <option name="footer-date" value="yyyy-mm-dd"/> --> </options> diff --git a/docs/git_howto.txt b/docs/git_howto.txt new file mode 100644 index 00000000..ce532d0e --- /dev/null +++ b/docs/git_howto.txt @@ -0,0 +1,170 @@ +> Hi. I'm on develop branch. I commited change, how can I push it to +> you? + +I'll explain the preferred method, instead of the simpler "send me a +patch file". The preferred method has many more benefits for you and me, +and makes integrating other developers changes easier. + +This is a bit long winded, but most of it is actually just about +setting up a new remote repository. This setup process is only done +once. The actual "how to share a branch with others" is answered near +the end. So if you know how to setup a forked Github repository, then +just skip to the end. + + +Using Github +------------ +If you cloned from SourceForge or from my GitHub repository, then you +only have "read" access. So you will not be allowed to push changes. + +Best is to register with Github (it is free, and very quick). Browse to +my fpGUI repository on Github (it is a mirror of the SourceForge one). + + http://github.com/graemeg/fpGUI + +Click the "fork" button. Github will now fork my repository, and you +should end up with a fpGUI repository in your github account. + + NOTE: This fork isn't automatically kept in sync with mine - it is + your repository - you keep it up to date via 'git push'. + +Now back in your Github account, note the read-write URI for the fpGUI +repository. It will be something like... + + git@github.com:<username>/fpGUI.git + +Now on your PC, simply add the remote repository (no need to do a new +clone): + + git remote add github <read-write url supplied by Github> + +Now you can do a 'git fetch github' or 'git pull github'... If your +repository was up to date, nothing will be updated accept for references +to the branches in the 'github' remote. + +If you do a 'git remote' command, you should now see 'origin' and +'github' listed. + + +Lets do some coding (in a separate branch) +------------------------------------------ +Now you can get to the "lets do some programming bit". Create a new +branch off 'develop', which we call a "feature" branch. + + NOTE: Never do development work in 'master' or the 'develop' + branches. This will just cause you unnecessary work, and makes + my job more difficult fetching code from your repository. + + $> git checkout -b myfeature develop + +Now write some code, an make some commits. All the commits will go +into the branch named 'myfeature'. To see a graphical overview of your +repository, type 'gitk --all' + + +Moving local commits out of a wrong branch +------------------------------------------ +Now if you accidentally made commits in 'master' or 'develop', it is +not a problem to fix. This is the huge benefit of Git. Commits are +local at first, so things can be shuffled around before you make them +public. + +The easiest way to fix commits in a wrong branch, is to use the GUI +tool 'gitk'. Run 'gitk --all' + +Find the commit under the 'develop' branch that still references +'origin/develop', then right-click and select "Create new branch". +Give at a meaningful name. We'll call it 'feature-1' just for now: + +Now close gitk, and switch to that new branch. + + git checkout feature-1 + +Now back into gitk via 'gitk --all'. The 'feature-1' branch will be in +bold, indicating it is the current branch. Now we are going to +cherry-pick commits from another branch. This just means we are going +to duplicate commits from one branch into another. + +Find the commit(s) you made in the wrong branch. From oldest to +newest, select a commit, right-click and select "Cherry-pick this +commit". You will now see that commit is duplicated in your +'feature-1' branch. Keep going until you have cherry-picked all your +commits you want to move. + +Now you should have all your commits is the right branch, but +'develop' still has them too. No problem. We will simply tell git +discard those commits, by resetting the 'develop' branch to match +'origin/develop'. + +Select the commit containing the reference 'origin/develop' (this +should be the same commit you branched your 'feature-1' branch from. +Right click on that commit, and select "Reset develop branch to here". + +Now if you refresh the view, F5, or quit and restart gitk, you will +see your local commit history has been fixed, and your local commits +have been moved to the feature branch. + + +How to share my feature branch +------------------------------ +Finally, we want to share the 'myfeature' branch, so we need to push +it to the 'github' remote. + + $> git push github myfeature + + +This will push the 'myfeature' branch to your repository on Github. +Now on the Github website under the 'myfeature' branch, there should +be a button "send a pull request". Click that, and I'll be notified +via email to take a look at your code. + +To keep your repository in sync with the official fpGUI repository, +pull from 'origin' (which will be SourceForge, or my fpGUI mirror on +Github - depending which repository you clone in the beginning). Make +sure you are in say the 'master' branch. Then do the following: + + $> git push github + + +How to delete a remote branch +----------------------------- +Once you are done with a branch you shared - for example if it was +merged into the official fpGUI code, then you can delete the branch +from your Github repository. + + $> git push github :myfeature + + +How to delete a local branch +---------------------------- +Now the 'myfeature' branch is deleted on the remote repository. Now +you can delete it locally on your PC too. Make sure you our in some +other branch, not 'myfeature'. + +eg: $> git checkout master + $> git branch -d myfeature + + + +For any details on any of the commands used above, Git includes +excellent help. Just type: + + $> git help <command> + +eg: + + $> git help remote + $> git help branch + $> git help push + + + +The Github also has some excellent documentation on using Git, and +using the Github services. Here is one such document. + +About Remote Repositories: + https://help.github.com/categories/18/articles + + + --------------------[ end ]--------------------- + diff --git a/docs/layouting_de.html b/docs/layouting_de.html deleted file mode 100644 index 0d2f5c0c..00000000 --- a/docs/layouting_de.html +++ /dev/null @@ -1,129 +0,0 @@ -<html><head><title>fpGUI Layouting</title> - - -<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> -<meta name="Generator" content="LaTeX2HTML v2K.1beta"></head><body> - -<h1><a name="SECTION00010000000000000000"> -Der fpGUI Layouting-Algorithmus</a> -</h1> - -Sebastian Günther, 2001-02-12 - -<p> - -</p><h2><a name="SECTION00011000000000000000"> -Initialisierung eines Fensters (Forms)</a> -</h2> - -<p> -Wenn sich ein Fenster zum ersten Mal darstellt, und keine Standardgröße vorgegeben -wurde, dann muß es diese selbst berechnen. Dies ist ein rekursiver Prozeß, bei -dem allen Kindern des Fensters das Ereignis <tt>TCalcSizesEventObj</tt> von -oben nach unten im Widget-Baum zugestellt wird (beginnend beim Fenster selbst). -<tt>TWidget</tt> reagiert auf den Empfang dieses Ereignisses folgendermaßen -(in <tt>TWidget.EvCalcSizes</tt>): - -</p><p> - -</p><ol> -<li>Das Ereignis wird mit <tt>TWidget.DistributeEvent</tt> an alle Kinder weitergeleitet -</li> -<li>Die virtuelle geschützte Methode <tt>TWidget.DoCalcSizes</tt> wird aufgerufen. -Abgeleitete Widgets überschreiben diese Methode, um ihre Größen (Minimum, Maximum, -Optimum) neu zu berechnen. -</li> -<li>Die Ergebnisse von <tt>DoCalcSizes</tt> werden ggf. korrigiert, z.B. darf die -Maximalgröße nicht kleiner als die Minimalgröße sein. -</li> -</ol> -Wenn der Code für das Fenster den Versand dieses Ereignisses fertiggestellt -hat, haben alle Widgets im Fenster gültige Größenangaben. Nun kann es seine -eigene, initiale Größe setzen (dies ist die vorher berechnete Optimum-Größe -des Fensters). Dies wird per <tt>TWidget.SetBounds</tt> durchgeführt. - -<p> - -</p><h2><a name="SECTION00012000000000000000"> -Zuweisung einer neuen Position und Größe mit <tt>TWidget.SetBounds</tt></a> -</h2> - -<p> -<tt>SetBounds</tt> dient zwei Zwecken: Dem Setzen einer neuen Position, und -dem Setzen einer neuen Größe für ein Widget. Zunächst werden die neuen Daten -ins Widget übernommen. <tt>SetBounds</tt> überprüft anschließend, ob eine Größenänderung -vorliegt - wenn ja, wird ein <tt>TApplySizeEventObj</tt>-Ereignis ausgelöst. -Der Default-Handler in TWidget führt nun zwei einfache Schritte durch: - -</p><p> - -</p><ol> -<li>Aufruf der virtuellen geschützten Methode <tt>TWidget.DoApplySize</tt> -</li> -<li>Weiterleitung des Ereignisses an alle Kinder per <tt>TWidget.DistributeEvent</tt> -</li> -</ol> -<tt>DoApplySize</tt> dürfte von allen Widgets überschrieben werden, die Kinder -besitzen - denn dies ist der einzig richtige Ort, um die Kinder zu layouten -(also ihre Position und Größe festzulegen.) - -<p> -Das <tt>TApplySizeEventObj</tt>-Ereignis führt ein wichtiges Flag mit: <tt>ForcedSize</tt> -gibt an, ob die nun folgende Größenänderung 'erzwungen' ist oder nicht. Erzwungen -bedeutet, daß Änderungen an untergeordneten Widgets (s.u.) <i>keinen</i> erneuten -Layout-Vorgang auslösen sollen. Dies wird beispielsweise in folgenden Fällen -genutzt: - -</p><p> - -</p><ul> -<li>Der Anwender hat ein Fenster manuell auf eine bestimmte Größe gebracht -</li> -<li>Eine ScrollBox löscht üblicherweise dieses Flag für ihre Kinder auf jeden Fall, -da der Inhalt der ScrollBox meist unabhängig von dem 'Drumherum' ist. -</li> -</ul> -Der aktuelle 'Gezwungenheits-Zustand' wird über das Flag <tt>wsSizeIsForced</tt> -in <tt>TWidget.WidgetState</tt> angezeigt. - -<p> -Forms behandeln dieses Ereignis auf etwas andere Art und Weise: Der Wunsch nach -einer Größenänderung wird an das unterliegende fpGFX-Fenster weitergeleitet; -dieses liefert irgendwann die Nachricht, daß nun die neue Größe aktiv ist. Als -Reaktion ruft es nun <tt>TWidget.SetBounds</tt> <i>für sich selbst</i> auf - -also die geerbte Methode. Diese sorgt dann, wie bei anderen Widgets auch, für -ein korrektes Layouting. - -</p><p> - -</p><h2><a name="SECTION00013000000000000000"> -Änderungen eines Widgets</a> -</h2> - -<p> -Wenn sich bestimmte Eigenschaften eines Widgets ändern, kann sich dadurch auch -dessen Größe ändern. Bei Verdacht auf Größenänderung sollten Widgets intern -immer die Methode <tt>TWidget.Update</tt> aufrufen. Ist die Größe des aktuellen -Widgets erzwungen, so bricht diese Methode sofort ab. Ansonsten wird zunächst -eine neue Berechnung der Größen per <tt>TCalcSizesEventObj</tt>-Ereignis veranlaßt. -Sollten diese nun von den alten Größen abweichen, so wird das Ereignis <tt>TUpdateEventObj</tt> -ausgelöst. Dieses wird <tt>nicht</tt> an Kinder weitergeleitet, stattdessen -ruft der Default-Handler in <tt>TWidget</tt> die <tt>Update</tt>-Methode des -Eltern-Widgets auf. Der Handler für Forms reagiert auf dieses Ereignis allerdings -mit einer Anpassung der Fenstergröße mit Hilfe der <tt>SetBounds</tt>-Methode. - -</p><p> - -</p><h2><a name="SECTION00014000000000000000"> -Widget ändert seine Sichtbarkeit</a> -</h2> - -<p> -Wenn ein normales Widget sichtbar oder unsichtbar wird, und diese Änderung vom -Widget selbst (und nicht seinem Eltern-Widget) ausgelöst wurde, dann wird für -das Eltern-Widget die <tt>TWidget.Update</tt>-Methode aufgerufen. Dieses prüft -nun den Einfluß dieser Änderung auf das Layout, und löst ggf. ein Relayouting -aus. - - -</p></body></html>
\ No newline at end of file diff --git a/docs/manifest.xml b/docs/manifest.xml index d89f8ec5..addb40c3 100644 --- a/docs/manifest.xml +++ b/docs/manifest.xml @@ -1,8 +1,8 @@ <?xml version="1.0"?> <packages> <package name="fpgui"> - <version major="0" minor="6" micro="3" build="0"/> - <filename>fpgui-0.6.3-0.zip</filename> + <version major="1" minor="2" micro="0" build="0"/> + <filename>fpgui-1.2.0-0.zip</filename> <author>Graeme Geldenhuys</author> <license>Modified LGPL</license> <email>graemeg@gmail.com</email> diff --git a/docs/xml/corelib/fpg_base.xml b/docs/xml/corelib/fpg_base.xml index 05a1f72f..f052e2f0 100644 --- a/docs/xml/corelib/fpg_base.xml +++ b/docs/xml/corelib/fpg_base.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="UTF-8"?> +<?xml version="1.0"?> <fpdoc-descriptions> <package name="fpGUI"> @@ -52,7 +52,7 @@ etc.). <!-- record type Visibility: default --> <element name="TRGBTriple"> <short>A record structure holding the RGBA values of a color</short> - <descr><printshort id="TRGBTriple"/>. This is now marked as "deprecated". Please use <link id="fpg_base.TFPColor">TFPColor</link> instead.</descr> + <descr><printshort id="TRGBTriple"/>.</descr> <seealso/> </element> <!-- variable Visibility: default --> @@ -79,8 +79,8 @@ means no titlebar or window borders are going to be created.</short> </element> <!-- enumeration value Visibility: default --> <element name="TWindowType.wtModalForm"> - <short>This windows type is similar to <link id="fpg_base.TWindowType.wtWindow">wtWindow</link>, but grabs focus.</short> - <descr>This windows is the same as <link id="fpg_base.TWindowType.wtWindow">wtWindow</link>, but grabs the input focus until it has closed. This window normally doesn't appear in the taskbar.</descr> + <short>This windows type is similar to wtWindow, but grabs focus.</short> + <descr>This windows is the same as <link id="#fpgui.fpg_base.TWindowType.wtWindow">wtWindow</link>, but grabs the input focus until it has closed. This window normally doesn't appear in the taskbar.</descr> </element> <!-- enumeration value Visibility: default --> <element name="TWindowType.wtPopup"> @@ -717,18 +717,18 @@ help.</remark></descr> it brings a window to the front - above all other windows of the application. Note that this only changes the z-order, it doesn't actually change window focus.</descr> <seealso> -<link id="fpg_base.TfpgWindowBase.ActivateWindow"></link> +<link id="fpg_base.TfpgWindowBase.ActivateWindow"/> </seealso> </element> <element name="TfpgWindowBase.ActivateWindow"> -<short>This makse the target window the active window</short> +<short>This makes the target window the active window</short> <descr>This doesn't have much meaning at the widget level, but at the TfpgForm level, it makes the target window the active window. Note that depending on the operating system and Window Manager, the active window could still be obscured by other windows. Under Windows, it seems that the active window is always brought to the front too.</descr> <seealso> -<link id="#fpgui.fpg_base.TfpgWindowBase.BringToFront"></link> +<link id="#fpgui.fpg_base.TfpgWindowBase.BringToFront"/> </seealso> </element> @@ -831,6 +831,10 @@ consecutive lines being drawn without overlapping pixels.</descr> <element name="TfpgCanvasBase.StretchDraw"> <short>Allows you to draw a bitmap, stretched or shrunken from its original size</short> +<descr><printshort id="#fpgui.fpg_base.TfpgCanvasBase.StretchDraw"/>. Default +interpolation is <link id="#fpgui.fpg_base.TfpgMitchelInterpolation">TfpgMitchelInterpolation</link>, +but others (found in <link id="#fpgui.fpg_extinterpolation">fpg_extinterpolation.pas</link>) can +be used too, by using the <link id="#fpgui.fpg_base.TfpgCanvasBase.InterpolationFilter">InterpolationFilter</link> property of the Canvas.</descr> </element> <!-- function Visibility: default --> @@ -931,6 +935,7 @@ Right. And the Top is always smaller than the Bottom. <descr>This does not do any drawing, in only clips the line coordinates. This method is used internally by <link id="TfpgCanvasBase.DrawLineClipped"/>.</descr> </element> + <element name="TfpgCanvasBase.GradientFill"> <short>Paints a rectangle with a gradient</short> <descr><printshort id="#fpgui.fpg_base.TfpgCanvasBase.GradientFill"/>. If the gradient direction is @@ -939,6 +944,71 @@ set to gdVertical, then it paints from top to bottom.</descr> </element> +<element name="TfpgCanvasBase.DrawArc"> +<short>Draws an outline arc shape</short> +<descr><p><printshort id="#fpgui.fpg_base.TfpgCanvasBase.DrawArc"/>. It uses the TfpgCanvas.Color +value to draw the arc.</p> +<dl> +<dt>x</dt> +<dd>The left x co-ordinate of the arc drawing position</dd> +<dt>y</dt> +<dd>The top y co-ordinate of the arc drawing position</dd> +<dt>w</dt> +<dd>The width of the whole arc</dd> +<dt>h</dt> +<dd>The height of the whole arc</dd> +<dt>a1</dt> +<dd>This is the starting point of the arc. A value of 0 is the 3 o'clock +position. A value of 270 is the 6 o'clock position. Positive values move +counter-clockwise, and negative values move clockwise.</dd> +<dt>a2</dt> +<dd>This parameter is the length of the arc in degrees. A positive value +goes counter-clockwise, and a negative values goes clockwise.</dd> +</dl> +</descr> +<seealso> + <link id="#fpgui.fpg_base.TfpgCanvasBase.FillArc">TfpgCanvasBase.FillArc</link> +</seealso> +<example file="examples/fpg_base.fpgcanvasbase.drawarc.pas"/> +</element> + + +<element name="TfpgCanvasBase.FillArc.a1"> +<descr>This is the starting point of the arc. A value of 0 is the 3 o'clock +position. A value of 270 is the 6 o'clock position. Positive values move +counter-clockwise, and negative values move clockwise.</descr> +</element> + + +<element name="TfpgCanvasBase.FillArc"> +<short>Draws a filled arc shape</short> +<descr><p><printshort id="#fpgui.fpg_base.TfpgCanvasBase.FillArc"/>. It uses the TfpgCanvas.Color +value to draw and fill the arc.</p> +<dl> +<dt>x</dt> +<dd>The left x co-ordinate of the arc drawing position</dd> +<dt>y</dt> +<dd>The top y co-ordinate of the arc drawing position</dd> +<dt>w</dt> +<dd>The width of the whole arc</dd> +<dt>h</dt> +<dd>The height of the whole arc</dd> +<dt>a1</dt> +<dd>This is the starting point of the arc. A value of 0 is the 3 o'clock +position. A value of 270 is the 6 o'clock position. Positive values move +counter-clockwise, and negative values move clockwise.</dd> +<dt>a2</dt> +<dd>This parameter is the length of the arc in degrees. A positive value +goes counter-clockwise, and a negative values goes clockwise.</dd> +</dl> +</descr> +<seealso> + <link id="#fpgui.fpg_base.TfpgCanvasBase.DrawArc">TfpgCanvasBase.DrawArc</link> +</seealso> +<example file="examples/fpg_base.fpgcanvasbase.fillarc.pas"/> +</element> + + <element name="TFileEntry"> <short>A simple data object representing a file</short> <descr><printshort id="TFileEntry"/>. Some properties are OS dependant.</descr> @@ -971,8 +1041,7 @@ set to gdVertical, then it paints from top to bottom.</descr> <element name="TFPColor"> <short>A record structure holding the RGBA values of a color.</short> <descr>This is the same declaration as the one found in FPImage (included with the -Free Pascal Compiler). In future when FPImage is integrated with fpGUI, this declaration -will be removed.</descr> +Free Pascal Compiler). Except the fpGUI version uses Byte values and not Word values. This is now marked as "deprecated". Please use <link id="fpg_base.TRGBTripple">TRGBTripple</link> instead.</descr> </element> <element name="TfpgPoint"> @@ -1038,18 +1107,22 @@ for more information.</p></descr> </element> <element name="TfpgApplicationBase"> -<short>aoeu</short> -<descr></descr> +<short>Base class for the fpgApplication variable</short> +<descr>This is the base class of TfpgApplication. All fpGUI-based applications +will contain a instance of TfpgApplication. It encapsulates the application as +a whole, and also supplies many useful functions and events.</descr> </element> <element name="TfpgApplicationBase.HelpFile"> <short>Specify a help file for the application</short> -<descr>bla bla bla</descr> +<descr>This property is used to assign the help file (normally an INF file) which +contains the help for the application.</descr> </element> <element name="TfpgApplicationBase.InvokeHelp"> <short>Run the help viewer</short> -<descr>bla bla bla</descr> +<descr>This method will invoke the defined help viewer, passing it the HelpContext +or HelpKeyword as parameter. The default help viewer is fpGUI's DocView.</descr> </element> diff --git a/docs/xml/corelib/fpg_extinterpolation.xml b/docs/xml/corelib/fpg_extinterpolation.xml index af129a1f..81d66e83 100644 --- a/docs/xml/corelib/fpg_extinterpolation.xml +++ b/docs/xml/corelib/fpg_extinterpolation.xml @@ -4,7 +4,7 @@ <module name="fpg_extinterpolation"> <short>Extra interpolation filter declarations.</short> <descr> - <p>Some more interpolation filters for <link id="fpg_base.TfpgCanvasBase.StretchDraw">TfpgCanvasBase.StretchDraw</link>:<br/> + <p>This unit defines more interpolation filters for <link id="fpg_base.TfpgCanvasBase.StretchDraw">TfpgCanvasBase.StretchDraw</link>:<br/> Bessel, Gaussian and Sinc are infinite impulse response (IIR), the others are finite impulse response (FIR). The implementation of Bessel and Sinc are windowed with Blackman filter.</p> diff --git a/docs/xml/gui/fpg_tree.xml b/docs/xml/gui/fpg_tree.xml index 6a69fd64..da1c631f 100644 --- a/docs/xml/gui/fpg_tree.xml +++ b/docs/xml/gui/fpg_tree.xml @@ -10,6 +10,20 @@ You can include icons with items' text labels and display different icons to indicate whether a node is expanded or collapsed.</p> </descr> +<element name="TfpgTreeNode"> +<short>TfpgTreeNdoe describes an individual node in a tree view widget.</short> +<descr>Each node in a tree view control consists of a label and an optional +bitmapped image. Each item can be the parent of a list of subitems. By clicking +an item, the user can expand or collapse the associated list of subitems.</descr> +<seealso> + <link id="fpgui.fpg_tree.TfpgTreeView">TfpgTreeView</link> +</seealso> +</element> + +<element name="TfpgTreeNode.TreeView"> +<short>Specifies the tree view widget that displays the node.</short> +<descr>Use TreeView to determine the tree view associated with the tree node.</descr> +</element> <element name="TfpgTreeView"> <short>Represents a window that displays a hierachy list of items</short> @@ -21,6 +35,9 @@ in a tree view control consists of a label and a number of optional bitmapped im Each node can have a list of subnodes associated with it. By clicking on a node, the user can expand or collapse the associated list of subnodes.</p> <remark>There is basic column support, but this is still very experimental.</remark></descr> +<seealso> + <link id="fpgui.fpg_tree.TfpgTreeNode">TfpgTreeNode</link> +</seealso> </element> <element name="TfpgTreeView.FullCollapse"> diff --git a/docview/components/richtext/CanvasFontManager.pas b/docview/components/richtext/CanvasFontManager.pas index 9e9114ec..edeb8cb9 100644 --- a/docview/components/richtext/CanvasFontManager.pas +++ b/docview/components/richtext/CanvasFontManager.pas @@ -35,7 +35,7 @@ type private FWidget: TfpgWidget; FCanvas: TfpgCanvas; - FFont: TfpgFont; + FFontCache: TFPList; function GetCurrentFont: TfpgFont; procedure SetDefaultFont(const AValue: TfpgFont); protected @@ -235,14 +235,20 @@ begin FWidget := AWidget; FDefaultFont := fpgGetFont(DefaultTopicFont); FCanvas.Font := FDefaultFont; - FFont := nil; + FFontCache := TFPList.Create; end; destructor TCanvasFontManager.Destroy; +var + i: Integer; begin FCanvas.Font := fpgApplication.DefaultFont; FDefaultFont.Free; - FFont.Free; + + for i := 0 to FFontCache.Count-1 do + TObject(FFontCache.Items[i]).Free; + FFontCache.Free; + inherited Destroy; end; @@ -262,6 +268,11 @@ end; // Set the current font for the canvas to match the given // spec, creating or re-using fonts as needed. procedure TCanvasFontManager.SetFont(const AFontDesc: TfpgString); +const + MAX_FONT_CACHE = 10; +var + i: Integer; + Tmp: TfpgFont; begin if FCanvas.Font.FontDesc = AFontDesc then Exit; // nothing to do so exit @@ -272,10 +283,25 @@ begin Exit; end; - if Assigned(FFont) then - FFont.Free; - FFont := fpgGetFont(AFontDesc); - FCanvas.Font := FFont; + for i := 0 to FFontCache.Count-1 do + begin + Tmp := TfpgFont(FFontCache.Items[i]); + if Tmp.FontDesc = AFontDesc then + begin + FFontCache.Move(i, 0); + FCanvas.Font := Tmp; + Exit; + end; + end; + + Tmp := fpgGetFont(AFontDesc); + FFontCache.Insert(0, Tmp); + if FFontCache.Count > MAX_FONT_CACHE then + begin + TObject(FFontCache.Items[MAX_FONT_CACHE]).Free; + FFontCache.Delete(MAX_FONT_CACHE); + end; + FCanvas.Font := Tmp; end; function TCanvasFontManager.CharWidth( const C: TfpgChar ): longint; @@ -313,14 +339,6 @@ var t: TfpgString; begin t := s; - //case Settings.Encoding of - // encUTF8: t := IPFToUTF8(t); - // encCP437: t := CP437ToUTF8(t); - // encCP850: t := CP850ToUTF8(t); - // encIBMGraph: t := IBMGraphToUTF8(t); - //else - // t := IPFToUTF8(t); - //end; FCanvas.DrawString(Point.X, Point.Y, t); Point.x := Point.X + Canvas.Font.TextWidth(t); end; diff --git a/docview/components/richtext/RichTextDisplayUnit.pas b/docview/components/richtext/RichTextDisplayUnit.pas index 2e62a511..482a587b 100644 --- a/docview/components/richtext/RichTextDisplayUnit.pas +++ b/docview/components/richtext/RichTextDisplayUnit.pas @@ -231,10 +231,19 @@ ProfileEvent('DEBUG: DrawRichTextLine >>>'); BitmapRect.Bottom := Trunc(BitmapRect.Top + Bitmap.Height * Layout.VerticalImageScale); - FontManager.Canvas.StretchDraw(BitmapRect.Left, BitMapRect.Top, - BitmapRect.Right-BitMapRect.Left, BitMapRect.Bottom-BitMapRect.Top, Bitmap); - - inc( X, trunc( Bitmap.Width * Layout.HorizontalImageScale ) ); + if ((BitMapRect.Right - BitMapRect.Left) = Bitmap.Width) and + ((BitMapRect.Bottom - BitMapRect.Top) = Bitmap.Height) then + begin + // no stretching required + FontManager.Canvas.DrawImage(BitmapRect.Left, BitMapRect.Top, Bitmap); + inc(X, Bitmap.Width); + end + else + begin + FontManager.Canvas.StretchDraw(BitmapRect.Left, BitMapRect.Top, + BitmapRect.Right-BitMapRect.Left, BitMapRect.Bottom-BitMapRect.Top, Bitmap); + inc(X, trunc(Bitmap.Width * Layout.HorizontalImageScale)); + end; end; end else diff --git a/docview/components/richtext/RichTextView.pas b/docview/components/richtext/RichTextView.pas index fe38017f..e890ca54 100644 --- a/docview/components/richtext/RichTextView.pas +++ b/docview/components/richtext/RichTextView.pas @@ -1007,7 +1007,7 @@ begin if InDesigner then exit; - if WinHandle = 0 then + if IsLoading then exit; RemoveCursor; @@ -1066,8 +1066,10 @@ ProfileEvent('DEBUG: TRichTextView.Layout >>>>'); if InDesigner then exit; - if WinHandle = 0 then + + if IsLoading then exit; + ProfileEvent('DEBUG: TRichTextView.Layout 1 of 6'); FSelectionEnd := -1; FSelectionStart := -1; @@ -1177,7 +1179,7 @@ begin end; ebsDefault: begin - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); end; ebsSingle: begin diff --git a/docview/components/richtext/testedit/frarichtextedit.pas b/docview/components/richtext/testedit/frarichtextedit.pas new file mode 100644 index 00000000..903c96ae --- /dev/null +++ b/docview/components/richtext/testedit/frarichtextedit.pas @@ -0,0 +1,652 @@ +unit frarichtextedit; + +{$mode objfpc}{$H+} + +interface + +uses + fpg_base, + fpg_tab, + fpg_button, + fpg_panel, + fpg_main, + fpg_memo, + fpg_form, + fpg_dialogs, + fpg_stdimages, + RichTextView, + fpg_imagelist, + fpg_imgfmt_bmp, + fpg_imgfmt_png, + fpg_imgfmt_jpg, + Classes, SysUtils; + +Type + + { TRichTextEditFrame } + + TRichTextEditFrame = class(TfpgFrame) + private + FImageNames : TStringList; + FImageList : tfpgImageList; + procedure CheckTags; + procedure EncloseSelection(Const StartTag, EndTag: String); + function GetImageNames: TStrings; + function GetRichText: String; + procedure InsertColor(Const Background : Boolean); + procedure InsertFont; + procedure InsertImage; + procedure InsertLink; + procedure InsertMargin; + procedure DoPageChange(Sender: TObject; NewActiveSheet: TfpgTabSheet); + procedure OnToolButton(Sender: TObject); + procedure SetImageNames(AValue: TStrings); + procedure SetRichText(AValue: String); + protected + {@VFD_HEAD_BEGIN: MainForm} + PCedit: TfpgPageControl; + TSedit: TfpgTabSheet; + BBar: TfpgBevel; + BBold: TfpgButton; + BItalic: TfpgButton; + Bunderline: TfpgButton; + BHead: TfpgBevel; + BH1: TfpgButton; + BH2: TfpgButton; + BH3: TfpgButton; + BAligns: TfpgBevel; + BAleft: TfpgButton; + BACenter: TfpgButton; + BAJustified: TfpgButton; + BAright: TfpgButton; + BAUnaligned: TfpgButton; + BANowrap: TfpgButton; + BevMargin: TfpgBevel; + BMargin: TfpgButton; + BFont: TfpgButton; + BColor: TfpgButton; + BBGColor: TfpgButton; + BSpaceImage: TfpgBevel; + BImage: TfpgButton; + BLink: TfpgButton; + BCheck: TfpgButton; + MText: TfpgMemo; + TSPreview: TfpgTabSheet; + RTVPreview: TRichTextView; + {@VFD_HEAD_END: MainForm} + procedure AfterCreate; override; + Public + Property ImageNames : TStrings Read GetImageNames Write SetImageNames; + Property RichText : String Read GetRichText Write SetRichText; + end; + +Procedure RegisterRichTextImages(ADir : String); +Procedure RegisterStdRichTextImages; + +implementation + +procedure TRichTextEditFrame.DoPageChange(Sender: TObject; NewActiveSheet: TfpgTabSheet); + +Var + F : String; + +begin + If NewActiveSheet=TSPreview then + begin + RTVPreview.Clear; + F:=MText.Lines.Text; + RTVPreview.AddText(Pchar(F)); + end; +end; + +Const + TBBold = 1; + TBItalic = 2; + TBUnderLine = 3; + TBH1 = 4; + TBH2 = 5; + TBH3 = 6; + TBAlignLeft = 7; + TBAlignCenter = 8; + TBAlignRight = 9; + TBAlignNone = 10; + TBAlignJustify = 11; + TBMargin = 12; + TBFont = 13; + TBColor = 14; + TBBGColor = 15; + TBImage = 16; + TBLink = 17; + TBNowrap = 18; + TBCheck = 19; + + BSize = 30; + + // Image names + BIBold = 'richtextedit.bold'; + BIItalic = 'richtextedit.italic'; + BIunderline = 'richtextedit.underline'; + BIAlignLeft = 'richtextedit.left'; + BIAlignCenter = 'richtextedit.center'; + BIAlignRight = 'richtextedit.right'; +// BIAlignNone = 10; + BIAlignJustify = 'richtextedit.justify'; + BIMargin = 'richtextedit.margin'; + BIFont = 'richtextedit.font'; + BIColor = 'richtextedit.color'; + BIBGColor = 'richtextedit.backgroundcolor'; + BIImage = 'richtextedit.image'; + BILink = 'richtextedit.link'; + BINowrap = 'richtextedit.nowrap'; + BICheck = 'richtextedit.check'; + + BFNBold = 'bold'; + BFNItalic = 'italic'; + BFNunderline = 'underlined'; + BFNAlignLeft = 'left'; + BFNAlignCenter = 'center'; + BFNAlignRight = 'right'; +// BFNAlignNone = 10; + BFNAlignJustify = 'justify'; + BFNMargin = 'margin'; + BFNFont = 'font'; + BFNColor = 'color'; + BFNBGColor = 'color_background'; + BFNImage = 'image'; + BFNLink = 'hyperlink'; + BFNNoWrap = 'nowrap'; + BFNCheck = 'check'; + +procedure CheckSelection(Const S, TextName : String); + +Var + I,P,L,TS,TC : Integer; + T : TStrings; + TT,TN : String; + +begin + T:=TStringList.Create; + try + I:=0; + P:=0; + L:=Length(S); + While (P=0) and (I<L) do + begin + Inc(I); + If (S[i]='<') then + if (I=L) then + P:=I + else + begin + Inc(I); + if (S[i]<>'<') then + begin + TS:=I; + While (P=0) and (S[i]<>'>') do + if (I=L) then + P:=I + else + Inc(I); + if (P=0) then + begin + TN:=LowerCase(Copy(S,TS,I-TS)); + TC:=Pos(' ',TN); + if TC<>0 then + TN:=Copy(TN,1,TC-1); + if (TN<>'') then + begin + if (TN[1]<>'/') then + begin + if Pos('/'+TN+'/','/align/rightmargin/leftmargin/image/')=0 then + T.Add(TN) + end + else + begin + Delete(TN,1,1); + TC:=T.Count-1; + if (TC<0) then + P:=TS + else + if (T[TC]<>TN) then + P:=TS + else + T.Delete(TC); + end; + end; + end; + end; + end; + end; + if (P<>0) then + Raise Exception.CreateFmt('The %s contains a not-opened closing tag at position %d: %s',[TextName,P,TN]) + else if (T.Count>0) then + Raise Exception.CreateFmt('The %s contains a not-closed tag: %s',[TextName,T[T.Count-1]]) + finally + T.Free; + end; +end; + +procedure TRichTextEditFrame.EncloseSelection(Const StartTag, EndTag : String); + + +Var + S: String; + +begin + S:=MText.SelectionText; + if (EndTag<>'') then + CheckSelection(S,'selection'); + If (StartTag<>'') then + S:='<'+StartTag+'>'+S; + if (EndTag<>'') then + S:=S+'</'+EndTag+'>'; + MText.SelectionText:=S; +// MText.SelectionText:=S; +end; + +function TRichTextEditFrame.GetImageNames: TStrings; +begin + Result:=FImageNames; +end; + +function TRichTextEditFrame.GetRichText: String; +begin + Result:=MText.Lines.Text; +end; + +procedure TRichTextEditFrame.InsertMargin; + +Var + S: tfpgstring; + +begin + S:='5'; + if fpgInputQuery('Insert margin','Enter the margin to be used:',S) then + begin + if StrToIntDef(S,-1)=-1 then + ShowMessage('Not a numerical value. The margin must be a number','Error') + else + EncloseSelection('leftmargin '+s,''); + end; +end; + +procedure TRichTextEditFrame.InsertLink; + +Var + S: tfpgstring; + +begin + S:=''; + if fpgInputQuery('Insert link','Enter the link target text:',S) then + EncloseSelection('link "'+s+'"','link'); +end; + +procedure TRichTextEditFrame.CheckTags; + +begin + CheckSelection(MText.Lines.Text,'text'); + ShowMessage('All tags are correctly balanced.','Check ok'); +end; + + +procedure TRichTextEditFrame.InsertFont; + +Var + S : String; + +begin + if SelectFontDialog(S) then + EncloseSelection('font "'+S+'"','font') +end; + +procedure TRichTextEditFrame.InsertColor(Const Background : Boolean); + +Var + t : TRGBTriple; + s : string; +begin + With TfpgColorSelectDialog.Create(nil) do + try + SelectedColor:=clBlack; + if ShowModal = mrOK then + begin + t:=fpgColorToRGBTriple(SelectedColor); + S:='color'; + if Background then + S:='back'+s; + EncloseSelection(s+' #'+format('%.2x%.2x%.2x',[t.red,t.green,t.blue]),s); + end; + finally + Free; + end; +end; + +procedure TRichTextEditFrame.InsertImage; + +Var + FN,E : String; + I : integer; + +begin + FN:=SelectFileDialog(sfdOpen,'Supported image files|*.png;*.jpg;*.bmp',''); + if (FN<>'') then + begin + E:=LowerCase(ExtractFIleExt(FN)); + i:=FImageList.Count; + if e='.png' then + FImageList.AddImage(loadimage_png(FN),i) + else if e='.bmp' then + FImageList.AddImage(loadimage_bmp(FN),i) + else if e='.jpg' then + FImageList.AddImage(loadimage_jpg(FN),i); + EncloseSelection('image '+intToStr(i),''); + FImageNames.Add(IntTostr(i)+'='+FN); + end; +end; + +procedure TRichTextEditFrame.OnToolButton(Sender: TObject); + +Var + T : Ptruint; +begin + T:=(Sender as TComponent).Tag; + Case T of + TBBold : + EncloseSelection('b','b'); + TBItalic : + EncloseSelection('i','i'); + TBUnderLine: + EncloseSelection('u','u'); + TBH1: + EncloseSelection('h1','h1'); + TBH2: + EncloseSelection('h2','h2'); + TBH3: + EncloseSelection('h3','h3'); + TBAlignLeft: + EncloseSelection('align left',''); + TBAlignCenter: + EncloseSelection('align center',''); + TBAlignRight: + EncloseSelection('align right',''); + TBAlignNone: + EncloseSelection('unalign',''); + TBNoWrap: + EncloseSelection('nowrap','nowrap'); + TBAlignJustify: + ; // Not functional yet + TBMargin: + InsertMargin; + TBFont: + InsertFont; + TBColor, + TBBGColor: + InsertColor(TBBGColor=T); + tbLink: + InsertLink; + TBCheck: + CheckTags; + TBImage: + InsertImage; + end; +end; + +procedure TRichTextEditFrame.SetImageNames(AValue: TStrings); +begin + if FImageNames=AValue then Exit; + FImageNames.Assign(AValue); +end; + +procedure TRichTextEditFrame.SetRichText(AValue: String); +begin + MText.Lines.Text:=AValue; +end; + +procedure TRichTextEditFrame.AfterCreate; + + Function TBSpace(Var ALeft : Integer; AName : String) : TfpgBevel; + + begin + Result := TfpgBevel.Create(BBar); + with Result do + begin + Name := AName; + SetPosition(ALeft, 2, 10, 24); + ALeft:=ALeft+10; + Align := alLeft; + Hint := ''; + Shape := bsSpacer; + end; + + end; + + Function TBButton(Var ALeft,ATab : Integer; ATag : Integer; Const AName,AImage,AText : String) : tfpgButton; + + begin + Result := TfpgButton.Create(BBar); + with Result do + begin + Name := AName; + SetPosition(ALeft, 2, BSize, BSize); + ALeft:=ALeft+BSize; + Align := alLeft; + Text := AText; + ImageName:=AImage; + Tag:=ATag; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := -1; + Embedded:=True; + Flat:=True; + TabOrder := ATab; + ATab:=ATab+1; + OnClick:=@OnToolButton; + end; + end; + +var + I, J, L, T: integer; + img: tfpgimage; + S: string; + + +begin + {%region 'Auto-generated GUI code' } + + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(496, 295, 739, 502); + WindowTitle := 'MainForm'; + Hint := ''; + + PCedit := TfpgPageControl.Create(self); + with PCedit do + begin + Name := 'PCedit'; + SetPosition(0, 0, 739, 502); + Align := alClient; + Hint := ''; + TabOrder := 1; + OnChange:=@DoPageChange; + end; + + TSedit := TfpgTabSheet.Create(PCedit); + with TSedit do + begin + Name := 'TSedit'; + SetPosition(3, 24, 733, 475); + Anchors := [anLeft,anRight,anTop,anBottom]; + Text := 'Edit text'; + end; + + BBar := TfpgBevel.Create(TSedit); + with BBar do + begin + Name := 'BBar'; + SetPosition(0, 0, 733, BSize+4); + Align := alTop; + Hint := ''; + Shape := bsBottomLine; + Shape := bsBottomLine; + end; + + + MText := TfpgMemo.Create(TSedit); + with MText do + begin + Name := 'MText'; + SetPosition(0, 28, 733, 447); + Align := alClient; + FontDesc := '#Edit1'; + Hint := ''; + TabOrder := 2; + end; + + TSPreview := TfpgTabSheet.Create(PCedit); + with TSPreview do + begin + Name := 'TSPreview'; + SetPosition(3, 24, 733, 475); + Anchors := [anLeft,anRight,anTop,anBottom]; + Text := 'Preview'; + end; + + RTVPreview := TRichTextView.Create(TSPreview); + with RTVPreview do + begin + Name := 'RTVPreview'; + SetPosition(0, 0, 735, 478); + Anchors := [anLeft,anRight,anTop,anBottom]; + end; + + {@VFD_BODY_END: MainForm} + {%endregion} + // Create toolbar + L:=2; + T:=0; + BBold:=TBButton(L,T,TBBold,'BBold',BIBold,''); + BItalic:=TBButton(L,T,TBItalic,'BItalic',BIItalic,''); + Bunderline:=TBButton(L,T,TBunderline,'BUnderline',BIUnderline,''); + + BHead := TBSpace(L,'BHead'); + + BH1 := TBButton(L,T,TBH1,'BH1','','1'); + BH2 := TBButton(L,T,TBH2,'BH2','','2'); + BH3 := TBButton(L,T,TBH3,'BH3','','3'); + + BAligns := TBSpace(L,'BAligns'); + + BAleft := TBButton(L,T,TBAlignLeft,'BALeft',BIAlignLeft,''); + BACenter := TBButton(L,T,TBAlignCenter,'BACenter',BIAlignCenter,''); + BAJustified := TBButton(L,T,TBAlignJustify,'BAJustified',BIAlignJustify,''); + BARight := TBButton(L,T,TBAlignRight,'BARight',BIAlignRight,''); + BAUnaligned := TBButton(L,T,TBAlignNone,'BAUnalign',BIAlignLeft,''); + + BANowrap := TBButton(L,T,TBNowrap,'BNowrap',BINoWrap,''); + + BevMargin := TBSpace(L,'BevMargin'); + BMargin := TBButton(L,T,TBMargin,'BMargin',BIMargin,''); + + BFont := TBButton(L,T,TBFont,'BFont',BIFont,''); + BColor := TBButton(L,T,TBColor,'BColor',BIColor,''); + BBGColor := TBButton(L,T,TBBGColor,'BBGColor',BIBGColor,''); + + BSpaceImage := TBSpace(L,'BSpaceImage'); + + BImage := TBButton(L,T,TBImage,'BImage',BIImage,''); + BLink := TBButton(L,T,TBLink,'BLink',BILink,''); + BCheck := TBButton(L,T,TBCheck,'BCheck',BICheck,''); + + FImageList:=TfpgImageList.Create; + FImageNames:=TStringList.Create; + RTVPreview.Images:=FImageList; + RTVPreview.RichTextSettings.Heading1Font := fpgGetFont('Arial-18:bold'); + RTVPreview.RichTextSettings.Heading2Font := fpgGetFont('Arial-14:bold'); + RTVPreview.RichTextSettings.Heading3Font := fpgGetFont('Arial-12:bold'); + RTVPreview.RichTextSettings.NormalFont := fpgGetFont(FPG_DEFAULT_FONT_DESC); + RTVPreview.RichTextSettings.FixedFont := fpgGetFont('Courier New-10:antialiased=true'); + +end; + +Procedure RegisterStdRichTextImages; + + Procedure LoadImage(const iname : string; ImageLoc : Pointer; ImageSize : Integer); + + begin + if (fpgImages.GetImage(iname)<>Nil) then + fpgImages.DeleteImage(iname,true); + fpgImages.AddMaskedBMP(iname,ImageLoc,ImageSize,0,0) + end; + + +{$i img_richedit.inc} + +begin + LoadImage(BIBold,@img_richedit_Bold,sizeof(img_richedit_Bold)); + LoadImage(BIItalic,@img_richedit_italic,sizeof(img_richedit_italic)); + LoadImage(BIunderline,@img_richedit_underlined,sizeof(img_richedit_underlined)); + LoadImage(BIAlignLeft,@img_richedit_left,sizeof(img_richedit_left)); + LoadImage(BIAlignCenter,@img_richedit_center,sizeof(img_richedit_center)); + LoadImage(BIAlignRight,@img_richedit_right,sizeof(img_richedit_right)); +// LoadImage(BIAlignCenter,@img_richedit_center,sizeof(img_richedit_center)); + LoadImage(BIAlignJustify,@img_richedit_justify,sizeof(img_richedit_justify)); + LoadImage(BIMargin,@img_richedit_margin,sizeof(img_richedit_margin)); + LoadImage(BIFont,@img_richedit_font,sizeof(img_richedit_font)); + LoadImage(BIColor,@img_richedit_color,sizeof(img_richedit_color)); + LoadImage(BIBGColor,@img_richedit_color_background,sizeof(img_richedit_color_background)); + LoadImage(BIImage,@img_richedit_image,sizeof(img_richedit_image)); + LoadImage(BINowrap,@img_richedit_nowrap,sizeof(img_richedit_nowrap)); + LoadImage(BILink,@img_richedit_hyperlink,sizeof(img_richedit_hyperlink)); + LoadImage(BICheck,@img_richedit_check,sizeof(img_richedit_check)); +end; + +Procedure RegisterRichTextImages(ADir : String); + + Procedure LoadImage(const iname,ifile : string); + + Var + fn : string; + img : TfpgImage; + + begin + fn:=ADir+ifile+'.bmp'; + if FileExists(fn) then + begin + if (fpgImages.GetImage(iname)<>Nil) then + fpgImages.DeleteImage(iname,true); + img:=LoadImage_BMP(fn); + img.CreateMaskFromSample(0,0); + img.UpdateImage; + fpgImages.AddImage(iname,img); + end + else + ShowMessage(iname+' : file does not exist : '+ifile); + end; + +begin + ADir:=IncludeTrailingPathDelimiter(ADir); + LoadImage(BIBold,BFNBold); + LoadImage(BIItalic,BFNItalic); + LoadImage(BIunderline,BFNUnderLine); +// BH1.ImageName:=BIH1; +// BH2.ImageName:=BIH2; +// BH3.ImageName:=BIH3; + LoadImage(BIAlignLeft,BFNAlignLeft); + LoadImage(BIAlignCenter,BFNAlignCenter); + LoadImage(BIAlignRight,BFNAlignRight); + LoadImage(BIAlignCenter,BFNAlignCenter); + LoadImage(BIAlignJustify,BFNAlignJustify); + // BIAlignJustify = 11; + LoadImage(BIMargin,BFNMargin); + LoadImage(BIFont,BFNFont); + LoadImage(BIColor,BFNColor); + LoadImage(BIBGColor,BFNBGColor); + LoadImage(BIImage,BFNImage); + LoadImage(BINowrap,BFNNowrap); + LoadImage(BILink,BFNLink); + LoadImage(BICheck,BFNCheck); + +end; + +end. + diff --git a/docview/components/richtext/testedit/images/bold.bmp b/docview/components/richtext/testedit/images/bold.bmp Binary files differnew file mode 100644 index 00000000..edb1ada1 --- /dev/null +++ b/docview/components/richtext/testedit/images/bold.bmp diff --git a/docview/components/richtext/testedit/images/bold.jpg b/docview/components/richtext/testedit/images/bold.jpg Binary files differnew file mode 100644 index 00000000..38adff11 --- /dev/null +++ b/docview/components/richtext/testedit/images/bold.jpg diff --git a/docview/components/richtext/testedit/images/bold.png b/docview/components/richtext/testedit/images/bold.png Binary files differnew file mode 100644 index 00000000..d12c5710 --- /dev/null +++ b/docview/components/richtext/testedit/images/bold.png diff --git a/docview/components/richtext/testedit/images/center.bmp b/docview/components/richtext/testedit/images/center.bmp Binary files differnew file mode 100644 index 00000000..b707a3f5 --- /dev/null +++ b/docview/components/richtext/testedit/images/center.bmp diff --git a/docview/components/richtext/testedit/images/center.jpg b/docview/components/richtext/testedit/images/center.jpg Binary files differnew file mode 100644 index 00000000..59389ae1 --- /dev/null +++ b/docview/components/richtext/testedit/images/center.jpg diff --git a/docview/components/richtext/testedit/images/center.png b/docview/components/richtext/testedit/images/center.png Binary files differnew file mode 100644 index 00000000..ce2b28d1 --- /dev/null +++ b/docview/components/richtext/testedit/images/center.png diff --git a/docview/components/richtext/testedit/images/check.bmp b/docview/components/richtext/testedit/images/check.bmp Binary files differnew file mode 100644 index 00000000..b8c31165 --- /dev/null +++ b/docview/components/richtext/testedit/images/check.bmp diff --git a/docview/components/richtext/testedit/images/check.png b/docview/components/richtext/testedit/images/check.png Binary files differnew file mode 100644 index 00000000..a7787a99 --- /dev/null +++ b/docview/components/richtext/testedit/images/check.png diff --git a/docview/components/richtext/testedit/images/color.bmp b/docview/components/richtext/testedit/images/color.bmp Binary files differnew file mode 100644 index 00000000..49e10a23 --- /dev/null +++ b/docview/components/richtext/testedit/images/color.bmp diff --git a/docview/components/richtext/testedit/images/color.jpg b/docview/components/richtext/testedit/images/color.jpg Binary files differnew file mode 100644 index 00000000..4b91026a --- /dev/null +++ b/docview/components/richtext/testedit/images/color.jpg diff --git a/docview/components/richtext/testedit/images/color.png b/docview/components/richtext/testedit/images/color.png Binary files differnew file mode 100644 index 00000000..95ceccfd --- /dev/null +++ b/docview/components/richtext/testedit/images/color.png diff --git a/docview/components/richtext/testedit/images/color_background.bmp b/docview/components/richtext/testedit/images/color_background.bmp Binary files differnew file mode 100644 index 00000000..dba0b6b0 --- /dev/null +++ b/docview/components/richtext/testedit/images/color_background.bmp diff --git a/docview/components/richtext/testedit/images/color_background.jpg b/docview/components/richtext/testedit/images/color_background.jpg Binary files differnew file mode 100644 index 00000000..72512e4a --- /dev/null +++ b/docview/components/richtext/testedit/images/color_background.jpg diff --git a/docview/components/richtext/testedit/images/color_background.png b/docview/components/richtext/testedit/images/color_background.png Binary files differnew file mode 100644 index 00000000..bba39fc2 --- /dev/null +++ b/docview/components/richtext/testedit/images/color_background.png diff --git a/docview/components/richtext/testedit/images/font.bmp b/docview/components/richtext/testedit/images/font.bmp Binary files differnew file mode 100644 index 00000000..37146e6d --- /dev/null +++ b/docview/components/richtext/testedit/images/font.bmp diff --git a/docview/components/richtext/testedit/images/font.jpg b/docview/components/richtext/testedit/images/font.jpg Binary files differnew file mode 100644 index 00000000..0c9eb4f3 --- /dev/null +++ b/docview/components/richtext/testedit/images/font.jpg diff --git a/docview/components/richtext/testedit/images/font.png b/docview/components/richtext/testedit/images/font.png Binary files differnew file mode 100644 index 00000000..d250478d --- /dev/null +++ b/docview/components/richtext/testedit/images/font.png diff --git a/docview/components/richtext/testedit/images/hyperlink.bmp b/docview/components/richtext/testedit/images/hyperlink.bmp Binary files differnew file mode 100644 index 00000000..82443df2 --- /dev/null +++ b/docview/components/richtext/testedit/images/hyperlink.bmp diff --git a/docview/components/richtext/testedit/images/hyperlink.jpg b/docview/components/richtext/testedit/images/hyperlink.jpg Binary files differnew file mode 100644 index 00000000..c2dd4fa8 --- /dev/null +++ b/docview/components/richtext/testedit/images/hyperlink.jpg diff --git a/docview/components/richtext/testedit/images/hyperlink.png b/docview/components/richtext/testedit/images/hyperlink.png Binary files differnew file mode 100644 index 00000000..c102771d --- /dev/null +++ b/docview/components/richtext/testedit/images/hyperlink.png diff --git a/docview/components/richtext/testedit/images/image.bmp b/docview/components/richtext/testedit/images/image.bmp Binary files differnew file mode 100644 index 00000000..007004a9 --- /dev/null +++ b/docview/components/richtext/testedit/images/image.bmp diff --git a/docview/components/richtext/testedit/images/image.jpg b/docview/components/richtext/testedit/images/image.jpg Binary files differnew file mode 100644 index 00000000..92a98073 --- /dev/null +++ b/docview/components/richtext/testedit/images/image.jpg diff --git a/docview/components/richtext/testedit/images/image.png b/docview/components/richtext/testedit/images/image.png Binary files differnew file mode 100644 index 00000000..9bcb9274 --- /dev/null +++ b/docview/components/richtext/testedit/images/image.png diff --git a/docview/components/richtext/testedit/images/italic.bmp b/docview/components/richtext/testedit/images/italic.bmp Binary files differnew file mode 100644 index 00000000..70760626 --- /dev/null +++ b/docview/components/richtext/testedit/images/italic.bmp diff --git a/docview/components/richtext/testedit/images/italic.jpg b/docview/components/richtext/testedit/images/italic.jpg Binary files differnew file mode 100644 index 00000000..d04a8a68 --- /dev/null +++ b/docview/components/richtext/testedit/images/italic.jpg diff --git a/docview/components/richtext/testedit/images/italic.png b/docview/components/richtext/testedit/images/italic.png Binary files differnew file mode 100644 index 00000000..f4ecd0dd --- /dev/null +++ b/docview/components/richtext/testedit/images/italic.png diff --git a/docview/components/richtext/testedit/images/justify.bmp b/docview/components/richtext/testedit/images/justify.bmp Binary files differnew file mode 100644 index 00000000..98d3f8b9 --- /dev/null +++ b/docview/components/richtext/testedit/images/justify.bmp diff --git a/docview/components/richtext/testedit/images/justify.jpg b/docview/components/richtext/testedit/images/justify.jpg Binary files differnew file mode 100644 index 00000000..6c21551a --- /dev/null +++ b/docview/components/richtext/testedit/images/justify.jpg diff --git a/docview/components/richtext/testedit/images/justify.png b/docview/components/richtext/testedit/images/justify.png Binary files differnew file mode 100644 index 00000000..0cf96ed6 --- /dev/null +++ b/docview/components/richtext/testedit/images/justify.png diff --git a/docview/components/richtext/testedit/images/left.bmp b/docview/components/richtext/testedit/images/left.bmp Binary files differnew file mode 100644 index 00000000..b8521e2e --- /dev/null +++ b/docview/components/richtext/testedit/images/left.bmp diff --git a/docview/components/richtext/testedit/images/left.jpg b/docview/components/richtext/testedit/images/left.jpg Binary files differnew file mode 100644 index 00000000..11790950 --- /dev/null +++ b/docview/components/richtext/testedit/images/left.jpg diff --git a/docview/components/richtext/testedit/images/left.png b/docview/components/richtext/testedit/images/left.png Binary files differnew file mode 100644 index 00000000..8a86f1f8 --- /dev/null +++ b/docview/components/richtext/testedit/images/left.png diff --git a/docview/components/richtext/testedit/images/margin.bmp b/docview/components/richtext/testedit/images/margin.bmp Binary files differnew file mode 100644 index 00000000..efe55071 --- /dev/null +++ b/docview/components/richtext/testedit/images/margin.bmp diff --git a/docview/components/richtext/testedit/images/margin.jpg b/docview/components/richtext/testedit/images/margin.jpg Binary files differnew file mode 100644 index 00000000..21d87624 --- /dev/null +++ b/docview/components/richtext/testedit/images/margin.jpg diff --git a/docview/components/richtext/testedit/images/margin.png b/docview/components/richtext/testedit/images/margin.png Binary files differnew file mode 100644 index 00000000..cbca4d62 --- /dev/null +++ b/docview/components/richtext/testedit/images/margin.png diff --git a/docview/components/richtext/testedit/images/nowrap.bmp b/docview/components/richtext/testedit/images/nowrap.bmp Binary files differnew file mode 100644 index 00000000..af3ed35f --- /dev/null +++ b/docview/components/richtext/testedit/images/nowrap.bmp diff --git a/docview/components/richtext/testedit/images/nowrap.jpg b/docview/components/richtext/testedit/images/nowrap.jpg Binary files differnew file mode 100644 index 00000000..76f803fb --- /dev/null +++ b/docview/components/richtext/testedit/images/nowrap.jpg diff --git a/docview/components/richtext/testedit/images/nowrap.png b/docview/components/richtext/testedit/images/nowrap.png Binary files differnew file mode 100644 index 00000000..b3ba2fd5 --- /dev/null +++ b/docview/components/richtext/testedit/images/nowrap.png diff --git a/docview/components/richtext/testedit/images/right.bmp b/docview/components/richtext/testedit/images/right.bmp Binary files differnew file mode 100644 index 00000000..a2ae1f6c --- /dev/null +++ b/docview/components/richtext/testedit/images/right.bmp diff --git a/docview/components/richtext/testedit/images/right.jpg b/docview/components/richtext/testedit/images/right.jpg Binary files differnew file mode 100644 index 00000000..e4b7508c --- /dev/null +++ b/docview/components/richtext/testedit/images/right.jpg diff --git a/docview/components/richtext/testedit/images/right.png b/docview/components/richtext/testedit/images/right.png Binary files differnew file mode 100644 index 00000000..be5cfd28 --- /dev/null +++ b/docview/components/richtext/testedit/images/right.png diff --git a/docview/components/richtext/testedit/images/underlined.bmp b/docview/components/richtext/testedit/images/underlined.bmp Binary files differnew file mode 100644 index 00000000..182ff5ac --- /dev/null +++ b/docview/components/richtext/testedit/images/underlined.bmp diff --git a/docview/components/richtext/testedit/images/underlined.jpg b/docview/components/richtext/testedit/images/underlined.jpg Binary files differnew file mode 100644 index 00000000..cafa162b --- /dev/null +++ b/docview/components/richtext/testedit/images/underlined.jpg diff --git a/docview/components/richtext/testedit/images/underlined.png b/docview/components/richtext/testedit/images/underlined.png Binary files differnew file mode 100644 index 00000000..db07038f --- /dev/null +++ b/docview/components/richtext/testedit/images/underlined.png diff --git a/docview/components/richtext/testedit/img_richedit.inc b/docview/components/richtext/testedit/img_richedit.inc new file mode 100644 index 00000000..8e5cb5d8 --- /dev/null +++ b/docview/components/richtext/testedit/img_richedit.inc @@ -0,0 +1,1616 @@ + +const + img_richedit_bold: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,253,253,253,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241, 44, 44, 44, 0, 0, 0, 0, 0, + 0, 0, 0, 0,191,191,191,246,246,246,247,247,247,248,248,248,249, + 249,249,170,170,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 46, 46, 46, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,133,133,133, 0, + 0, 0, 0, 0, 0, 0, 0, 0,113,113,113,244,244,244,245,245,245, + 246,246,246,247,247,247, 89, 89, 89, 0, 0, 0, 0, 0, 0, 0, 0, + 0,140,140,140,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 217,217,217, 3, 3, 3, 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, 3, 3, 3,228,228,228,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237, 70, 70, 70, 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, 74, 74, 74,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,158,158,158, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 76, 76, 76,242,242,242,242,242,242, 57, 57, + 57, 0, 0, 0, 0, 0, 0, 0, 0, 0,166,166,166,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,229,229, + 229, 15, 15, 15, 0, 0, 0, 0, 0, 0, 15, 15, 15,237,237,237,228, + 228,228, 3, 3, 3, 0, 0, 0, 0, 0, 0, 17, 17, 17,240,240,240, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235, 97, 97, 97, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 187,187,187,166,166,166, 0, 0, 0, 0, 0, 0, 0, 0, 0,101,101, + 101,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233,234,234,234,184,184,184, 0, 0, 0, 0, 0, + 0, 0, 0, 0,122,122,122,100,100,100, 0, 0, 0, 0, 0, 0, 0, + 0, 0,191,191,191,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234, 35, + 35, 35, 0, 0, 0, 0, 0, 0, 57, 57, 57, 35, 35, 35, 0, 0, 0, + 0, 0, 0, 37, 37, 37,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,122,122,122, 0, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, + 0, 0, 0, 0, 0, 0, 0,127,127,127,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,206,206,206, 1, 1, 1, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1,213,213,213,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231, 61, 61, 61, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64, 64, 64,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,147,147,147, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,151, + 151,151,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,231,231,231,232,232,232,233,233,233, + 234,234,234,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{/home/michael/reader/center.bmp} +const + img_richedit_center: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,144,144,144,145,145,145,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,149,149, + 149,150,150,150,150,150,150,150,150,150,151,151,151,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,239,239,239,240, + 240,240,241,241,241,242,242,242,144,144,144,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,238,238,238,142,142,142,143,143,143,143, + 143,143,144,144,144,144,144,144,145,145,145,145,145,145,146,146,146, + 146,146,146,147,147,147,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,236,236, + 236,237,237,237,238,238,238,239,239,239,143,143,143,143,143,143,143, + 143,143,144,144,144,243,243,243,244,244,244,245,245,245,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,138,138,138,139,139,139,140,140,140,140,140,140,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,144, + 144,144,144,144,144,145,145,145,146,146,146,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 138,138,138,138,138,138,139,139,139,140,140,140,140,140,140,141,141, + 141,141,141,141,142,142,142,143,143,143,143,143,143,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,235, + 235,235,236,236,236,237,237,237,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231,138,138,138, + 138,138,138,139,139,139,140,140,140,140,140,140,141,141,141,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,134,134,134,135,135,135,135, + 135,135,136,136,136,137,137,137,137,137,137,138,138,138,138,138,138, + 139,139,139,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/check.bmp } +const + img_richedit_check: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, + 0, 0, 0, 0, 0, 0, 0,191, 0,191,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,248, 0,248, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0,104,136,107, 70, 92, 72, 0, 0, 0, 0, 0, + 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255, 0, 0, 0, 0, 0, 0,136,186,137,104,136,107, 0, + 0, 0, 0, 0, 0, 0, 0, 0,243, 0,243,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,157,195,157,123,177,125, + 104,163,107, 70, 92, 72, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255, 0, 0, 0, 0, 0, 0,186,214, + 187,129,184,130,116,175,117,104,136,107, 0, 0, 0, 0, 0, 0, 0, + 0, 0,243, 0,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,157, + 197,159,146,190,147,181,209,181,104,175,103, 97,162, 99, 85,112, 88, + 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0, + 0, 0, 0,184,214,184, 89,145, 91, 0, 0, 0,212,228,212,103,175, + 103, 91,144, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0,243, 0,243,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255, 0, 0, 0,166,203,168,108,157,109, 0, 0, 0, 0, 0, 0, 0, + 0, 0,208,228,208,111,175,111, 85,112, 88, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255, 0, 0, 0, 19, 44, 19,118,166,119, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 45, 45, 45,203,223,203,110,174,111, 0, 0, + 0, 0, 0, 0, 0, 0, 0,243, 0,243,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255, 0, 0, 0,136,186,138, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,180, + 213,180,112,167,112, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255, 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,172,208,171, 26, 59, 26, 0, 0, 0, 0, 0, + 0,114, 0,114,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255, 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, 0, 0, 0, 0, 0, 0,221, 0,221, 0, 0, 0,140,187,139, 0, + 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255, + 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, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, + 0, 0, 0, 0, 0, 0, 0, 0, 0,235, 0,235,255, 0,255, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, + 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, + 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 255, 0,255,255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ /home/michael/reader/color.bmp} +const + img_richedit_color: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,140,117, 95,108, 78, 49,108, 78, 49,219,214,208, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,250,250, + 250,126,100, 75,108, 78, 49,111, 82, 54,242,240,237,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,193,182,171,108, 78, 49,108, 78, + 49,172,156,140,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,216,209,202,108, 78, 49,108, 78, 49,157,138,119,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,234,233,232,116, + 88, 60,108, 78, 49,125, 99, 73,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,163,145,128,108, 78, 49,108, 78, 49,213,206, + 198,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,163,146,129,108, 78, 49,108, 78, 49,113, 85, 57,113, 85, + 57,113, 85, 57,113, 85, 57,113, 85, 57,109, 79, 50,108, 78, 49,128, + 102, 77,248,248,248,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,214,209,203,108, 78, 49,108, 78, 49,108, + 78, 49,108, 78, 49,108, 78, 49,108, 78, 49,108, 78, 49,108, 78, 49, + 108, 78, 49,182,168,155,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,135,111, 88, + 108, 78, 49,114, 86, 58,226,223,219,229,226,223,229,226,223,141,118, + 96,108, 78, 49,110, 81, 52,234,231,229,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,236,236, + 236,185,174,162,108, 78, 49,108, 78, 49,204,196,188,240,240,240,233, + 231,229,111, 81, 53,108, 78, 49,152,132,113,245,245,245,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,229,228,227,114, 85, 57,108, 78, 49,160,142,124, + 239,239,239,192,181,171,108, 78, 49,108, 78, 49,206,198,190,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233,234,234,234,235,235,235,158,139,122,108, 78, + 49,119, 91, 65,236,236,236,149,128,108,108, 78, 49,125, 99, 73,241, + 241,241,243,243,243,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,207, + 200,194,108, 78, 49,108, 78, 49,199,190,181,112, 83, 55,108, 78, 49, + 176,162,148,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,233,233,233,130,106, 82,108, 78, 49,125, 99, 73,108, 78, + 49,110, 80, 51,226,223,221,240,240,240,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,179,166,154,108, 78, 49,108, + 78, 49,108, 78, 49,148,127,107,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231,223,221,219, + 111, 82, 54,108, 78, 49,108, 78, 49,199,190,182,237,237,237,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,152,133,115,108, 78, 49,122, 96, 70,234,233,233,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,201,193,186,108, 78, 49,171,156,142, + 234,234,234,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,202,195, + 188,225,223,221,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/color_background.bmp } +const + img_richedit_color_background: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,181,153,125,206,177,149,213,185,156,211,183,154, + 212,184,155,213,184,155,213,185,156,213,185,156,214,186,157,215,186, + 158,215,187,158,216,188,159,217,188,159,217,188,160,217,189,161,217, + 189,161,217,189,161,217,189,161,207,178,150,172,144,118,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,209,181,152,209,181,152,210,181, + 153,210,182,154,211,183,154,212,184,155,212,184,155,213,184,155,213, + 185,156,214,186,157,215,186,158,215,187,158,216,188,159,217,188,159, + 217,188,160,217,189,161,217,189,161,217,189,161,217,189,161,205,176, + 148,255, 0,255,255, 0,255,255, 0,255,255, 0,255,213,185,156,208, + 180,152,209,181,152, 50, 43, 36, 0, 0, 0, 0, 0, 0,172,149,125, + 212,184,155,213,184,155,213,185,156,214,186,157,215,186,158,214,186, + 157, 27, 24, 20, 0, 0, 0, 5, 5, 4,199,173,147,217,189,161,217, + 189,161,217,189,161,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 213,185,156,208,180,151,208,180,152,132,114, 96, 0, 0, 0, 0, 0, + 0, 98, 85, 72,211,183,154,212,184,155,213,184,155,213,185,156,214, + 186,157,164,142,120, 0, 0, 0, 0, 0, 0, 74, 64, 54,217,188,159, + 217,188,160,217,189,161,217,189,161,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,213,184,155,207,178,150,208,179,151,200,172,145, 13, + 11, 9, 0, 0, 0, 27, 23, 19,210,181,153,210,182,154,211,183,154, + 212,184,155,213,184,155, 85, 73, 62, 0, 0, 0, 0, 0, 0,160,138, + 117,215,187,158,216,188,159,217,188,159,217,188,160,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,213,184,155,206,177,149,206,177,149, + 207,178,150, 88, 75, 63, 0, 0, 0, 0, 0, 0, 9, 7, 6, 9, 7, + 6, 9, 7, 6, 9, 7, 6, 9, 7, 6, 1, 1, 1, 0, 0, 0, 30, + 26, 22,213,185,156,215,186,158,215,187,158,216,188,159,217,188,159, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,212,184,155,204,176, + 148,205,176,148,206,177,149,169,145,122, 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,114, 98, 83,213,185,156,214,186,157,215,186,158,215,187, + 158,216,188,159,255, 0,255,255, 0,255,255, 0,255,255, 0,255,211, + 183,154,204,175,147,204,176,148,205,176,148,206,177,149, 43, 36, 31, + 0, 0, 0, 10, 9, 7,185,160,135,189,163,137,189,163,137, 51, 44, + 37, 0, 0, 0, 4, 3, 3,193,168,141,213,184,155,213,185,156,214, + 186,157,215,186,158,215,186,158,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,211,183,154,204,175,146,204,175,147,204,176,148,205,176, + 148,124,106, 89, 0, 0, 0, 0, 0, 0,151,131,110,208,180,151,195, + 169,143, 4, 4, 3, 0, 0, 0, 69, 59, 50,211,183,154,212,184,155, + 213,184,155,213,185,156,213,185,156,214,186,157,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,211,183,154,203,174,145,204,175,146,204, + 175,147,204,176,148,195,167,141, 9, 8, 7, 0, 0, 0, 82, 71, 60, + 208,179,151,132,115, 96, 0, 0, 0, 0, 0, 0,153,132,111,210,182, + 154,211,183,154,212,184,155,213,184,155,213,184,155,213,185,156,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,210,182,154,203,174,145, + 203,174,145,204,175,146,204,175,147,204,176,148, 80, 69, 58, 0, 0, + 0, 17, 15, 12,205,176,148, 65, 56, 47, 0, 0, 0, 26, 23, 19,208, + 180,151,210,181,153,210,182,154,211,183,154,211,183,154,212,184,155, + 213,184,155,255, 0,255,255, 0,255,255, 0,255,255, 0,255,210,182, + 154,202,173,145,203,174,145,203,174,145,204,175,146,204,175,147,160, + 137,115, 0, 0, 0, 0, 0, 0,145,124,105, 7, 6, 5, 0, 0, 0, + 108, 93, 78,208,180,152,209,181,152,210,181,153,210,181,153,210,182, + 154,211,183,154,212,184,155,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,210,181,153,201,172,144,202,173,145,203,174,145,203,174,145, + 204,175,146,204,175,146, 36, 31, 26, 0, 0, 0, 27, 23, 19, 0, 0, + 0, 3, 2, 2,188,162,136,208,180,151,208,180,152,208,180,152,209, + 181,152,210,181,153,210,182,154,211,183,154,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,210,181,153,200,172,143,201,172,144,202,173, + 145,203,174,145,203,174,145,203,174,145,116,100, 83, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 64, 55, 46,207,178,150,208,179,151,208,179,151, + 208,180,151,208,180,152,209,181,152,210,181,153,210,182,154,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,210,181,153,199,171,142,200, + 172,143,201,172,144,201,172,144,202,173,145,203,174,145,189,162,135, + 6, 5, 4, 0, 0, 0, 0, 0, 0,146,125,105,206,177,149,206,177, + 149,207,178,150,208,179,151,208,180,151,208,180,152,209,181,152,210, + 181,153,255, 0,255,255, 0,255,255, 0,255,255, 0,255,209,181,152, + 199,170,142,199,171,142,199,171,142,200,172,143,201,172,144,202,173, + 145,203,174,145, 73, 62, 52, 0, 0, 0, 24, 20, 17,202,174,146,205, + 176,148,205,176,148,206,177,149,207,178,150,208,179,151,208,180,151, + 208,180,152,209,181,152,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,209,181,152,199,169,141,199,169,141,199,170,142,199,171,142,200, + 172,143,201,172,144,202,173,145,153,131,109, 0, 0, 0,103, 88, 73, + 204,175,147,204,175,147,204,176,148,205,176,148,206,177,149,207,178, + 150,208,179,151,208,180,151,208,180,152,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,208,180,151,198,168,141,198,168,141,199,169,141, + 199,170,142,199,171,142,200,172,143,201,172,144,202,173,145,156,133, + 111,191,164,137,203,174,145,204,175,146,204,175,147,204,176,148,205, + 176,148,206,177,149,207,178,150,208,179,151,206,177,149,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,199,170,142,209,181,152,209,181, + 152,209,181,152,209,181,152,210,181,153,210,181,153,210,181,153,210, + 182,154,210,182,154,210,182,154,211,183,154,211,183,154,211,183,154, + 212,184,155,212,184,155,213,184,155,213,184,155,210,182,154,193,165, + 137,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/font.bmp } +const + img_richedit_font: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 50, 84, 94, 22, 37, 41, 18, 30, 33, + 0, 0, 0, 25, 41, 47, 35, 58, 65, 31, 51, 57,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 41, 69, 76, 1, 1, + 1, 1, 1, 1, 43, 71, 81, 19, 33, 36, 14, 23, 26, 27, 45, 50,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 39, + 66, 74, 1, 1, 1, 12, 20, 22,255, 0,255, 58, 99,110, 4, 7, 8, + 25, 41, 47,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 39, 66, 74, 1, 1, 1, 22, 37, 41,255, 0,255, 47, 79, + 88, 1, 1, 1, 22, 37, 41,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255, 39, 66, 74, 1, 1, 1, 22, 37, 41,255, + 0,255, 47, 79, 88, 1, 1, 1, 22, 37, 41,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255, 42, 71, 79, 1, 1, 1, + 35, 58, 65,255, 0,255, 25, 43, 48, 1, 1, 1, 27, 46, 52,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255, 7, 13, 15, 24, 40, 45, + 26, 45, 50, 47, 80, 89, 17, 31, 35, 32, 54, 60, 12, 19, 21, 48, 82, + 90, 1, 1, 1, 27, 46, 51, 24, 40, 45, 1, 1, 1, 10, 16, 18, 26, + 45, 50,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 16, 26, + 30,255, 0,255, 0, 0, 0, 1, 1, 1, 34, 57, 64,255, 0,255,255, + 0,255, 47, 79, 88, 1, 1, 1, 12, 20, 22, 19, 32, 35, 16, 27, 30, + 26, 43, 49, 56, 93,104,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255, 33, 55, 62,255, 0,255,255, 0,255,255, 0,255, 26, 43, 48, + 255, 0,255,255, 0,255, 49, 83, 92, 1, 1, 1, 14, 23, 26,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255, 99,166,185, 59,100,112,255, 0,255,255, 0, + 255, 22, 37, 41,255, 0,255,255, 0,255, 68,117,130, 33, 55, 61, 29, + 49, 55,255, 0,255,255, 0,255, 94,158,176, 22, 36, 41, 23, 39, 44, + 20, 33, 37, 34, 57, 65, 48, 82, 91,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 99,166,185, 48, + 80, 89, 18, 33, 37, 22, 37, 41,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 16, 27, 30, 26, 43, + 48,255, 0,255,255, 0,255,255, 0,255, 50, 85, 95,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255, 24, 40, 44,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 26, + 43, 48,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255, 57, 97,107,255, 0,255,255, 0,255, 13, 24, 27,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 43, 72, 80,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 75,127,141, 59,101,112, 36, 63, 70, + 39, 66, 74,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255, 53, 90,100,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255, 84,142,158, 26, 44, 50, + 255, 0,255,255, 0,255,255, 0,255, 49, 84, 93,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,104,175, + 194, 56, 93,106, 29, 49, 55, 0, 0, 0, 0, 0, 0, 1, 1, 1,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,111,186,206, 76,129,143, 57, 98,109, 43, 73, 82, + 16, 27, 30,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/hyperlink.bmp } +const + img_richedit_hyperlink: array[0..1709] of byte = ( + 66, 77,174, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 23, 0, 0, 0, 23, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 120, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, + 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,221, 0, + 221, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,114, 0,114,255, + 0,255,255, 0,255,255, 0,255,191, 0,191, 0, 0, 0,235, 0,235, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, + 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 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, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,252, 0,252,255, 0,255,255, + 0,255, 0, 0, 0,255, 0,255,255, 0,255, 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, 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, + 255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, + 0, 91, 91, 91,151,151,151,157,157,157,163,163,163,167,167,167,169, + 169,169,169,169,169,120,120,120, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 120,120,120,164,164,164,150,150,150,136,136,136,121,121,121,108,108, + 108,105,105,105,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255, 0, + 0, 0, 0, 0, 0,121,121,121, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0,204,204,204, 0, 0, 0, 0, 0, + 0, 0, 0, 0,142,142,142, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0, + 255, 0,255,195,195,195,178,178,178,201,201,201,217,217,217,147,147, + 147, 0, 0, 0, 0, 0, 0, 97, 97, 97,142,142,142,170,170,170,204, + 204,204,204,204,204,220,220,220,244,244,244,242,242,242,128,128,128, + 0, 0, 0, 0, 0, 0, 65, 65, 65, 77, 77, 77,255, 0,255,255, 0, + 255, 0, 0, 0,255, 0,255, 0, 0, 0, 0, 0, 0,179,179,179, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 239,239,239, 0, 0, 0, 0, 0, 0, 0, 0, 0,204,204,204, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, + 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0, + 96, 96, 96,185,185,185,190,190,190,195,195,195,200,200,200,234,234, + 234,249,249,249,136,136,136, 0, 0, 0, 0, 0, 0, 0, 0, 0,104, + 104,104,202,202,202,190,190,190,178,178,178,179,179,179,172,172,172, + 170,170,170,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0, + 255,248, 0,248, 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,255, 0,255, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, + 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255, 0, 0, 0); +{home/michael/reader/image.bmp } +const + img_richedit_image: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0,136, 11, 0, 0,136, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 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, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 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, 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, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255, + 0, 0, 0,145,152,153,146,158,163,147,158,164,146,157,163,145,157, + 163,146,157,163,144,156,161,144,156,162,144,156,161,144,156,162,143, + 155,161,144,155,161,141,153,159,141,153,159,140,151,157,140,151,157, + 138,150,155, 89, 99,103, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255, 0, 0, 0,209,209,209,219,223,225,218,222,224,218, + 222,223,217,221,222,219,223,224,217,221,222,218,222,224,217,221,222, + 218,222,224,216,220,222,216,220,222,214,218,220,214,218,220,210,214, + 216,209,214,215,206,211,213,138,149,155, 0, 0, 0, 0, 0, 0,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,233,233,233,217,220,221, + 215,218,220,215,219,220,214,218,219,216,220,221,214,218,219,215,219, + 220,214,218,219,215,219,220,213,217,218,213,217,219,211,215,217,211, + 215,217,210,214,216,209,214,216,209,213,215,139,151,157, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,214,214, + 214,192,194,195,191,194,194,190,194,194,191,194,195,191,194,195,189, + 193,194,190,194,194,189,193,194,190,194,194,188,192,193,188,192,193, + 187,190,191,193,196,198,205,209,211,210,214,216,210,214,216,141,152, + 158, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0, 0, + 0, 0,164,164,164,142,144,144,141,143,144,141,143,144,141,143,144, + 141,143,143,141,143,144,140,143,143,141,143,144,140,143,143,139,142, + 143,138,141,141,139,142,143,158,161,161,193,196,197,209,213,215,211, + 215,217,141,153,159, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, + 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, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,139,142,143,187,190,191, + 211,215,216,215,219,220,144,155,161, 0, 0, 0, 0, 0, 0,255, 0, + 255,255, 0,255, 0, 0, 0,140,173,149, 77,122, 89, 86,130, 87, 85, + 130, 86, 81,127, 86, 77,122, 89, 72,116, 89, 75,122, 87, 75,121, 90, + 72,117, 93, 69,110, 92, 72,114, 89, 51, 84, 59, 0, 0, 0,139,141, + 142,187,190,191,212,216,217,216,220,221,144,155,161, 0, 0, 0, 0, + 0, 0,255, 0,255,255, 0,255, 0, 0, 0,112,128,133, 92,144,102, + 98,149,102, 95,144,102, 93,142, 99, 98,149,100, 92,142,103, 89,140, + 102, 96,146,100, 92,140,103, 92,140,104, 94,145,102, 62,102, 69, 0, + 0, 0,139,141,142,189,192,194,215,219,220,219,223,224,144,156,161, + 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0,218,205, + 196, 25, 47, 73, 89,138,103, 93,141,102, 95,142,101, 99,150,102, 86, + 135,100, 19, 39, 34, 9, 51, 65, 70,115, 96, 94,144,100, 84,132, 95, + 6, 7, 7, 0, 0, 0,141,143,143,192,194,195,217,220,221,220,223, + 225,147,158,164, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, + 0, 0,222,207,191,183,167,154, 15, 38, 66, 89,135,102, 96,140,102, + 88,134, 94, 32, 39, 45,206,182,158,154,119, 84, 16, 33, 33, 73,117, + 85, 14, 13, 11,147,130,113, 0, 0, 0,141,143,143,192,194,195,217, + 220,221,220,223,225,147,158,164, 0, 0, 0, 0, 0, 0,255, 0,255, + 255, 0,255, 0, 0, 0,219,201,184,201,174,147,182,162,145, 20, 36, + 47, 88,136, 94, 18, 28, 31,196,169,143,201,173,144,201,171,141,166, + 135,102, 38, 33, 27,156,134,114,176,152,129, 0, 0, 0,142,144,144, + 191,193,194,219,222,223,220,223,225,147,158,164, 0, 0, 0, 0, 0, + 0,255, 0,255,255, 0,255, 0, 0, 0,215,196,177,195,166,136,195, + 166,136,188,160,131, 97, 82, 67,188,160,131,195,166,136,192,177,153, + 200,239,234,203,186,163,195,166,136,195,166,136,171,145,119, 0, 0, + 0,147,148,148,194,196,196,215,218,220,220,223,225,147,158,164, 0, + 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, 0,212,191,170, + 190,158,126,190,158,126,190,158,126,190,158,126,190,158,126,190,158, + 126,199,238,235,223,254,254,208,226,218,190,158,126,190,158,126,166, + 138,110, 0, 0, 0,151,152,153,199,200,201,215,218,220,220,223,225, + 125,134,139, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255, 0, 0, + 0,209,186,163,185,150,115,185,150,115,185,150,115,185,150,115,185, + 150,115,185,150,115,189,170,143,196,228,220,185,156,123,185,150,115, + 185,150,115,162,131,101, 0, 0, 0,151,152,153,204,206,207,221,223, + 224,192,195,196,116,125,129, 0, 0, 0,252, 0,252,255, 0,255,255, + 0,255, 0, 0, 0,239,233,226,205,180,156,205,180,156,205,180,156, + 205,180,156,205,180,156,205,180,156,205,180,156,205,180,156,205,180, + 156,205,180,156,205,180,156,149,128,105, 0, 0, 0,162,163,163,193, + 195,197,196,198,198,180,182,182,108,112,114, 0, 0, 0,255, 0,255, + 255, 0,255,255, 0,255, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 189,190,190,174,175,177,128,130,130,129,131,132, 99,103,106, 0, 0, + 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,251, + 251,251,251,251,251,250,250,250,250,250,250,250,250,250,249,249,249, + 248,248,248,246,247,247,248,248,248,246,247,247,246,246,246,243,244, + 244,238,238,238,156,156,156, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,254,254,254,255,255,255,254,254,254,253, + 253,253,248,249,249,238,238,238,163,164,164,240,240,240,255,255,255, + 244,244,244,116,116,116, 5, 5, 5,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255, 0, 0, 0,246,246,246,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,248,249,249,238,239,239,174,175,175,233,233, + 233,255,255,255,129,129,129, 43, 43, 43,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,211,211,211,246,246,246, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,249,249,249,248,249,249,248,249,249,231, + 231,231,228,228,228,146,146,146, 31, 31, 31,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 34, 34, 34, 40, 40, 40, 81, 81, 81,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{home/michael/reader/italic.bmp} +const + img_richedit_italic: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,253,253,253,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242, 66, 66, 66, 3, 3, + 3,211,211,211,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,107,107,107, 17, 17, 17,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,239,239,239,196, + 196,196, 1, 1, 1, 91, 91, 91,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,247,247,247, 70, 70, 70, 54, 54, 54,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239, 91, 91, 91, 2, 2, 2,207,207,207,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246, 35, 35, 35, 91, + 91, 91,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,238,238,238,213,213,213, 9, 9, 9, 86, + 86, 86,242,242,242,243,243,243,244,244,244,244,244,244,242,242,242, + 4, 4, 4,127,127,127,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,238,238,238, + 116,116,116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0,164,164,164,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,236,236, + 236,237,237,237,226,226,226, 21, 21, 21, 31, 31, 31,234,234,234,241, + 241,241,242,242,242,163,163,163, 0, 0, 0,199,199,199,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,140,140,140, 0, 0, 0, + 136,136,136,240,240,240,241,241,241,127,127,127, 0, 0, 0,234,234, + 234,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233,234,234,234,235,235,235,236,236,236,232,232, + 232, 38, 38, 38, 20, 20, 20,227,227,227,240,240,240, 91, 91, 91, 25, + 25, 25,243,243,243,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,234, + 234,234,235,235,235,164,164,164, 0, 0, 0,118,118,118,239,239,239, + 57, 57, 57, 61, 61, 61,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,233,233,233,234,234,234,235,235,235, 59, 59, 59, 12, 12, + 12,221,221,221, 29, 29, 29, 96, 96, 96,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,188, + 188,188, 0, 0, 0,115,115,115, 9, 9, 9,132,132,132,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,234,234,234, 82, 82, 82, 16, 16, 16, 0, 0, 0,166,166, + 166,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,232,232,232,233,233,233,205,205,205, 7, 7, 7, 0, + 0, 0,200,200,200,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,231,231,231,232,232,232,233,233,233, + 234,234,234,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{home/michael/reader/justify.bmp } +const + img_richedit_justify: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,144,144,144,144,144,144,145,145,145,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,149,149, + 149,150,150,150,150,150,150,150,150,150,151,151,151,152,152,152,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,142,142,142,142,142,142,143, + 143,143,143,143,143,144,144,144,144,144,144,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,147,147,147,148,148,148,149,149, + 149,149,149,149,150,150,150,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,140,140,140,141,141,141,141,141,141,142,142,142,143,143,143,143, + 143,143,144,144,144,144,144,144,145,145,145,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,139,139,139,140,140,140,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,143, + 143,143,144,144,144,144,144,144,145,145,145,146,146,146,146,146,146, + 147,147,147,147,147,147,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 138,138,138,138,138,138,139,139,139,140,140,140,140,140,140,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,144, + 144,144,144,144,144,145,145,145,146,146,146,146,146,146,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,137,137,137,137,137,137,138,138,138, + 138,138,138,138,138,138,139,139,139,140,140,140,140,140,140,141,141, + 141,141,141,141,142,142,142,143,143,143,143,143,143,143,143,143,144, + 144,144,144,144,144,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,235, + 235,235,236,236,236,237,237,237,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,135, + 135,135,136,136,136,136,136,136,137,137,137,137,137,137,138,138,138, + 138,138,138,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,141,141,141,142,142,142,143,143,143,143,143,143,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,134,134,134,134,134,134,135,135,135,135, + 135,135,136,136,136,137,137,137,137,137,137,138,138,138,138,138,138, + 139,139,139,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,142,142,142,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/left.bmp } +const + img_richedit_left: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,144,144,144,144,144,144,145,145,145,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,149,149, + 149,252,252,252,253,253,253,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,142,142,142,142,142,142,143, + 143,143,143,143,143,144,144,144,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,247,247,247,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,140,140,140,141,141,141,141,141,141,142,142,142,143,143,143,143, + 143,143,144,144,144,243,243,243,244,244,244,244,244,244,245,245,245, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,139,139,139,140,140,140,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,143, + 143,143,144,144,144,144,144,144,145,145,145,146,146,146,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 138,138,138,138,138,138,139,139,139,140,140,140,140,140,140,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,242, + 242,242,243,243,243,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,137,137,137,137,137,137,138,138,138, + 138,138,138,138,138,138,139,139,139,140,140,140,236,236,236,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,235, + 235,235,236,236,236,237,237,237,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,135, + 135,135,136,136,136,136,136,136,137,137,137,137,137,137,138,138,138, + 138,138,138,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,141,141,141,142,142,142,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,134,134,134,134,134,134,135,135,135,135, + 135,135,136,136,136,137,137,137,137,137,137,138,138,138,138,138,138, + 139,139,139,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{ home/michael/reader/margin.bmp } +const + img_richedit_margin: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,218,218,218,238,238,238,235,235,235, + 236,236,236,237,237,237,238,238,238,238,238,238,239,239,239,240,240, + 240,241,241,241,242,242,242,243,243,243,244,244,244,245,245,245,245, + 245,245,245,245,245,245,245,245,228,228,228,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,188, + 188,188,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,217,217, + 217,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,253,253,253,253,253,253,254,254,254,255,255,255,255, + 255,255,245,245,245,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,183,183,183,184,184,184,184,184,184,184,184, + 184,185,185,185,186,186,186,187,187,187,187,187,187,188,188,188,189, + 189,189,190,190,190,190,190,190,190,190,190,191,191,191,192,192,192, + 193,193,193,255,255,255,245,245,245,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,239,239,239,240, + 240,240,241,241,241,242,242,242,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,247,247,247,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,244,244,244,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,243,243,243, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240,241, + 241,241,121,121,121,121,121,121,122,122,122,122,122,122,122,122,122, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,173,173,173,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,240,240,240,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235, 0, 0, + 0,173,173,173,238,238,238,239,239,239,120,120,120,120,120,120,120, + 120,120,121,121,121,121,121,121,122,122,122,122,122,122,123,123,123, + 123,123,123,124,124,124,248,248,248,239,239,239,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0,173,173,173,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,238,238,238,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233, 0, 0, 0,172,172,172,236,236,236,236,236, + 236,118,118,118,119,119,119,119,119,119,120,120,120,120,120,120,121, + 121,121,121,121,121,122,122,122,122,122,122,122,122,122,246,246,246, + 237,237,237,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,170,170,170,234,234,234,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,236,236,236,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,233,233,233,234,234,234,117,117,117,118,118,118,118,118, + 118,119,119,119,119,119,119,120,120,120,120,120,120,120,120,120,121, + 121,121,121,121,121,244,244,244,235,235,235,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,235, + 235,235,236,236,236,237,237,237,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,234,234,234,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,234,234,234,235,235,235,236,236,236,237,237,237,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,233, + 233,233,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,172,172,172,172,172,172,173,173,173,174,174,174,174,174, + 174,175,175,175,176,176,176,177,177,177,178,178,178,178,178,178,179, + 179,179,179,179,179,180,180,180,181,181,181,181,181,181,182,182,182, + 241,241,241,232,232,232,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,231,231,231,232,232,232,233,233,233, + 234,234,234,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,231,231,231,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,174,174,174,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,227,227,227,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{home/michael/reader/nowrap.bmp} +const + img_richedit_nowrap: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,253,253,253,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,207,200,192,115, 87, 59,115, 87, + 60,180,165,152,245,245,245,246,246,246,108, 78, 49,108, 78, 49,122, + 95, 69,232,229,225,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,108, 78, 49,236, + 235,234,241,241,241,108, 78, 49,243,243,243,244,244,244,108, 78, 49, + 246,246,246,173,158,142,132,107, 83,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 108, 78, 49,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,108, 78, 49,245,245,245,245,245,245,115, 86, 59,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,108, 78, 49,238,238,238,239,239,239,240,240,240,241, + 241,241,242,242,242,108, 78, 49,244,244,244,244,244,244,114, 86, 58, + 246,246,246,247,247,247,248,248,248,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,108, 78, 49,234,234,234,238,238,238, + 108, 78, 49,240,240,240,241,241,241,108, 78, 49,242,242,242,169,153, + 138,132,107, 84,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,204,196,189,115, 87, + 60,116, 87, 60,184,172,160,239,239,239,240,240,240,108, 78, 49,108, + 78, 49,122, 95, 69,227,224,220,244,244,244,245,245,245,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,108, 78, 49,234,234,234,235,235,235,108, 78, 49,236,236, + 236,237,237,237,108, 78, 49,108, 78, 49,108, 78, 49,177,163,149,242, + 242,242,243,243,243,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,108, 78, 49,233,233,233,234,234,234,108, + 78, 49,235,235,235,236,236,236,108, 78, 49,238,238,238,223,219,215, + 115, 86, 59,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,108, 78, 49,108, 78, 49, + 108, 78, 49,108, 78, 49,234,234,234,235,235,235,108, 78, 49,237,237, + 237,204,197,189,121, 95, 69,240,240,240,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,108, 78, + 49,231,231,231,231,231,231,108, 78, 49,233,233,233,234,234,234,108, + 78, 49,108, 78, 49,108, 78, 49,206,199,192,239,239,239, 0, 0, 0, + 0, 0, 0, 0, 0, 0,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,108, 78, 49,229,229,229,230,230,230,108, 78, 49,232,232,232, + 233,233,233,108, 78, 49,235,235,235,225,223,221,117, 89, 62,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,156,138,120,108, 78, 49,108, 78, 49,158,140, + 123,231,231,231,232,232,232,108, 78, 49,108, 78, 49,108, 78, 49,147, + 126,106,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,231,231,231,232,232,232,233,233,233, + 234,234,234,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{home/michael/reader/right.bmp} +const + img_richedit_right: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,149,149, + 149,150,150,150,150,150,150,150,150,150,151,151,151,152,152,152,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,239,239,239,240, + 240,240,241,241,241,242,242,242,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,247,247,247,147,147,147,148,148,148,149,149, + 149,149,149,149,150,150,150,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240,241, + 241,241,242,242,242,243,243,243,244,244,244,145,145,145,146,146,146, + 146,146,146,147,147,147,147,147,147,148,148,148,149,149,149,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,236,236, + 236,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,143, + 143,143,144,144,144,144,144,144,145,145,145,146,146,146,146,146,146, + 147,147,147,147,147,147,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,238,238,238, + 239,239,239,240,240,240,241,241,241,242,242,242,243,243,243,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233,234,234,234,235,235,235,236,236,236,140,140, + 140,141,141,141,141,141,141,142,142,142,143,143,143,143,143,143,144, + 144,144,144,144,144,145,145,145,146,146,146,146,146,146,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,234, + 234,234,235,235,235,236,236,236,237,237,237,238,238,238,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,233,233,233,234,234,234,235,235,235,236,236,236,237,237, + 237,141,141,141,142,142,142,143,143,143,143,143,143,143,143,143,144, + 144,144,144,144,144,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,233,233,233,234,234,234,235, + 235,235,236,236,236,237,237,237,238,238,238,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,136,136,136,137,137,137,137,137,137,138,138,138, + 138,138,138,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,141,141,141,142,142,142,143,143,143,143,143,143,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,137,137,137,138,138,138,138,138,138, + 139,139,139,139,139,139,140,140,140,140,140,140,141,141,141,141,141, + 141,142,142,142,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); +{home/michael/reader/underlined.bmp} +const + img_richedit_underlined: array[0..1781] of byte = ( + 66, 77,246, 6, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,201,201,201,237,237,237,248,248,248,245,245,245, + 246,246,246,247,247,247,248,248,248,248,248,248,249,249,249,250,250, + 250,251,251,251,252,252,252,253,253,253,254,254,254,255,255,255,255, + 255,255,255,255,255,255,255,255,238,238,238,189,189,189,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,246,246,246,247,247,247,248, + 248,248,249,249,249,250,250,250,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255,255,255,255,255,255,236,236, + 236,255, 0,255,255, 0,255,255, 0,255,255, 0,255,248,248,248,241, + 241,241,242,242,242,192,192,192, 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, 0, 0, 0, 0, 0, 0,159,159,159,255,255,255,255, + 255,255,255,255,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 248,248,248,240,240,240,241,241,241,242,242,242,242,242,242,243,243, + 243,244,244,244,245,245,245,246,246,246,247,247,247,248,248,248,249, + 249,249,250,250,250,251,251,251,251,251,251,252,252,252,253,253,253, + 254,254,254,255,255,255,255,255,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,247,247,247,238,238,238,239,239,239,239,239,239, 44, + 44, 44, 13, 13, 13,234,234,234,243,243,243,244,244,244,245,245,245, + 246,246,246,247,247,247,247,247,247,216,216,216, 0, 0, 0, 50, 50, + 50,251,251,251,252,252,252,253,253,253,254,254,254,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,247,247,247,237,237,237,237,237,237, + 238,238,238,134,134,134, 0, 0, 0,162,162,162,242,242,242,243,243, + 243,244,244,244,245,245,245,245,245,245,246,246,246,124,124,124, 0, + 0, 0,151,151,151,250,250,250,251,251,251,252,252,252,253,253,253, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,246,246,246,235,235, + 235,236,236,236,237,237,237,219,219,219, 4, 4, 4, 77, 77, 77,241, + 241,241,242,242,242,243,243,243,244,244,244,244,244,244,245,245,245, + 33, 33, 33, 13, 13, 13,237,237,237,249,249,249,250,250,250,251,251, + 251,252,252,252,255, 0,255,255, 0,255,255, 0,255,255, 0,255,245, + 245,245,234,234,234,235,235,235,236,236,236,237,237,237, 76, 76, 76, + 7, 7, 7,225,225,225,241,241,241,242,242,242,242,242,242,243,243, + 243,186,186,186, 0, 0, 0,102,102,102,247,247,247,248,248,248,249, + 249,249,250,250,250,250,250,250,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,245,245,245,233,233,233,234,234,234,235,235,235,236,236, + 236,166,166,166, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,200,200,200,246,246,246, + 247,247,247,248,248,248,248,248,248,249,249,249,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,245,245,245,232,232,232,233,233,233,234, + 234,234,235,235,235,233,233,233, 22, 22, 22, 29, 29, 29,238,238,238, + 239,239,239,240,240,240,208,208,208, 0, 0, 0, 53, 53, 53,244,244, + 244,245,245,245,246,246,246,247,247,247,247,247,247,248,248,248,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,244,244,244,231,231,231, + 232,232,232,233,233,233,234,234,234,235,235,235,108,108,108, 0, 0, + 0,184,184,184,238,238,238,239,239,239,123,123,123, 0, 0, 0,151, + 151,151,243,243,243,244,244,244,245,245,245,245,245,245,246,246,246, + 247,247,247,255, 0,255,255, 0,255,255, 0,255,255, 0,255,244,244, + 244,230,230,230,231,231,231,232,232,232,233,233,233,234,234,234,196, + 196,196, 0, 0, 0, 99, 99, 99,237,237,237,238,238,238, 37, 37, 37, + 16, 16, 16,232,232,232,242,242,242,243,243,243,243,243,243,244,244, + 244,245,245,245,246,246,246,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,243,243,243,229,229,229,230,230,230,231,231,231,232,232,232, + 233,233,233,233,233,233, 50, 50, 50, 20, 20, 20,233,233,233,191,191, + 191, 0, 0, 0,104,104,104,240,240,240,241,241,241,241,241,241,242, + 242,242,243,243,243,244,244,244,245,245,245,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,243,243,243,228,228,228,229,229,229,230,230, + 230,231,231,231,231,231,231,232,232,232,138,138,138, 0, 0, 0,175, + 175,175,106,106,106, 0, 0, 0,199,199,199,239,239,239,239,239,239, + 240,240,240,241,241,241,242,242,242,243,243,243,244,244,244,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,243,243,243,227,227,227,228, + 228,228,229,229,229,229,229,229,230,230,230,231,231,231,218,218,218, + 8, 8, 8,106,106,106, 27, 27, 27, 56, 56, 56,237,237,237,237,237, + 237,238,238,238,239,239,239,240,240,240,241,241,241,242,242,242,243, + 243,243,255, 0,255,255, 0,255,255, 0,255,255, 0,255,242,242,242, + 226,226,226,227,227,227,227,227,227,228,228,228,229,229,229,230,230, + 230,231,231,231, 81, 81, 81, 19, 19, 19, 0, 0, 0,152,152,152,236, + 236,236,236,236,236,237,237,237,238,238,238,239,239,239,240,240,240, + 241,241,241,242,242,242,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,242,242,242,225,225,225,225,225,225,226,226,226,227,227,227,228, + 228,228,229,229,229,230,230,230,169,169,169, 0, 0, 0, 17, 17, 17, + 227,227,227,234,234,234,235,235,235,236,236,236,237,237,237,238,238, + 238,239,239,239,240,240,240,241,241,241,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,240,240,240,224,224,224,224,224,224,225,225,225, + 226,226,226,227,227,227,228,228,228,229,229,229,230,230,230,231,231, + 231,232,232,232,232,232,232,233,233,233,234,234,234,235,235,235,236, + 236,236,237,237,237,238,238,238,239,239,239,237,237,237,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,226,226,226,242,242,242,242,242, + 242,242,242,242,242,242,242,243,243,243,243,243,243,243,243,243,244, + 244,244,244,244,244,244,244,244,245,245,245,245,245,245,245,245,245, + 246,246,246,246,246,246,247,247,247,247,247,247,244,244,244,219,219, + 219,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); diff --git a/docview/components/richtext/testedit/testedit.lpi b/docview/components/richtext/testedit/testedit.lpi new file mode 100644 index 00000000..de17125e --- /dev/null +++ b/docview/components/richtext/testedit/testedit.lpi @@ -0,0 +1,88 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <Language Value=""/> + <CharSet Value=""/> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <CommandLineParams Value="/home/michael/source/fpgui/docview/components/richtext/testapp/sample01.txt"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="fpgui_richtext"/> + </Item1> + <Item2> + <PackageName Value="fpgui_toolkit"/> + </Item2> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="testedit.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="testedit"/> + </Unit0> + <Unit1> + <Filename Value="frarichtextedit.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frarichtextedit"/> + </Unit1> + <Unit2> + <Filename Value="img_richedit.inc"/> + <IsPartOfProject Value="True"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/docview/components/richtext/testedit/testedit.lpr b/docview/components/richtext/testedit/testedit.lpr new file mode 100644 index 00000000..c2dba52a --- /dev/null +++ b/docview/components/richtext/testedit/testedit.lpr @@ -0,0 +1,176 @@ +program testboard; + +{$mode objfpc}{$H+} + +uses {$IFDEF UNIX} {$IFDEF UseCThreads} + cthreads, {$ENDIF} {$ENDIF} + Classes, + SysUtils, + fpg_base, + fpg_tab, + fpg_button, + fpg_panel, + fpg_main, + fpg_memo, + fpg_form, + fpg_dialogs, + fpg_menu, + RichTextView, frarichtextedit, + fpg_imagelist, + fpg_imgfmt_bmp, + fpg_imgfmt_png, + fpg_imgfmt_jpg; + +type + + {@VFD_NEWFORM_DECL} + { TMainForm } + + TMainForm = class(TfpgForm) + procedure DoNewFile(Sender: TObject); + procedure DoOpenFile(Sender: TObject); + procedure DoQuit(Sender: TObject); + procedure DoSaveFile(Sender: TObject); + private + procedure LoadFile(const AFileName: String); + procedure SaveFile(const AFileName: String); + public + FMenu : TfpgMenuBar; + MFile, + MNew, + MOpen, + MSave, + MQuit: TfpgMenuItem; + FFileName : string; + {@VFD_HEAD_BEGIN: MainForm} + FEdit : TRichTextEditFrame; + {@VFD_HEAD_END: MainForm} + procedure AfterCreate; override; + end; + + + + {@VFD_NEWFORM_IMPL} + +procedure TMainForm.DoNewFile(Sender: TObject); +begin + FEdit.RichText:=''; + FFileName:=''; + WindowTitle:='Editing new file'; +end; + +procedure TMainForm.LoadFile(COnst AFileName :String); + +Var + L : TStrings; + +begin + FFileName:=AFileName; + L:=TstringList.Create; + try + L.LoadFromFile(AFileName); + fedit.RichText:=l.text; + finally + L.Free; + end; + WindowTitle:='Editing '+AFileName; +end; + +procedure TMainForm.SaveFile(COnst AFileName :String); + +Var + L : TStrings; + +begin + FFileName:=AFileName; + L:=TstringList.Create; + try + l.text:=fedit.RichText; + L.SaveToFile(AFileName); + finally + L.Free; + end; + WindowTitle:='Editing '+AFileName; +end; + + +procedure TMainForm.DoOpenFile(Sender: TObject); + +Var + FN : String; + +begin + FN:=SelectFileDialog(sfdOpen,'text files|*.txt|All files|'+AllFilesMask,''); + if (FN<>'') then + LoadFile(FN); +end; + +procedure TMainForm.DoQuit(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.DoSaveFile(Sender: TObject); +Var + FN : String; + +begin + FN:=SelectFileDialog(sfdSave,'text files|*.txt|All files|'+AllFilesMask,''); + if (FN<>'') then + SaveFile(FN); +end; + +procedure TMainForm.AfterCreate; +var + I, J: integer; + img: tfpgimage; + S: string; +begin + FMenu:=TfpgMenuBar.Create(Self); + FMenu.SetPosition(0,0,Self.width,30); + FMenu.align:=alTop; + MFile:=FMenu.AddMenuItem('File',Nil); + MFile.SubMenu:=TfpgPopupMenu.Create(MFile); + MNew:=MFile.SubMenu.AddMenuItem('&New','ctrl-n',@DoNewFile); + MOpen:=MFile.SubMenu.AddMenuItem('&Open','ctrl-o',@DoOpenFile); + MSave:=MFile.SubMenu.AddMenuItem('&Save','ctrl-s',@DoSaveFile); + MQuit:=MFile.SubMenu.AddMenuItem('&Quit','ctrl-q',@DoQuit); + Fedit:=TRichTextEditFrame.Create(Self); + Fedit.SetPosition(0,FMenu.Height,Self.width,Self.Height-FMenu.Height); + Fedit.align:=alClient; + {%region 'Auto-generated GUI code' } + + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(496, 295, 739, 502); + WindowTitle := 'Editing new file'; + Hint := ''; + + {@VFD_BODY_END: MainForm} + {%endregion} +end; + + + +procedure MainProc; +var + frm: TMainForm; + +begin + fpgApplication.Initialize; + RegisterStdRichTextImages; + frm := TMainForm.Create(nil); + try + frm.Show; + if (ParamCount=1) and FileExists(ParamStr(1)) then + frm.LoadFile(Paramstr(1)); + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + diff --git a/docview/docs/docview.ipf b/docview/docs/docview.ipf index 94099582..c916787d 100644 --- a/docview/docs/docview.ipf +++ b/docview/docs/docview.ipf @@ -136,7 +136,7 @@ The following trademarks are used in this online help file: .* ************************************************************ .* Using DocView .* ************************************************************ -:h1 res=2 id='Using'.Using &dv. +:h1 res=2 id='Using'.Using DocView :hp2.Using &dv.:ehp2. :p. Once you have :link reftype=hd refid='OpeningFiles'.opened a @@ -169,8 +169,7 @@ Colours and some of the behaviour of &dv. can be adjusted from the "Tools .* ************************************************************ .* Opening Help File .* ************************************************************ -:h1 res=3 id='OpeningFiles'. -Opening Files +:h1 res=3 id='OpeningFiles'.Opening Files :i1 id=30005.open :p.:hp2.Opening Help Files:ehp2. :p. diff --git a/docview/src/CompareWordUnit.pas b/docview/src/CompareWordUnit.pas index 49c2ea26..05f32cc8 100644 --- a/docview/src/CompareWordUnit.pas +++ b/docview/src/CompareWordUnit.pas @@ -2,11 +2,7 @@ Unit CompareWordUnit; {$mode objfpc}{$H+} -// NewView - a new OS/2 Help Viewer -// Copyright 2001 Aaron Lawrence (aaronl at consultant dot com) -// This software is released under the Gnu Public License - see readme.txt - -Interface +interface // Compares words and produces a match level (relevance) based // on the relative sizes etc. Used in searching help files @@ -21,15 +17,15 @@ const // Compares the given search word against the given // reference word. Returns a value indicating how well the // search word matches, 0 = not at all. -function CompareWord( const SearchWord: string; - const ReferenceWord: string ): longint; +function CompareWord( const SearchWord: string; const ReferenceWord: string ): longint; + -Implementation +implementation uses SysUtils; -// LOoks for string a within string b, case insensitively +// Looks for string a within string b, case insensitively function CaseInsensitivePos( const a, b: string ): longint; begin // Budget implementation to begin with. @@ -63,21 +59,16 @@ begin if OccurrencePos = 1 then begin // word starts with searchword - Result := mwWordStart - * Length( SearchWord ) - div Length( ReferenceWord ); + Result := mwWordStart * Length(SearchWord) div Length(ReferenceWord); if Result = 0 then Result := 1; exit; end; // Matched searchword somewhere within word - Result := mwWordWithin - * Length( SearchWord ) - div Length( ReferenceWord ); + Result := mwWordWithin * Length(SearchWord) div Length(ReferenceWord); if Result = 0 then Result := 1; - end; {// Note: searchstring must be uppercase, @@ -103,5 +94,6 @@ begin end; end; } -Initialization -End. + +end. + diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index 692bf64d..45855a1f 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -83,7 +83,7 @@ type _UncompressedBlockSize: longint; function GetPaletteSize: longint; procedure BitmapError(Msg: string); - procedure ReadBitmapData( Blocks: TList; TotalSize: longint ); + procedure ReadBitmapData( Blocks: TList; TotalSize: longword); public constructor CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longint); destructor Destroy; override; @@ -267,7 +267,7 @@ begin inherited Destroy; end; -procedure THelpBitmap.ReadBitmapData( Blocks: TList; TotalSize: longint ); +procedure THelpBitmap.ReadBitmapData( Blocks: TList; TotalSize: longword ); var BytesWritten: longint; BytesWrittenFromBlock: longword; diff --git a/docview/src/HelpFile.pas b/docview/src/HelpFile.pas index ce3d9f8a..6e1a40d6 100644 --- a/docview/src/HelpFile.pas +++ b/docview/src/HelpFile.pas @@ -9,6 +9,7 @@ interface uses Classes ,SysUtils + ,fpg_base ,fpg_imagelist ,IPFFileFormatUnit ,HelpTopic @@ -18,9 +19,6 @@ uses type - TFontEncoding = (encUTF8, encCP437, encCP850, encIBMGraph); - - TIndexEntry = class(TObject) private name: String; @@ -132,6 +130,7 @@ type property Title: string read _Title; property Topics[ Index: longint ]: TTopic read GetTopic; property TopicList: TList read _Topics; + property FontTable: TList read _FontTable; property TopicCount: longint read GetTopicCount; property StringResourceIDCount: integer read GetStringResourceIDCount; property NumericResourceIDCount: integer read GetNumericResourceIDCount; @@ -173,7 +172,7 @@ type procedure SetupFontSubstitutes( Substitutions: string ); public NotesLoaded: boolean; // used externally - Encoding: TFontEncoding; + Encoding: TfpgTextEncoding; end; // Returns helpfile that the given topic is within @@ -396,14 +395,7 @@ begin begin lText := TTopic(TopicList[i]).Title; // apply encoding conversion - case Encoding of - encUTF8: lText := IPFToUTF8(lText); - encCP437: lText := CP437ToUTF8(lText); - encCP850: lText := CP850ToUTF8(lText); - encIBMGraph: lText := IBMGraphToUTF8(lText); - else - lText := IPFToUTF8(lText); - end; + lText := ConvertTextToUTF8(Encoding, lText); TTopic(TopicList[i]).Title := lText; end; except @@ -663,7 +655,6 @@ var pEnd: pByte; pIndexData: pointer; tmpIndexEntry: TIndexEntry; - lText: string; begin LogEvent(LogParse, 'Read index'); _Index := TIndex.Create; @@ -694,15 +685,7 @@ begin if pEntryHeader^.TOCIndex < _Topics.Count then begin // apply encoding conversion - case Encoding of - encUTF8: lText := IPFToUTF8(EntryText); - encCP437: lText := CP437ToUTF8(EntryText); - encCP850: lText := CP850ToUTF8(EntryText); - encIBMGraph: lText := IBMGraphToUTF8(EntryText); - else - lText := IPFToUTF8(EntryText); - end; - EntryText := lText; + EntryText := ConvertTextToUTF8(Encoding, EntryText); tmpIndexEntry := TIndexEntry.Create(EntryText, TTopic(_Topics[pEntryHeader^.TOCIndex]), pEntryHeader^.flags); _Index.Add(tmpIndexEntry); end @@ -1067,10 +1050,11 @@ begin begin pFontSpec := p + i * sizeof( THelpFontSpec ); _FontTable.Add( pFontSpec ); - if pFontSpec^.CodePage = 850 then - Encoding := encCP850 - else if pFontSpec^.CodePage = 437 then - Encoding := encCP437; + case pFontSpec^.CodePage of + 437: Encoding := encCP437; + 850: Encoding := encCP850; + 866: Encoding := encCP866; + end; end; end; diff --git a/docview/src/HelpTopic.pas b/docview/src/HelpTopic.pas index a9b981f1..8b12b569 100644 --- a/docview/src/HelpTopic.pas +++ b/docview/src/HelpTopic.pas @@ -235,6 +235,8 @@ uses ,nvUtilities ,ACLStringUtility ,SettingsUnit + ,fpg_stringutils + ,HelpFile ; const @@ -2544,7 +2546,10 @@ begin // normal lookup if GlobalDictIndex < _GlobalDictionary.Count then - StringToAdd := _GlobalDictionary[ GlobalDictIndex ] + begin + StringToAdd := _GlobalDictionary[ GlobalDictIndex ]; + StringToAdd := ConvertTextToUTF8(THelpFile(HelpFile).Encoding, StringToAdd); + end else StringToAdd := ''; diff --git a/docview/src/SearchUnit.pas b/docview/src/SearchUnit.pas index ec333406..5f40f641 100644 --- a/docview/src/SearchUnit.pas +++ b/docview/src/SearchUnit.pas @@ -2,9 +2,11 @@ Unit SearchUnit; {$mode objfpc}{$H+} -// NewView - a new OS/2 Help Viewer -// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com) -// This software is released under the Gnu Public License - see readme.txt +{ TODO: Possible speed improvement here is to populate the DictionaryWords + array with already UTF8 text encoded words. That way we don't need + to do conversions each time for each word we search for. This should + be a nice speed impromevent. +} Interface @@ -52,6 +54,7 @@ uses ,CompareWordUnit ,nvUtilities ,ACLStringUtility + ,fpg_stringutils ; type @@ -129,6 +132,8 @@ begin for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin DictWord := HelpFile.DictionaryWords[ DictIndex ]; + // apply encoding conversion + DictWord := ConvertTextToUTF8(HelpFile.Encoding, DictWord); Results^[ DictIndex ] := CompareWord( SearchWord, DictWord ); end; end; @@ -147,6 +152,8 @@ begin for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin DictWord := HelpFile.DictionaryWords[ DictIndex ]; + // apply encoding conversion + DictWord := ConvertTextToUTF8(HelpFile.Encoding, DictWord); if SameText( SearchWord, DictWord ) then Results^[ DictIndex ] := mwExactWord; end; @@ -166,6 +173,8 @@ begin for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin DictWord := HelpFile.DictionaryWords[ DictIndex ]; + // apply encoding conversion + DictWord := ConvertTextToUTF8(HelpFile.Encoding, DictWord); if StrStartsWithIgnoringCase(DictWord, SearchWord) then Results^[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); end; @@ -185,6 +194,8 @@ begin for DictIndex := 0 to HelpFile.DictionaryCount - 1 do begin DictWord := HelpFile.DictionaryWords[ DictIndex ]; + // apply encoding conversion + DictWord := ConvertTextToUTF8(HelpFile.Encoding, DictWord); if StrEndsWithIgnoringCase( SearchWord, DictWord ) then Results^[ DictIndex ] := MatchedWordRelevance( SearchWord, DictWord ); end; diff --git a/docview/src/SettingsUnit.pas b/docview/src/SettingsUnit.pas index 43083709..0825b10b 100644 --- a/docview/src/SettingsUnit.pas +++ b/docview/src/SettingsUnit.pas @@ -13,7 +13,6 @@ Uses ,fpg_base ,fpg_main ,CanvasFontManager - ,HelpFile ; Const @@ -95,7 +94,7 @@ type GlobalSearchLocation: TGlobalSearchLocation; SearchDirectories: TStringList; IPFTopicSaveAsEscaped: boolean; - Encoding: TFontEncoding; + Encoding: TfpgTextEncoding; end; diff --git a/docview/src/docview.rc b/docview/src/docview.rc index 34ed0c18..749a08de 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, 0, 0, 0 -PRODUCTVERSION 1, 0, 0, 0 +FILEVERSION 1, 2, 0, 0 +PRODUCTVERSION 1, 2, 0, 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.0.0" + VALUE "FileVersion", "1.2.0" VALUE "InternalName", "docview" VALUE "LegalCopyright", "GNU Public License" VALUE "OriginalFilename", "docview" VALUE "ProductName", "fpGUI Toolkit" - VALUE "ProductVersion", "1.0.0" + VALUE "ProductVersion", "1.2.0" } } BLOCK "VarFileInfo" diff --git a/docview/src/extrafpc.cfg b/docview/src/extrafpc.cfg index f23067ff..f5c8d3a4 100644 --- a/docview/src/extrafpc.cfg +++ b/docview/src/extrafpc.cfg @@ -6,3 +6,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 97a9fd04..802c3600 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -105,6 +105,9 @@ type Bookmarks: TList; BookmarksMenuItems: TList; + procedure RichViewDragDrop(Sender, Source: TObject; X, Y: integer; AData: variant); + procedure tvContentsDragDrop(Sender, Source: TObject; X, Y: integer; AData: variant); + procedure tvContentsDragEntered(Sender, Source: TObject; AMimeList: TStringList; var AMimeChoice: TfpgString; var ADropAction: TfpgDropAction; var Accept: Boolean); procedure Splitter1DoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); procedure btnTBNoteAddClick(Sender: TObject); procedure RichViewOverLink(Sender: TRichTextView; Link: string); @@ -148,7 +151,7 @@ type procedure miHelpAboutFPGui(Sender: TObject); procedure miHelpCmdLineParams(Sender: TObject); procedure miHelpUsingDocView(Sender: TObject); - procedure miDebugHeader(Sender: TObject); + procedure miShowFileInfoClicked(Sender: TObject); procedure miDebugHex(Sender: TObject); procedure miToolsFindByResourceID(Sender: TObject); procedure miToolsFindTopifByName(Sender: TObject); @@ -328,6 +331,77 @@ begin btnNext.Click; end; +{ If you drop on RichView, only load the first INF file (closing all others + first. If you want multiple files or add more files, drop on Contents + TreeView. } +procedure TMainForm.RichViewDragDrop(Sender, Source: TObject; X, Y: integer; + AData: variant); +var + s: string; + i: integer; + sl: TStringList; +begin + sl := TStringList.Create; + sl.Text := Trim(AData); + try + for i := 0 to sl.Count-1 do + begin + s := sl[i]; + if not SameText(fpgExtractFileExt(s), '.inf') then + Exit; //==> + s := StringReplace(s, 'file://', '', [rfIgnoreCase]); + OpenFile(s, '', false); + Break; + end; + finally + sl.Free; + end; +end; + +procedure TMainForm.tvContentsDragDrop(Sender, Source: TObject; X, Y: integer; + AData: variant); +var + s: string; + i: integer; + sl: TStringList; +begin + sl := TStringList.Create; + sl.Text := Trim(AData); + OpenAdditionalFile := True; + try + for i := 0 to sl.Count-1 do + begin + s := sl[i]; + if not SameText(fpgExtractFileExt(s), '.inf') then + Exit; //==> + s := StringReplace(s, 'file://', '', [rfIgnoreCase]); + OpenFile(s, '', false); + end; + finally + OpenAdditionalFile := False; + sl.Free; + end; +end; + +procedure TMainForm.tvContentsDragEntered(Sender, Source: TObject; + AMimeList: TStringList; var AMimeChoice: TfpgString; + var ADropAction: TfpgDropAction; var Accept: Boolean); +var + i: integer; + s: string; +begin + { the mime type we want to accept } + s := 'text/uri-list'; + { if we wil accept the drop, set Accept to True } + Accept := AMimeList.IndexOf(s) > -1; + if Accept then + begin + { If the offered mime type is different, request our preference } + if AMimeChoice <> s then + AMimeChoice := s; + end; +end; + procedure TMainForm.Splitter1DoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin @@ -732,11 +806,12 @@ begin OpenFile(OWN_HELP_MARKER, '', True); end; -procedure TMainForm.miDebugHeader(Sender: TObject); +procedure TMainForm.miShowFileInfoClicked(Sender: TObject); var f: THelpFile; - i: integer; + i, j: integer; sl: TStringList; + pFontSpec: pTHelpFontSpec; begin RichView.Clear; sl := TStringList.Create; @@ -750,7 +825,13 @@ begin Add('<b><u>Filename:</u></b> <blue>' + f.Filename + '</blue>'); Add('<b>Title:</b> ' + f.Title); Add('<b>File size:</b> ' + IntToStr(fpgFileSize(f.Filename)) + ' bytes'); - Add('<b>INF/HLP file version</b> ' + f.FormatVersion); + Add('<b>INF/HLP file version:</b> ' + f.FormatVersion); + Add('<b>Font table:</b> '); + for j := 0 to f.FontTable.Count-1 do + begin + pFontSpec := f.FontTable[j]; + Add(Format(' %s (%d x %d), codepage: %d', [pFontSpec^.FaceName, pFontSpec^.Width, pFontSpec^.Height, pFontSpec^.Codepage])); + end; Add('<b>Dictionary count:</b> ' + IntToStr(f.DictionaryCount)); Add('<b>Topic count:</b> ' + IntToStr(f.TopicCount)); Add('<b>Index count:</b> ' + IntToStr(f.Index.Count)); @@ -1174,7 +1255,7 @@ end; procedure TMainForm.cbEncodingChanged(Sender: TObject); begin - Settings.Encoding := TFontEncoding(cbEncoding.FocusItem); + Settings.Encoding := TfpgTextEncoding(cbEncoding.FocusItem); DisplayTopic(CurrentTopic); end; @@ -1326,7 +1407,7 @@ begin if SearchText = '' then begin ClearAllWordSequences; - exit; + exit; //==> end; lbSearchResults.Items.Add(rsDVSearchingMsg); @@ -1338,7 +1419,7 @@ begin on e: ESearchSyntaxError do begin TfpgMessageDialog.Critical( rsSearch, rsDVSearchSyntaxError + e.Message ); - exit; + exit; //==> end; end; @@ -1348,7 +1429,7 @@ begin SearchResults := TList.Create; - // Search open help file + // Search open help files for FileIndex := 0 to CurrentOpenFiles.Count - 1 do begin HelpFile := THelpFile(CurrentOpenFiles[ FileIndex ]); @@ -1364,7 +1445,7 @@ begin TfpgMessageDialog.Critical(rsError , E.Message); Query.Destroy; ClearWaitCursor; - exit; + exit; //==> end; end; @@ -2264,7 +2345,6 @@ var Note: THelpNote; NotesFile: TStringList; TopicIndex: integer; - s: TfpgString; begin ProfileEvent('Save notes for ' + AHelpFile.Filename); if not AHelpFile.NotesLoaded then @@ -2465,8 +2545,6 @@ procedure TMainForm.DisplayTopic(ATopic: TTopic); var lText: String; ImageIndices: TList; - LinkIndex: longint; - Link: THelpLink; HelpFile: THelpFile; Topic: TTopic; HighlightWordSequences: TList; @@ -2569,14 +2647,7 @@ begin ImageIndices.Free; // apply encoding conversion - case Settings.Encoding of - encUTF8: lText := IPFToUTF8(lText); - encCP437: lText := CP437ToUTF8(lText); - encCP850: lText := CP850ToUTF8(lText); - encIBMGraph: lText := IBMGraphToUTF8(lText); - else - lText := IPFToUTF8(lText); - end; + lText := ConvertTextToUTF8(Settings.Encoding, lText); { Load and insert annotations / notes } if not HelpFile.NotesLoaded then @@ -2709,6 +2780,7 @@ begin WindowPosition := wpUser; MinWidth := 430; MinHeight := 300; + DNDEnabled := True; OnCloseQuery := @MainFormCloseQuery; bvlStatusBar := TfpgBevel.Create(self); @@ -2783,8 +2855,11 @@ begin ScrollWheelDelta := 60; ShowImages := True; TabOrder := 0; + AcceptDrops := True; OnChange := @tvContentsChange; //OnDoubleClick := @tvContentsDoubleClick; + OnDragEnter := @tvContentsDragEntered; + OnDragDrop := @tvContentsDragDrop; end; btnGo := TfpgButton.Create(tsContents); @@ -3158,9 +3233,12 @@ begin SetPosition(77, 188, 244, 92); TabOrder := 2; Align := alClient; + AcceptDrops := True; OnOverLink := @RichViewOverLink; OnNotOverLink := @RichViewNotOverLink; OnClickLink := @RichViewClickLink; + OnDragEnter := @tvContentsDragEntered; + OnDragDrop := @RichViewDragDrop; end; MainMenu := TfpgMenuBar.Create(self); @@ -3239,7 +3317,7 @@ begin begin Name := 'miTools'; SetPosition(428, 96, 120, 20); - AddMenuItem('Show file info', '', @miDebugHeader); + AddMenuItem('Show file info', '', @miShowFileInfoClicked); AddMenuItem('Find topic by resource ID', '', @miToolsFindByResourceID); AddMenuItem('Find topic by resource name', '', @miToolsFindTopifByName); miDebugHexInfo := AddMenuItem('Toggle hex INF values in contents', '', @miDebugHex); @@ -3467,6 +3545,8 @@ begin Items.Add('UTF-8'); Items.Add('CP437'); Items.Add('CP850'); + Items.Add('CP866'); + Items.Add('CP1250'); Items.Add('IBM Graph (cp437)'); FocusItem := 0; TabOrder := 10; @@ -3840,6 +3920,7 @@ begin if not fpgFileExists( BookmarksFileName ) then Exit; + {$NOTE: Replace this with TStringList or TStringStream.} FileMode := fmInput; AssignFile( BookmarksFile, BookmarksFileName ); try diff --git a/examples/apps/debugserver/extrafpc.cfg b/examples/apps/debugserver/extrafpc.cfg index bf32f456..49dd2ec7 100644 --- a/examples/apps/debugserver/extrafpc.cfg +++ b/examples/apps/debugserver/extrafpc.cfg @@ -4,3 +4,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/apps/debugserver/fpgDebugServer.lpi b/examples/apps/debugserver/fpgDebugServer.lpi index f26f35ee..582e7494 100644 --- a/examples/apps/debugserver/fpgDebugServer.lpi +++ b/examples/apps/debugserver/fpgDebugServer.lpi @@ -38,7 +38,7 @@ <PackageName Value="fpgui_toolkit"/> </Item1> </RequiredPackages> - <Units Count="2"> + <Units Count="3"> <Unit0> <Filename Value="fpgDebugServer.lpr"/> <IsPartOfProject Value="True"/> @@ -49,6 +49,11 @@ <IsPartOfProject Value="True"/> <UnitName Value="frm_main"/> </Unit1> + <Unit2> + <Filename Value="fra_liveview.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="fra_liveview"/> + </Unit2> </Units> </ProjectOptions> <CompilerOptions> diff --git a/examples/apps/debugserver/fra_liveview.pas b/examples/apps/debugserver/fra_liveview.pas new file mode 100644 index 00000000..dd04e625 --- /dev/null +++ b/examples/apps/debugserver/fra_liveview.pas @@ -0,0 +1,66 @@ +unit fra_liveview; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_form, + fpg_panel, + fpg_grid; + +type + + TLiveViewFrame = class(TfpgFrame) + private + {@VFD_HEAD_BEGIN: fra_liveview} + Grid1: TfpgStringGrid; + {@VFD_HEAD_END: fra_liveview} + public + procedure AfterCreate; override; + property Grid: TfpgStringGrid read Grid1; + end; + +{@VFD_NEWFORM_DECL} + +implementation + +{@VFD_NEWFORM_IMPL} + +procedure TLiveViewFrame.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: fra_liveview} + Name := 'fra_liveview'; + SetPosition(359, 215, 442, 104); + WindowTitle := 'fra_liveview'; + Hint := ''; + + Grid1 := TfpgStringGrid.Create(self); + with Grid1 do + begin + Name := 'Grid1'; + SetPosition(0, 4, 444, 98); + Anchors := [anLeft,anRight,anTop,anBottom]; + BackgroundColor := TfpgColor($80000002); + AddColumn('Desc', 100, taLeftJustify); + AddColumn('Value', 310, taLeftJustify); + FontDesc := '#Grid'; + HeaderFontDesc := '#GridHeader'; + Hint := ''; + RowCount := 0; + RowSelect := False; + ShowHeader := False; + TabOrder := 1; + end; + + {@VFD_BODY_END: fra_liveview} + {%endregion} +end; + + +end. diff --git a/examples/apps/debugserver/frm_main.pas b/examples/apps/debugserver/frm_main.pas index 3e0fdd33..436a170c 100644 --- a/examples/apps/debugserver/frm_main.pas +++ b/examples/apps/debugserver/frm_main.pas @@ -79,8 +79,10 @@ uses ,fpg_menu ,fpg_basegrid ,fpg_grid + ,fpg_memo ,simpleipc - ,dbugmsg + ,fpg_dbugmsg + ,fra_liveview ; type @@ -98,6 +100,9 @@ type btnPause: TfpgButton; btnStart: TfpgButton; btnClear: TfpgButton; + btnExpandView: TfpgButton; + Bevel3: TfpgBevel; + btnLiveView: TfpgButton; {@VFD_HEAD_END: MainForm} miPause: TfpgMenuItem; FIPCSrv: TSimpleIPCServer; @@ -105,21 +110,31 @@ type FAddAtBottom: Boolean; FDiscarded: Integer; FShowOnMessage: Boolean; + FMemo: TfpgMemo; + FLiveViewFrame: TLiveViewFrame; procedure StartServer; procedure StopServer; procedure CheckMessages(Sender: TObject); procedure CheckDebugMessages; procedure ReadDebugMessage; procedure ShowDebugMessage(const AMsg: TDebugmessage); + procedure ShowLiveViewMessage(const AMsg: TDebugmessage); procedure ShowMessageWindow; procedure miPauseClicked(Sender: TObject); procedure miFileQuit(Sender: TObject); + procedure miEditCopy(Sender: TObject); + procedure btnExpandViewClicked(Sender: TObject); procedure miHelpAboutFPGui(Sender: TObject); procedure miHelpProductInformation(Sender: TObject); procedure btnClearClicked(Sender: TObject); procedure btnPauseClicked(Sender: TObject); procedure btnStartClicked(Sender: TObject); + procedure btnLiveViewClicked(Sender: TObject); procedure GridDrawCell(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); + procedure GridRowChanged(Sender: TObject; ARow: Integer); + procedure GridClicked(Sender: TObject); + procedure CreateLiveViewFrame; + procedure DestroyLiveViewFrame; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -133,6 +148,8 @@ implementation uses dateutils ,fpg_dialogs + ,fpg_constants + ,fpg_dbugintf ; @@ -171,12 +188,13 @@ begin ADefaultDrawing := False; try i := StrToInt(grdMessages.Cells[ACol, ARow]); + { TODO: This needs improving. We need to somehow referce TDebugLevel instead } case i of - -1: img := fpgImages.GetImage('dbs.state.stop'); - 0: img := fpgImages.GetImage('dbs.state.info'); - 1: img := fpgImages.GetImage('dbs.state.warning'); - 2: img := fpgImages.GetImage('dbs.state.error'); - 3: img := fpgImages.GetImage('dbs.state.identify'); + 0: img := fpgImages.GetImage('dbs.state.stop'); + 1: img := fpgImages.GetImage('dbs.state.info'); + 2: img := fpgImages.GetImage('dbs.state.warning'); + 3: img := fpgImages.GetImage('dbs.state.error'); + 4: img := fpgImages.GetImage('dbs.state.identify'); end; dx := (grdMessages.ColumnWidth[ACol] - 16) div 2; grdMessages.Canvas.DrawImage(ARect.Left + dx, ARect.Top {+ y}, img); @@ -189,6 +207,47 @@ begin end; end; +procedure TMainForm.GridRowChanged(Sender: TObject; ARow: Integer); +begin + if not btnExpandView.Down then + Exit; + FMemo.Text := grdMessages.Cells[2, ARow]; +// FMemo.Text := grdMessages.Cells[2, grdMessages.FocusRow]; +end; + +procedure TMainForm.GridClicked(Sender: TObject); +begin + if not btnExpandView.Down then + Exit; + if (grdMessages.RowCount > 0) and (grdMessages.FocusRow <> -1) then + FMemo.Text := grdMessages.Cells[2, grdMessages.FocusRow]; +end; + +procedure TMainForm.CreateLiveViewFrame; +begin + if Assigned(FLiveViewFrame) then + FLiveViewFrame.Free; + FLiveViewFrame := TLiveViewFrame.Create(self); + grdMessages.Height := grdMessages.Height - FLiveViewFrame.Height; + grdMessages.UpdateWindowPosition; + FLiveViewFrame.SetPosition(grdMessages.Left, grdMessages.Bottom+1, grdMessages.Width, FLiveViewFrame.Height); +end; + +procedure TMainForm.DestroyLiveViewFrame; +begin + grdMessages.Height := grdMessages.Height + FLiveViewFrame.Height; + FreeAndNil(FLiveViewFrame); + grdMessages.UpdateWindowPosition; +end; + +procedure TMainForm.btnLiveViewClicked(Sender: TObject); +begin + if btnLiveView.Down then + CreateLiveViewFrame + else + DestroyLiveViewFrame; +end; + procedure TMainForm.StartServer; begin FIPCSrv := TSimpleIPCServer.Create(nil); @@ -223,9 +282,14 @@ var Msg: TDebugMessage; begin FIPCSrv.MsgData.Seek(0, soFromBeginning); - ReadDebugMessageFromStream(FIPCSrv.MsgData, MSg); + ReadDebugMessageFromStream(FIPCSrv.MsgData, Msg); if not FPaused then - ShowDebugMessage(Msg) + begin + if Msg.MsgType = Ord(dlLive) then + ShowLiveViewMessage(Msg) + else + ShowDebugMessage(Msg); + end else Inc(FDiscarded); end; @@ -254,6 +318,36 @@ begin ShowMessageWindow; end; +procedure TMainForm.ShowLiveViewMessage(const AMsg: TDebugmessage); +var + r: integer; + lFound: Boolean; +begin + if not Assigned(FLiveViewFrame) then + Exit; + lFound := False; + FLiveViewFrame.Grid.BeginUpdate; + for r := 0 to FLiveViewFrame.Grid.RowCount-1 do + begin + if FLiveViewFrame.Grid.Cells[0, r] = AMsg.MsgTitle then + begin + lFound := True; + Break; + end; + end; + if lFound then + begin + FLiveViewFrame.Grid.Cells[1, r] := AMsg.Msg; + end + else + begin + FLiveViewFrame.Grid.RowCount := FLiveViewFrame.Grid.RowCount + 1; + FLiveViewFrame.Grid.Cells[0, FLiveViewFrame.Grid.RowCount-1] := AMsg.MsgTitle; + FLiveViewFrame.Grid.Cells[1, FLiveViewFrame.Grid.RowCount-1] := AMsg.Msg; + end; + FLiveViewFrame.Grid.EndUpdate; +end; + procedure TMainForm.ShowMessageWindow; begin if not Visible then @@ -271,6 +365,37 @@ begin Close; end; +procedure TMainForm.miEditCopy(Sender: TObject); +begin + if (grdMessages.RowCount > 0) and (grdMessages.FocusRow <> -1) then + fpgClipboard.Text := grdMessages.Cells[2, grdMessages.FocusRow]; +end; + +procedure TMainForm.btnExpandViewClicked(Sender: TObject); +const + cSpacing = 4; +begin + if btnExpandView.Down then + begin + FMemo := CreateMemo(self, grdMessages.Right + cSpacing, grdMessages.Top, 200, Height - grdMessages.Top - cSpacing); + FMemo.UpdateWindowPosition; + grdMessages.Anchors := grdMessages.Anchors - [anRight]; + Width := Width + FMemo.Width + (2 * cSpacing); + UpdateWindowPosition; + grdMessages.Anchors := grdMessages.Anchors + [anRight]; + GridClicked(nil); // update memo contents + end + else + begin + grdMessages.Anchors := grdMessages.Anchors - [anRight]; + Width := Width - FMemo.Width - (2 * cSpacing); + FMemo.Visible := False; + UpdateWindowPosition; + grdMessages.Anchors := grdMessages.Anchors + [anRight]; + FreeAndNil(FMemo); + end; +end; + procedure TMainForm.miHelpAboutFPGui(Sender: TObject); begin TfpgMessageDialog.AboutFPGui; @@ -293,6 +418,7 @@ begin fpgImages.AddMaskedBMP('dbs.stop', @DBS_stop, sizeof(DBS_stop), 0, 0); fpgImages.AddMaskedBMP('dbs.pause', @DBS_pause, sizeof(DBS_pause), 0, 0); fpgImages.AddMaskedBMP('dbs.run', @DBS_run, sizeof(DBS_run), 0, 0); + fpgImages.AddMaskedBMP('dbs.extended_view', @DBS_extended_view, sizeof(DBS_extended_view), 0, 0); fpgImages.AddMaskedBMP('dbs.state.info', @DBS_state_info, sizeof(DBS_state_info), 0, 0); fpgImages.AddMaskedBMP('dbs.state.warning', @DBS_state_warning, sizeof(DBS_state_warning), 0, 0); @@ -316,6 +442,7 @@ begin WindowTitle := 'fpGUI''s Debug Server'; Hint := ''; ShowHint := True; + WindowPosition := wpScreenCenter; MainMenu := TfpgMenuBar.Create(self); with MainMenu do @@ -332,8 +459,8 @@ begin SetPosition(0, 21, 486, 30); Anchors := [anLeft,anRight,anTop]; Hint := ''; - Style := bsLowered; Shape := bsBottomLine; + Style := bsLowered; end; grdMessages := TfpgStringGrid.Create(self); @@ -342,6 +469,7 @@ begin Name := 'grdMessages'; SetPosition(4, 55, 478, 254); Anchors := [anLeft,anRight,anTop,anBottom]; + BackgroundColor := TfpgColor($80000002); AddColumn('Type', 50, taLeftJustify); AddColumn('Time', 75, taCenter); AddColumn('Message', 330, taLeftJustify); @@ -354,6 +482,8 @@ begin TabOrder := 2; Options := [go_SmoothScroll]; OnDrawCell := @GridDrawCell; +// OnRowChange := @GridRowChanged; + OnClick := @GridClicked; end; mnuFile := TfpgPopupMenu.Create(self); @@ -371,9 +501,9 @@ begin begin Name := 'mnuEdit'; SetPosition(260, 126, 120, 24); - AddMenuItem('Cut', '', nil).Enabled := False; - AddMenuItem('Copy', '', nil).Enabled := False; - AddMenuItem('Paste', '', nil).Enabled := False; + // AddMenuItem('Cut', '', nil).Enabled := False; + AddMenuItem('Copy selected message to clipboard', rsKeyCtrl+'C', @miEditCopy); + // AddMenuItem('Paste', '', nil).Enabled := False; AddMenuItem('-', '', nil); AddMenuItem('Preferences...', '', nil).Enabled := False; end; @@ -410,8 +540,8 @@ begin Name := 'Bevel2'; SetPosition(34, 2, 8, 25); Hint := ''; - Style := bsLowered; Shape := bsLeftLine; + Style := bsLowered; end; btnPause := TfpgButton.Create(Bevel1); @@ -439,6 +569,7 @@ begin Name := 'btnStart'; SetPosition(67, 2, 24, 24); Text := ''; + Enabled := False; Flat := True; FontDesc := '#Label1'; Hint := 'start server'; @@ -448,7 +579,6 @@ begin TabOrder := 2; Focusable := False; OnClick := @btnStartClicked; - Enabled := False; end; btnClear := TfpgButton.Create(Bevel1); @@ -468,6 +598,52 @@ begin OnClick :=@btnClearClicked; end; + btnExpandView := TfpgButton.Create(Bevel1); + with btnExpandView do + begin + Name := 'btnExpandView'; + SetPosition(128, 2, 24, 24); + Text := ''; + AllowAllUp := True; + Flat := True; + FontDesc := '#Label1'; + GroupIndex := 2; + Hint := 'Toggle expanded view'; + ImageMargin := -1; + ImageName := 'dbs.extended_view'; + ImageSpacing := 0; + TabOrder := 6; + Focusable := False; + OnClick := @btnExpandViewClicked; + end; + + Bevel3 := TfpgBevel.Create(Bevel1); + with Bevel3 do + begin + Name := 'Bevel3'; + SetPosition(120, 2, 8, 24); + Hint := ''; + Shape := bsLeftLine; + Style := bsLowered; + end; + + btnLiveView := TfpgButton.Create(Bevel1); + with btnLiveView do + begin + Name := 'btnLiveView'; + SetPosition(156, 2, 24, 24); + Text := 'LV'; + AllowAllUp := True; + Flat := True; + FontDesc := '#Label1'; + GroupIndex := 3; + Hint := ''; + ImageName := ''; + TabOrder := 8; + Focusable := False; + OnClick := @btnLiveViewClicked; + end; + {@VFD_BODY_END: MainForm} {%endregion} diff --git a/examples/apps/debugserver/images.inc b/examples/apps/debugserver/images.inc index 166155c9..ce33402d 100644 --- a/examples/apps/debugserver/images.inc +++ b/examples/apps/debugserver/images.inc @@ -206,3 +206,57 @@ Const 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 255, 0,255,255, 0,255); + + +const + DBS_extended_view: array[0..821] of byte = ( + 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, + 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164, + 101, 52,164,101, 52,164,101, 52,164,101, 52,255, 0,255,255, 0,255, + 164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,164,101, 52,215,166,125,215,166,125,215, + 166,125,215,166,125,164,101, 52,255, 0,255,255, 0,255,164,101, 52, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,164,101, 52,215,166,125,215,166,125,215,166,125,215, + 166,125,164,101, 52,255, 0,255,255, 0,255,164,101, 52,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,164,101, 52,215,166,125,215,166,125,215,166,125,215,166,125,164, + 101, 52,255, 0,255,255, 0,255,164,101, 52,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,164,101, + 52,215,166,125,215,166,125,215,166,125,215,166,125,164,101, 52,255, + 0,255,255, 0,255,164,101, 52,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,164,101, 52,215,166, + 125,215,166,125,215,166,125,215,166,125,164,101, 52,255, 0,255,255, + 0,255,164,101, 52,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,164,101, 52,215,166,125,215,166, + 125,215,166,125,215,166,125,164,101, 52,255, 0,255,255, 0,255,164, + 101, 52,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,164,101, 52,215,166,125,215,166,125,215,166, + 125,215,166,125,164,101, 52,255, 0,255,255, 0,255,164,101, 52,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,164,101, 52,215,166,125,215,166,125,215,166,125,215,166, + 125,164,101, 52,255, 0,255,255, 0,255,164,101, 52,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 164,101, 52,215,166,125,215,166,125,215,166,125,215,166,125,164,101, + 52,255, 0,255,255, 0,255,164,101, 52,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,164,101, 52, + 215,166,125,215,166,125,215,166,125,215,166,125,164,101, 52,255, 0, + 255,255, 0,255,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164, + 101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52, + 164,101, 52,164,101, 52,164,101, 52,164,101, 52,255, 0,255,255, 0, + 255,164,101, 52,200,208,212,164,101, 52,164,101, 52,164,101, 52,164, + 101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,200,208,212, + 164,101, 52,200,208,212,164,101, 52,255, 0,255,255, 0,255,164,101, + 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164, + 101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52,164,101, 52, + 164,101, 52,164,101, 52,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255); + diff --git a/examples/apps/debugserver/images/extended_view.bmp b/examples/apps/debugserver/images/extended_view.bmp Binary files differnew file mode 100644 index 00000000..d137c6c4 --- /dev/null +++ b/examples/apps/debugserver/images/extended_view.bmp diff --git a/examples/apps/docedit/extrafpc.cfg b/examples/apps/docedit/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/apps/docedit/extrafpc.cfg +++ b/examples/apps/docedit/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/apps/globe/extrafpc.cfg b/examples/apps/globe/extrafpc.cfg index bf32f456..49dd2ec7 100644 --- a/examples/apps/globe/extrafpc.cfg +++ b/examples/apps/globe/extrafpc.cfg @@ -4,3 +4,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/apps/globe/frm_main.pas b/examples/apps/globe/frm_main.pas index 76775a4b..ef80f2f7 100644 --- a/examples/apps/globe/frm_main.pas +++ b/examples/apps/globe/frm_main.pas @@ -579,7 +579,7 @@ procedure TGlobe.DrawGrid; var temp: integer; begin - Canvas.Color := TfpgColor($8080FF); // clGray; + Canvas.Color := TfpgColor($FF8080FF); // clGray; Canvas.SetLineStyle(0, lsDash); { Parallels } temp := Wfi; @@ -672,12 +672,8 @@ end; procedure TGlobe.HandlePaint; begin - Canvas.BeginDraw; Canvas.Clear(clWindowBackground); -// R := Width div 2; - // inherited HandlePaint; DrawGlobe; - Canvas.EndDraw; end; constructor TGlobe.Create(AOwner: TComponent); diff --git a/examples/apps/ide/src/extrafpc.cfg b/examples/apps/ide/src/extrafpc.cfg index 90e167a9..2132065d 100644 --- a/examples/apps/ide/src/extrafpc.cfg +++ b/examples/apps/ide/src/extrafpc.cfg @@ -4,3 +4,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/apps/ide/src/fpg_textedit.pas b/examples/apps/ide/src/fpg_textedit.pas index 013ad86b..3e88f3d1 100644 --- a/examples/apps/ide/src/fpg_textedit.pas +++ b/examples/apps/ide/src/fpg_textedit.pas @@ -2412,7 +2412,7 @@ begin BuffList[I] := SLine; end; end; - BuffList.SaveToFile(AFileName); + BuffList.SaveToFile(fpgToOSEncoding(AFileName)); finally BuffList.Free; end; @@ -2423,7 +2423,7 @@ begin if not fpgFileExists(AFileName) then Exit; //==> Clear; - FLines.LoadFromFile(AFileName); + FLines.LoadFromFile(fpgToOSEncoding(AFileName)); HandleResize(Width, Height); Invalidate; end; diff --git a/examples/apps/ide/src/frm_main.pas b/examples/apps/ide/src/frm_main.pas index 6ef73f50..fe903c31 100644 --- a/examples/apps/ide/src/frm_main.pas +++ b/examples/apps/ide/src/frm_main.pas @@ -168,7 +168,7 @@ uses ,UnitList ,BuilderThread {$IFDEF DEBUGSVR} - ,dbugintf + ,fpg_dbugintf {$ENDIF} ,ideutils ; @@ -856,7 +856,7 @@ const + '|xor|repeat|until|constref|stdcall|cdecl|external|generic|specialize)\b'; cComments1 = '(\s*\/\/.*$)|(\{[^\{]*\})'; - cComments2 = '\{[^\{]*\}'; + cComments2 = '\{[^\$][^\{]*\}'; cDefines1 = '\{\$[^\{]*\}'; @@ -892,6 +892,7 @@ begin if not Assigned(FKeywordFont) then FKeywordFont := fpgGetFont(edt.FontDesc + ':bold'); ACanvas.Font := FKeywordFont; + ACanvas.Color := clWhite; FRegex.Expression := cKeywords1; FRegex.ModifierI := True; if FRegex.Exec(ALineText) then @@ -912,6 +913,7 @@ begin { syntax highlighting for: cDecimal } ACanvas.TextColor := clNavy; + ACanvas.Color := clWhite; FRegex.Expression := cDecimal; if FRegex.Exec(ALineText) then begin @@ -929,6 +931,7 @@ begin { syntax highlighting for: cHexadecimal } ACanvas.TextColor := clMagenta; + ACanvas.Color := clWhite; FRegex.Expression := cHexadecimal; if FRegex.Exec(ALineText) then begin @@ -946,6 +949,7 @@ begin { syntax highlighting for: comments2 } ACanvas.TextColor := clDarkCyan; + ACanvas.Color := clWhite; FRegex.Expression := cComments2; if FRegex.Exec(ALineText) then begin @@ -963,6 +967,7 @@ begin { syntax highlighting for: cDefines1 } ACanvas.TextColor := clRed; + ACanvas.Color := clWhite; FRegex.Expression := cDefines1; if FRegex.Exec(ALineText) then begin @@ -980,6 +985,7 @@ begin { syntax highlighting for: cString1 } ACanvas.TextColor := clOlive; + ACanvas.Color := clWhite; FRegex.Expression := cString1; if FRegex.Exec(ALineText) then begin @@ -997,6 +1003,7 @@ begin { syntax highlighting for: comments1 } ACanvas.TextColor := clDarkCyan; + ACanvas.Color := clWhite; FRegex.Expression := cComments1; if FRegex.Exec(ALineText) then begin diff --git a/examples/apps/ide/src/maximus.lpi b/examples/apps/ide/src/maximus.lpi index 5d3e289a..accb3570 100644 --- a/examples/apps/ide/src/maximus.lpi +++ b/examples/apps/ide/src/maximus.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> diff --git a/examples/apps/ide/src/maximus.lpr b/examples/apps/ide/src/maximus.lpr index 1f758a43..cf9c439f 100644 --- a/examples/apps/ide/src/maximus.lpr +++ b/examples/apps/ide/src/maximus.lpr @@ -22,10 +22,29 @@ uses {$IFDEF UNIX} cthreads, {$ENDIF} - Classes, fpg_base, fpg_main, frm_main, frm_configureide, ideconst, idemacros, - frm_debug, project, unitlist, frm_projectoptions, ideutils, builderthread, - ideimages, stringhelpers, frm_procedurelist, mPasLex, filemonitor, SynRegExpr, - fpg_textedit, frm_find, Sha1; + Classes, + fpg_base, + fpg_main, + fpg_cmdlineparams, + frm_main, + frm_configureide, + ideconst, + idemacros, + frm_debug, + project, + unitlist, + frm_projectoptions, + ideutils, + builderthread, + ideimages, + stringhelpers, + frm_procedurelist, + mPasLex, + filemonitor, + SynRegExpr, + fpg_textedit, + frm_find, + Sha1; procedure MainProc; diff --git a/examples/apps/nanoedit/extrafpc.cfg b/examples/apps/nanoedit/extrafpc.cfg index 97a53282..8fdb5d9b 100644 --- a/examples/apps/nanoedit/extrafpc.cfg +++ b/examples/apps/nanoedit/extrafpc.cfg @@ -4,3 +4,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/apps/nanoedit/mainfrm.pas b/examples/apps/nanoedit/mainfrm.pas index 5cece909..f652e179 100644 --- a/examples/apps/nanoedit/mainfrm.pas +++ b/examples/apps/nanoedit/mainfrm.pas @@ -40,6 +40,7 @@ type procedure miPasteClicked(Sender: TObject); procedure btnGOClick(Sender: TObject); procedure memEditorChanged(Sender: TObject); + procedure UpdateStatus(const AMessage: TfpgString); public procedure AfterCreate; override; end; @@ -67,7 +68,7 @@ begin s := StringReplace(s, 'file://', '', []); memEditor.LoadFromFile(s); FFilename := s; - lblStatusText.Text := FFilename; + UpdateStatus(FFilename); end; end; @@ -79,8 +80,9 @@ begin try if dlg.RunOpenFile then begin - memEditor.Lines.LoadFromFile(dlg.FileName); + memEditor.LoadFromFile(dlg.FileName); FFileName := dlg.FileName; + UpdateStatus(FFileName); end; finally dlg.Free; @@ -97,7 +99,8 @@ begin dlg.FileName := FFilename; if dlg.RunSaveFile then begin - memEditor.Lines.SaveToFile(dlg.FileName); + memEditor.SaveToFile(dlg.FileName); + UpdateStatus(Format('<%s> successfully saved.', [FFileName])); end; finally dlg.Free; @@ -116,7 +119,7 @@ begin begin memEditor.Lines.SaveToFile(dlg.FileName); FFilename := dlg.FileName; - lblStatusText.Text := FFilename; + UpdateStatus(Format('<%s> successfully saved.', [FFileName])); end; finally dlg.Free; @@ -223,6 +226,11 @@ begin } end; +procedure TMainForm.UpdateStatus(const AMessage: TfpgString); +begin + lblStatusText.Text := AMessage; +end; + procedure TMainForm.AfterCreate; begin {@VFD_BODY_BEGIN: MainFrom} diff --git a/examples/corelib/aggcanvas/agg_canvas_test.lpr b/examples/corelib/aggcanvas/agg_canvas_test.lpr index 63ba1d53..3b3a75ef 100644 --- a/examples/corelib/aggcanvas/agg_canvas_test.lpr +++ b/examples/corelib/aggcanvas/agg_canvas_test.lpr @@ -202,6 +202,10 @@ begin Canvas.SetLineStyle(1, lsSolid); Canvas.FillRectangle(r); + // Draw filled triangle + Canvas.Color := clOrange; + Canvas.FillTriangle(200, 150, 175, 175, 275, 175); + // Testing line drawing ac.NoFill; Canvas.SetColor(clBlue); @@ -262,7 +266,7 @@ begin Canvas.DrawString(45, y, 'DrawControlFrame():'); y := y + Canvas.Font.Height; - Canvas.DrawControlFrame(5, y, 150, 23); + fpgStyle.DrawControlFrame(Canvas, 5, y, 150, 23); // A Vector Text example //---------------------- diff --git a/examples/corelib/aggcanvas/extrafpc.cfg b/examples/corelib/aggcanvas/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/corelib/aggcanvas/extrafpc.cfg +++ b/examples/corelib/aggcanvas/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/corelib/canvastest/extrafpc.cfg b/examples/corelib/canvastest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/corelib/canvastest/extrafpc.cfg +++ b/examples/corelib/canvastest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/corelib/eventtest/extrafpc.cfg b/examples/corelib/eventtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/corelib/eventtest/extrafpc.cfg +++ b/examples/corelib/eventtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/corelib/helloworld/extrafpc.cfg b/examples/corelib/helloworld/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/corelib/helloworld/extrafpc.cfg +++ b/examples/corelib/helloworld/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/alignment/aligntest.lpi b/examples/gui/alignment/aligntest.lpi index 586b7b90..2062f69a 100644 --- a/examples/gui/alignment/aligntest.lpi +++ b/examples/gui/alignment/aligntest.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,13 +40,21 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="aligntest"/> + </Target> <SearchPaths> - <IncludeFiles Value="../src/"/> - <OtherUnitFiles Value="../src/"/> + <IncludeFiles Value="../src"/> + <OtherUnitFiles Value="../src"/> + <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/alignment/extrafpc.cfg b/examples/gui/alignment/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/alignment/extrafpc.cfg +++ b/examples/gui/alignment/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/alignment_resize/alignment_resize.lpi b/examples/gui/alignment_resize/alignment_resize.lpi index e22fcc29..4bf13dfd 100644 --- a/examples/gui/alignment_resize/alignment_resize.lpi +++ b/examples/gui/alignment_resize/alignment_resize.lpi @@ -1,21 +1,22 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> <Title Value="alignment_resize"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -43,9 +44,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="alignment_resize"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/alignment_resize/extrafpc.cfg b/examples/gui/alignment_resize/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/alignment_resize/extrafpc.cfg +++ b/examples/gui/alignment_resize/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/animation/anim_test.lpi b/examples/gui/animation/anim_test.lpi index 16a03599..4db5823a 100644 --- a/examples/gui/animation/anim_test.lpi +++ b/examples/gui/animation/anim_test.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=".elf"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -40,9 +42,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="anim_test"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/animation/extrafpc.cfg b/examples/gui/animation/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/animation/extrafpc.cfg +++ b/examples/gui/animation/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/bevel/beveltest.lpi b/examples/gui/bevel/beveltest.lpi index 2486d074..36486204 100644 --- a/examples/gui/bevel/beveltest.lpi +++ b/examples/gui/bevel/beveltest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,9 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="beveltest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/bevel/extrafpc.cfg b/examples/gui/bevel/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/bevel/extrafpc.cfg +++ b/examples/gui/bevel/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/calendar/calendartest.lpi b/examples/gui/calendar/calendartest.lpi index 20afc9c1..ccc474ab 100644 --- a/examples/gui/calendar/calendartest.lpi +++ b/examples/gui/calendar/calendartest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,14 +41,20 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="calendartest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/calendar/extrafpc.cfg b/examples/gui/calendar/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/calendar/extrafpc.cfg +++ b/examples/gui/calendar/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/colorlistbox/colorlistboxtest.lpi b/examples/gui/colorlistbox/colorlistboxtest.lpi index b74ec22a..04703732 100644 --- a/examples/gui/colorlistbox/colorlistboxtest.lpi +++ b/examples/gui/colorlistbox/colorlistboxtest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,12 +9,14 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <Title Value="colorlistboxtest"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -46,12 +48,22 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="colorlistboxtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Linking> <LinkSmart Value="True"/> </Linking> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/colorlistbox/extrafpc.cfg b/examples/gui/colorlistbox/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/colorlistbox/extrafpc.cfg +++ b/examples/gui/colorlistbox/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/colorwheel/colorwheel_test.lpi b/examples/gui/colorwheel/colorwheel_test.lpi index 41da8416..3ad6b196 100644 --- a/examples/gui/colorwheel/colorwheel_test.lpi +++ b/examples/gui/colorwheel/colorwheel_test.lpi @@ -1,20 +1,22 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <Title Value="colorwheel_test"/> <UseAppBundle Value="False"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -46,19 +48,23 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="colorwheel_test"/> + </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)/"/> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units"/> </SearchPaths> <Parsing> <SyntaxOptions> <CStyleOperator Value="False"/> <AllowLabel Value="False"/> <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/colorwheel/extrafpc.cfg b/examples/gui/colorwheel/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/colorwheel/extrafpc.cfg +++ b/examples/gui/colorwheel/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/colorwheel/frm_main.pas b/examples/gui/colorwheel/frm_main.pas index 63518360..3633b740 100644 --- a/examples/gui/colorwheel/frm_main.pas +++ b/examples/gui/colorwheel/frm_main.pas @@ -67,14 +67,14 @@ end; procedure TMainForm.RGBChanged(Sender: TObject); var - rgb: TFPColor; + rgb: TRGBTriple; c: TfpgColor; begin FViaRGB := True; // revent recursive updates rgb.Red := StrToInt(edR.Text); rgb.Green := StrToInt(edG.Text); rgb.Blue := StrToInt(edB.Text); - c := FPColorTofpgColor(rgb); + c := RGBTripleTofpgColor(rgb); ColorWheel1.SetSelectedColor(c); // This will trigger ColorWheel and ValueBar OnChange event FViaRGB := False; end; @@ -122,11 +122,11 @@ end; procedure TMainForm.UpdateRGBComponents; var - rgb: TFPColor; + rgb: TRGBTriple; c: TfpgColor; begin c := ValueBar1.SelectedColor; - rgb := fpgColorToFPColor(c); + rgb := fpgColorToRGBTriple(c); edR.Text := IntToStr(rgb.Red); edG.Text := IntToStr(rgb.Green); edB.Text := IntToStr(rgb.Blue); diff --git a/examples/gui/combobox/comboboxtest.lpi b/examples/gui/combobox/comboboxtest.lpi index 41f6ae73..2163619a 100644 --- a/examples/gui/combobox/comboboxtest.lpi +++ b/examples/gui/combobox/comboboxtest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -50,13 +52,20 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="comboboxtest"/> + </Target> <SearchPaths> - <OtherUnitFiles Value="../common/"/> + <OtherUnitFiles Value="../common"/> + <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/combobox/extrafpc.cfg b/examples/gui/combobox/extrafpc.cfg index 07f6831a..89eafa99 100644 --- a/examples/gui/combobox/extrafpc.cfg +++ b/examples/gui/combobox/extrafpc.cfg @@ -4,3 +4,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/combobox/frm_main.pas b/examples/gui/combobox/frm_main.pas index e1a293df..6471963d 100644 --- a/examples/gui/combobox/frm_main.pas +++ b/examples/gui/combobox/frm_main.pas @@ -5,12 +5,18 @@ unit frm_main; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_basegrid, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge, fpg_editcombo; + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_form, + fpg_label, + fpg_button, + fpg_combobox, + fpg_checkbox, + fpg_radiobutton, + fpg_panel, + fpg_editcombo; type diff --git a/examples/gui/command_interface/extrafpc.cfg b/examples/gui/command_interface/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/command_interface/extrafpc.cfg +++ b/examples/gui/command_interface/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/command_interface/test.lpi b/examples/gui/command_interface/test.lpi index da19eca5..cf714b52 100644 --- a/examples/gui/command_interface/test.lpi +++ b/examples/gui/command_interface/test.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -50,7 +51,18 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="command_interface_test"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/examples/gui/customstyles/customstyles.lpi b/examples/gui/customstyles/customstyles.lpi index b2996aeb..36fef016 100644 --- a/examples/gui/customstyles/customstyles.lpi +++ b/examples/gui/customstyles/customstyles.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -52,7 +52,13 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="customstyles_test"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <CStyleOperator Value="False"/> @@ -73,7 +79,6 @@ <CompilerMessages> <UseMsgFile Value="True"/> </CompilerMessages> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/customstyles/customstyles.lpr b/examples/gui/customstyles/customstyles.lpr index 419e6456..16b00ac8 100644 --- a/examples/gui/customstyles/customstyles.lpr +++ b/examples/gui/customstyles/customstyles.lpr @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -25,7 +25,6 @@ quotes. } - program customstyles; {$mode objfpc}{$H+} diff --git a/examples/gui/customstyles/extrafpc.cfg b/examples/gui/customstyles/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/customstyles/extrafpc.cfg +++ b/examples/gui/customstyles/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/customstyles/frm_test.pas b/examples/gui/customstyles/frm_test.pas index 6eb30b35..1cefa10a 100644 --- a/examples/gui/customstyles/frm_test.pas +++ b/examples/gui/customstyles/frm_test.pas @@ -1,3 +1,20 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Demo form showing some widgets in different states, and how the themes + paint them. +} unit frm_test; {$mode objfpc}{$H+} @@ -5,8 +22,16 @@ unit frm_test; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_widget, - fpg_form, fpg_edit, fpg_label, fpg_button, fpg_menu, + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_widget, + fpg_form, + fpg_edit, + fpg_label, + fpg_button, + fpg_menu, fpg_memo; type @@ -33,6 +58,7 @@ type Label1: TfpgLabel; {@VFD_HEAD_END: TestForm} procedure CloseClicked(Sender: TObject); + procedure HelpAboutClicked(Sender: TObject); public procedure AfterCreate; override; end; @@ -42,7 +68,8 @@ type implementation uses - fpg_stylemanager; + fpg_stylemanager, + fpg_dialogs; {@VFD_NEWFORM_IMPL} @@ -51,6 +78,11 @@ begin Close; end; +procedure TTestForm.HelpAboutClicked(Sender: TObject); +begin + TfpgMessageDialog.AboutFPGui(''); +end; + procedure TTestForm.AfterCreate; var miSubMenu: TfpgMenuItem; @@ -198,7 +230,7 @@ begin AddMenuItem('-', '', nil); AddMenuItem('Save && Reload', '', nil); AddMenuItem('-', '', nil); - AddMenuItem('&Quit', 'Ctrl+Q', nil); + AddMenuItem('&Quit', 'Ctrl+Q', @CloseClicked); end; pmEdit := TfpgPopupMenu.Create(self); @@ -219,7 +251,7 @@ begin begin Name := 'pmHelp'; SetPosition(204, 196, 120, 24); - AddMenuItem('About...', '', nil); + AddMenuItem('About...', '', @HelpAboutClicked); end; pmSubMenu1 := TfpgPopupMenu.Create(self); diff --git a/examples/gui/customstyles/mystyle.pas b/examples/gui/customstyles/mystyle.pas index 665a22b0..8ca00d33 100644 --- a/examples/gui/customstyles/mystyle.pas +++ b/examples/gui/customstyles/mystyle.pas @@ -1,4 +1,4 @@ -{ +(* A very quick and basic style implementation. It took all of 10 minutes. To apply this style, follow these instructions: @@ -31,7 +31,7 @@ end; end; -} +*) unit mystyle; {$mode objfpc}{$H+} diff --git a/examples/gui/dbtest/dbtest.lpi b/examples/gui/dbtest/dbtest.lpi index a7c9efb9..b9934e9e 100644 --- a/examples/gui/dbtest/dbtest.lpi +++ b/examples/gui/dbtest/dbtest.lpi @@ -1,22 +1,23 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> <MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -47,16 +48,21 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="dbtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <AllowLabel Value="False"/> <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/dbtest/extrafpc.cfg b/examples/gui/dbtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/dbtest/extrafpc.cfg +++ b/examples/gui/dbtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/drag_n_drop/dndexample.lpi b/examples/gui/drag_n_drop/dndexample.lpi index 758b5887..8c0df33d 100644 --- a/examples/gui/drag_n_drop/dndexample.lpi +++ b/examples/gui/drag_n_drop/dndexample.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -46,7 +46,7 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <Target> <Filename Value="dndexample"/> </Target> diff --git a/examples/gui/drag_n_drop/dndexample.lpr b/examples/gui/drag_n_drop/dndexample.lpr index 13dda563..c95b97d0 100644 --- a/examples/gui/drag_n_drop/dndexample.lpr +++ b/examples/gui/drag_n_drop/dndexample.lpr @@ -81,7 +81,6 @@ procedure TMainForm.Bevel1DragEnter(Sender, Source: TObject; AMimeList: TStringList; var AMimeChoice: TfpgString; var ADropAction: TfpgDropAction; var Accept: Boolean); var - i: integer; s: string; begin { the mime type we want to accept } @@ -108,7 +107,6 @@ procedure TMainForm.PanelDragDrop(Sender, Source: TObject; X, Y: integer; AData: Variant); var s: string; - v: variant; begin s := AData; Bevel1.Text := Format('Drop event at (%d,%d) with value(s):'+LineEnding+'%s', [X, Y, s]); @@ -129,7 +127,6 @@ procedure TMainForm.LabelDragStartDetected(Sender: TObject); var m: TfpgMimeData; d: TfpgDrag; - v: variant; begin m := TfpgMimeData.Create; diff --git a/examples/gui/drag_n_drop/extrafpc.cfg b/examples/gui/drag_n_drop/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/drag_n_drop/extrafpc.cfg +++ b/examples/gui/drag_n_drop/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/edits/edittest.lpi b/examples/gui/edits/edittest.lpi index f10feccd..be69faf9 100644 --- a/examples/gui/edits/edittest.lpi +++ b/examples/gui/edits/edittest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -40,9 +42,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="edittest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/edits/extrafpc.cfg b/examples/gui/edits/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/edits/extrafpc.cfg +++ b/examples/gui/edits/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/embedded_form/demo1.lpi b/examples/gui/embedded_form/demo1.lpi index f6200396..de9bb9a3 100644 --- a/examples/gui/embedded_form/demo1.lpi +++ b/examples/gui/embedded_form/demo1.lpi @@ -1,19 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <UseAppBundle Value="False"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -50,12 +52,20 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="embedded_form_test"/> + </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir)/"/> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/embedded_form/extrafpc.cfg b/examples/gui/embedded_form/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/embedded_form/extrafpc.cfg +++ b/examples/gui/embedded_form/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/embedded_form/frm_main.pas b/examples/gui/embedded_form/frm_main.pas index 785247c9..e2fb0f0e 100644 --- a/examples/gui/embedded_form/frm_main.pas +++ b/examples/gui/embedded_form/frm_main.pas @@ -56,6 +56,7 @@ var var j: integer; begin + Result := ''; if indent = 0 then exit; for j := 1 to indent do diff --git a/examples/gui/filedialog/extrafpc.cfg b/examples/gui/filedialog/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/filedialog/extrafpc.cfg +++ b/examples/gui/filedialog/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/filedialog/filedialog.lpi b/examples/gui/filedialog/filedialog.lpi index 2291e3f1..872cf6e3 100644 --- a/examples/gui/filedialog/filedialog.lpi +++ b/examples/gui/filedialog/filedialog.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,10 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="filedialog"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/filedialog/filedialog.lpr b/examples/gui/filedialog/filedialog.lpr index e1dca3d7..315b7885 100644 --- a/examples/gui/filedialog/filedialog.lpr +++ b/examples/gui/filedialog/filedialog.lpr @@ -105,6 +105,7 @@ procedure TMainForm.btnUserInputClicked(Sender: TObject); var lAnswer: TfpgString; begin + lAnswer := ''; if fpgInputQuery('Caption here', 'And the prompt goes here', lAnswer) then ShowMessage(Format('User entered <%s>', [lAnswer])); end; diff --git a/examples/gui/filegrid/extrafpc.cfg b/examples/gui/filegrid/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/filegrid/extrafpc.cfg +++ b/examples/gui/filegrid/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/filegrid/filegrid.lpi b/examples/gui/filegrid/filegrid.lpi index 1fc73d24..74fb0d20 100644 --- a/examples/gui/filegrid/filegrid.lpi +++ b/examples/gui/filegrid/filegrid.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,10 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="filegrid"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/fontselect/extrafpc.cfg b/examples/gui/fontselect/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/fontselect/extrafpc.cfg +++ b/examples/gui/fontselect/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/fontselect/fontselect.lpi b/examples/gui/fontselect/fontselect.lpi index 74eb6b4d..a23797f7 100644 --- a/examples/gui/fontselect/fontselect.lpi +++ b/examples/gui/fontselect/fontselect.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,10 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="fontselect"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/gauges/extrafpc.cfg b/examples/gui/gauges/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/gauges/extrafpc.cfg +++ b/examples/gui/gauges/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/gauges/gaugetest.lpi b/examples/gui/gauges/gaugetest.lpi index 731e6f4d..899f99cd 100644 --- a/examples/gui/gauges/gaugetest.lpi +++ b/examples/gui/gauges/gaugetest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=".exe"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -38,16 +40,21 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="gaugetest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <AllowLabel Value="False"/> <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/gridediting/extrafpc.cfg b/examples/gui/gridediting/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/gridediting/extrafpc.cfg +++ b/examples/gui/gridediting/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/gridediting/gridediting.lpi b/examples/gui/gridediting/gridediting.lpi index 13caff41..dba84086 100644 --- a/examples/gui/gridediting/gridediting.lpi +++ b/examples/gui/gridediting/gridediting.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -16,6 +16,9 @@ <VersionInfo> <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -46,12 +49,18 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="gridediting"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Other> <CompilerMessages> <UseMsgFile Value="True"/> </CompilerMessages> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/gridtest/gridtest.lpi b/examples/gui/gridtest/gridtest.lpi index 8d6de301..a02b0697 100644 --- a/examples/gui/gridtest/gridtest.lpi +++ b/examples/gui/gridtest/gridtest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="8"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,15 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="gridtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr index 465281b2..173806e9 100644 --- a/examples/gui/gridtest/gridtest.lpr +++ b/examples/gui/gridtest/gridtest.lpr @@ -16,7 +16,8 @@ uses fpg_button, fpg_checkbox, fpg_tab, - fpg_edit; + fpg_edit, + fpg_dialogs; type @@ -42,6 +43,7 @@ type chkSmoothScroll: TfpgCheckBox; chkAlterColor: TfpgCheckBox; {@VFD_HEAD_END: MainForm} + procedure StringGridHeaderClicked(Sender: TObject; ACol: Integer); procedure StringGridDoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); procedure btnAddFiveClicked(Sender: TObject); procedure btnAddOneClicked(Sender: TObject); @@ -66,6 +68,11 @@ type { TMainForm } +procedure TMainForm.StringGridHeaderClicked(Sender: TObject; ACol: Integer); +begin + ShowMessage(Format('column %d clicked', [ACol])); +end; + procedure TMainForm.StringGridDoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); var @@ -92,7 +99,8 @@ end; procedure TMainForm.btnDelRowClicked(Sender: TObject); begin - stringgrid.DeleteRow(stringgrid.FocusRow); + if StringGrid.RowCount > 0 then + stringgrid.DeleteRow(stringgrid.FocusRow); end; procedure TMainForm.chkDisabledChange(Sender: TObject); @@ -219,6 +227,9 @@ begin AddColumn('Column 1', 100, taLeftJustify); AddColumn('Col 2', 50, taCenter); AddColumn('Numbers', 150, taRightJustify); + AddColumn('Column 4', 150, taRightJustify); + AddColumn('Column 5', 150, taRightJustify); + AddColumn('Column 6', 150, taRightJustify); FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; Hint := ''; @@ -244,6 +255,7 @@ begin // Add custom painting OnDrawCell := @StringGridDrawCell; OnDoubleClick := @StringGridDoubleClicked; + OnHeaderClick := @StringGridHeaderClicked; end; chkShowHeader := TfpgCheckBox.Create(self); diff --git a/examples/gui/hintwindow/extrafpc.cfg b/examples/gui/hintwindow/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/hintwindow/extrafpc.cfg +++ b/examples/gui/hintwindow/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/hintwindow/hintwindowtest.lpi b/examples/gui/hintwindow/hintwindowtest.lpi index eef2ca11..ecb49472 100644 --- a/examples/gui/hintwindow/hintwindowtest.lpi +++ b/examples/gui/hintwindow/hintwindowtest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,12 +9,14 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <Title Value="hintwindowtest"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,9 +42,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="hintwindowtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/imgtest/bitmaptest.lpi b/examples/gui/imgtest/bitmaptest.lpi index ec9a5f70..f10675d4 100644 --- a/examples/gui/imgtest/bitmaptest.lpi +++ b/examples/gui/imgtest/bitmaptest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,12 +9,14 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <Title Value="bitmaptest"/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,14 +42,21 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="bitmaptest"/> + </Target> <SearchPaths> - <IncludeFiles Value="../source/"/> - <OtherUnitFiles Value="../source/;../source/x11/;../gui/"/> + <IncludeFiles Value="../source"/> + <OtherUnitFiles Value="../source;../source/x11;../gui"/> + <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/imgtest/extrafpc.cfg b/examples/gui/imgtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/imgtest/extrafpc.cfg +++ b/examples/gui/imgtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/imgtest_jpeg/extrafpc.cfg b/examples/gui/imgtest_jpeg/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/imgtest_jpeg/extrafpc.cfg +++ b/examples/gui/imgtest_jpeg/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/imgtest_jpeg/jpeg.lpi b/examples/gui/imgtest_jpeg/jpeg.lpi index 6b0fc630..bd592bfe 100644 --- a/examples/gui/imgtest_jpeg/jpeg.lpi +++ b/examples/gui/imgtest_jpeg/jpeg.lpi @@ -1,25 +1,26 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> <MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasTitleStatement Value="False"/> - <UseDefaultCompilerOptions Value="True"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <UseAppBundle Value="False"/> <ResourceType Value="res"/> </General> <VersionInfo> <Language Value=""/> <CharSet Value=""/> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -50,15 +51,14 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="jpegtest"/> + </Target> <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="units"/> </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="True"/> - </SyntaxOptions> - </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/examples/gui/listbox/extrafpc.cfg b/examples/gui/listbox/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/listbox/extrafpc.cfg +++ b/examples/gui/listbox/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/listbox/frm_main.pas b/examples/gui/listbox/frm_main.pas index 1c858112..cacc604f 100644 --- a/examples/gui/listbox/frm_main.pas +++ b/examples/gui/listbox/frm_main.pas @@ -5,13 +5,15 @@ unit frm_main; interface uses - SysUtils, Classes, - fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_basegrid, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge; + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_form, + fpg_button, + fpg_listbox, + fpg_memo, + fpg_checkbox; type diff --git a/examples/gui/listbox/listboxtest.lpi b/examples/gui/listbox/listboxtest.lpi index e745c4da..17170ebf 100644 --- a/examples/gui/listbox/listboxtest.lpi +++ b/examples/gui/listbox/listboxtest.lpi @@ -1,19 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -45,9 +47,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="listboxtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/listviewtest/extrafpc.cfg b/examples/gui/listviewtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/listviewtest/extrafpc.cfg +++ b/examples/gui/listviewtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/listviewtest/listviewtest.lpi b/examples/gui/listviewtest/listviewtest.lpi index e8537f5b..50579565 100644 --- a/examples/gui/listviewtest/listviewtest.lpi +++ b/examples/gui/listviewtest/listviewtest.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -41,7 +41,13 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="listviewtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <UseAnsiStrings Value="False"/> diff --git a/examples/gui/memo/extrafpc.cfg b/examples/gui/memo/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/memo/extrafpc.cfg +++ b/examples/gui/memo/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/memo/memotest.lpi b/examples/gui/memo/memotest.lpi index 0102fcfc..12046720 100644 --- a/examples/gui/memo/memotest.lpi +++ b/examples/gui/memo/memotest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -40,10 +42,18 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="memotest"/> + </Target> <SearchPaths> <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/examples/gui/menutest/extrafpc.cfg b/examples/gui/menutest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/menutest/extrafpc.cfg +++ b/examples/gui/menutest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/menutest/menutest.lpi b/examples/gui/menutest/menutest.lpi index c3120df3..579cbc7c 100644 --- a/examples/gui/menutest/menutest.lpi +++ b/examples/gui/menutest/menutest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="8"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,7 +41,13 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="menutest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <UseAnsiStrings Value="False"/> @@ -47,7 +55,7 @@ </Parsing> <Linking> <Debugging> - <GenerateDebugInfo Value="True"/> + <DebugInfoType Value="dsStabs"/> </Debugging> <Options> <Win32> @@ -56,8 +64,6 @@ </Options> </Linking> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/modalforms/extrafpc.cfg b/examples/gui/modalforms/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/modalforms/extrafpc.cfg +++ b/examples/gui/modalforms/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/modalforms/modalforms.lpi b/examples/gui/modalforms/modalforms.lpi index 7f6f526a..cc8137c8 100644 --- a/examples/gui/modalforms/modalforms.lpi +++ b/examples/gui/modalforms/modalforms.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,9 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="modalformstests"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/mousecursor/cursordemo.lpi b/examples/gui/mousecursor/cursordemo.lpi index 7aea18fa..d3e71ef7 100644 --- a/examples/gui/mousecursor/cursordemo.lpi +++ b/examples/gui/mousecursor/cursordemo.lpi @@ -1,23 +1,25 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> </Flags> <SessionStorage Value="None"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> <Title Value="cursordemo"/> <UseAppBundle Value="False"/> <ResourceType Value="res"/> </General> <VersionInfo> - <ProjectVersion Value=""/> <Language Value=""/> <CharSet Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -44,15 +46,14 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="cursordemo"/> + </Target> <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="units"/> </SearchPaths> - <Parsing> - <SyntaxOptions> - <UseAnsiStrings Value="True"/> - </SyntaxOptions> - </Parsing> <Linking> <Options> <Win32> diff --git a/examples/gui/mousecursor/extrafpc.cfg b/examples/gui/mousecursor/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/mousecursor/extrafpc.cfg +++ b/examples/gui/mousecursor/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/panel/extrafpc.cfg b/examples/gui/panel/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/panel/extrafpc.cfg +++ b/examples/gui/panel/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/panel/panel_test.lpi b/examples/gui/panel/panel_test.lpi index 89378ec4..dc519cb0 100644 --- a/examples/gui/panel/panel_test.lpi +++ b/examples/gui/panel/panel_test.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -45,9 +46,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="panel_test"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/reporting/extrafpc.cfg b/examples/gui/reporting/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/reporting/extrafpc.cfg +++ b/examples/gui/reporting/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/reporting/pdf_demo.lpi b/examples/gui/reporting/pdf_demo.lpi index 57598cef..9af69bbd 100644 --- a/examples/gui/reporting/pdf_demo.lpi +++ b/examples/gui/reporting/pdf_demo.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> diff --git a/examples/gui/scrollframe/bigframe_test.lpi b/examples/gui/scrollframe/bigframe_test.lpi new file mode 100644 index 00000000..ee242841 --- /dev/null +++ b/examples/gui/scrollframe/bigframe_test.lpi @@ -0,0 +1,78 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="bigframe_test"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="bigframe_test.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="bigframe_test"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="bigframe_test"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gui/scrollframe/bigframe_test.lpr b/examples/gui/scrollframe/bigframe_test.lpr new file mode 100644 index 00000000..5309e965 --- /dev/null +++ b/examples/gui/scrollframe/bigframe_test.lpr @@ -0,0 +1,114 @@ +program bigframe_test; + +{$mode objfpc}{$H+} + +uses + Classes, + sysutils, + fpg_base, + fpg_main, + fpg_button, + fpg_label, + fpg_form, + fpg_panel, + fpg_scrollframe + ; + +procedure create_buttons (f : TfpgFrame); +var + i, j, ij : integer; + b : TfpgButton; +const + num_button_cols = 4; + num_button_rows = 5; +begin + with f do begin + for i := 0 to num_button_cols-1 do + begin + for j := 0 to num_button_rows-1 do + begin + if (j>4) and (j<16) then continue; + ij := j + num_button_rows*i; + b := TfpgButton.Create(f); + with b do begin + if (i=2) and (j=2) + then SetPosition(6000, 6000, 100, 25) + else SetPosition(20+i*105, 50+j*30, 100, 25); + name := 'button' + inttostr(ij); + Text := 'Button ' + inttostr(ij+1); + FontDesc := '#Label1'; + end; + end; + end; + end; +end; + +type + + { t_sample_frame } + + t_sample_frame = class (TfpgAutoSizingFrame) + protected + my_color : TfpgColor; + embed_button : TfpgButton; + procedure click_embed_button (Sender: TObject); + procedure paint_my_stuff (Sender: TObject); + public + procedure AfterCreate; override; + end; + +procedure t_sample_frame.click_embed_button(Sender: TObject); +var + inner_bevel : TfpgBevel; + inner_frame : TfpgScrollFrame; +begin + embed_button.Visible:=false; + inner_bevel := TfpgBevel.Create(self); + with inner_bevel do begin; + SetPosition(90, 210, 300, 300); + BorderStyle := bsDouble; + Shape := bsFrame; + UpdateWindowPosition; + end; + RecalcFrameSize; + + inner_frame := TfpgScrollFrame.Create(inner_bevel, t_sample_frame); + inner_frame.Align:=alClient; +end; + +procedure t_sample_frame.paint_my_stuff (Sender: TObject); +begin + canvas.Color := my_color; + canvas.FillRectangle (30, 30, 200, 400); +end; + +procedure t_sample_frame.AfterCreate; +begin + inherited AfterCreate; + MarginBR:=7; + my_color:=TfpgColor(random(high(longint))); + embed_button := CreateButton (self, 20, 240, 270, + 'Click to embed another Scroll-Frame here', @click_embed_button); + OnPaint:=@paint_my_stuff; + create_buttons(self); +end; + + +var + form: TfpgForm; + outer_frame: TfpgScrollFrame; + +begin + fpgApplication.Initialize; + form := TfpgForm.Create(nil); + form.SetPosition(0,0,380,360); + outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); + outer_frame.Align:=alClient; + try + form.Show; + fpgApplication.Run; + finally + form.Free; + end; +end. + diff --git a/examples/gui/scrollframe/frame_test.lpi b/examples/gui/scrollframe/frame_test.lpi new file mode 100644 index 00000000..ab3bd77f --- /dev/null +++ b/examples/gui/scrollframe/frame_test.lpi @@ -0,0 +1,78 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="frame_test"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="frame_test.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frame_test"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="frame_test"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr new file mode 100644 index 00000000..252f8a07 --- /dev/null +++ b/examples/gui/scrollframe/frame_test.lpr @@ -0,0 +1,112 @@ +program frame_test; + +{$mode objfpc}{$H+} + +uses + Classes, + sysutils, + fpg_base, + fpg_main, + fpg_button, + fpg_label, + fpg_form, + fpg_panel, + fpg_scrollframe + ; + +procedure create_buttons (f : TfpgFrame); +var + i, j, ij : integer; + b : TfpgButton; +const + num_button_cols = 4; + num_button_rows = 5; +begin + with f do begin + for i := 0 to num_button_cols-1 do + begin + for j := 0 to num_button_rows-1 do + begin + if (j>4) and (j<16) then continue; + ij := j + num_button_rows*i; + b := TfpgButton.Create(f); + with b do begin + SetPosition(20+i*105, 50+j*30, 100, 25); + name := 'button' + inttostr(ij); + Text := 'Button ' + inttostr(ij+1); + FontDesc := '#Label1'; + end; + end; + end; + end; +end; + +type + + { t_sample_frame } + + t_sample_frame = class (TfpgAutoSizingFrame) + protected + my_color : TfpgColor; + embed_button : TfpgButton; + procedure click_embed_button (Sender: TObject); + procedure paint_my_stuff (Sender: TObject); + public + procedure AfterCreate; override; + end; + +procedure t_sample_frame.click_embed_button(Sender: TObject); +var + inner_bevel : TfpgBevel; + inner_frame : TfpgScrollFrame; +begin + embed_button.Visible:=false; + inner_bevel := TfpgBevel.Create(self); + with inner_bevel do begin; + SetPosition(90, 210, 300, 300); + BorderStyle := bsDouble; + Shape := bsFrame; + UpdateWindowPosition; + end; + RecalcFrameSize; + + inner_frame := TfpgScrollFrame.Create(inner_bevel, t_sample_frame); + inner_frame.Align:=alClient; +end; + +procedure t_sample_frame.paint_my_stuff (Sender: TObject); +begin + canvas.Color := my_color; + canvas.FillRectangle (30, 30, 200, 400); +end; + +procedure t_sample_frame.AfterCreate; +begin + inherited AfterCreate; + MarginBR:=7; + my_color:=TfpgColor(random(high(longint))); + embed_button := CreateButton (self, 20, 240, 270, + 'Click to embed another Scroll-Frame here', @click_embed_button); + OnPaint:=@paint_my_stuff; + create_buttons(self); +end; + + +var + form: TfpgForm; + outer_frame: TfpgScrollFrame; + +begin + fpgApplication.Initialize; + form := TfpgForm.Create(nil); + form.SetPosition(0,0,380,360); + outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); + outer_frame.Align:=alClient; + try + form.Show; + fpgApplication.Run; + finally + form.Free; + end; +end. + diff --git a/examples/gui/splashscreen/extrafpc.cfg b/examples/gui/splashscreen/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/splashscreen/extrafpc.cfg +++ b/examples/gui/splashscreen/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/splashscreen/frm_main.pas b/examples/gui/splashscreen/frm_main.pas index 7ecf663c..61155fae 100644 --- a/examples/gui/splashscreen/frm_main.pas +++ b/examples/gui/splashscreen/frm_main.pas @@ -49,7 +49,6 @@ type implementation uses - fpg_command_intf, commands; {@VFD_NEWFORM_IMPL} diff --git a/examples/gui/splashscreen/test.lpi b/examples/gui/splashscreen/test.lpi index fa0ecd6b..bd28075e 100644 --- a/examples/gui/splashscreen/test.lpi +++ b/examples/gui/splashscreen/test.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -54,9 +56,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="splashscreen"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/splitter/extrafpc.cfg b/examples/gui/splitter/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/splitter/extrafpc.cfg +++ b/examples/gui/splitter/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/splitter/splitter_test.lpi b/examples/gui/splitter/splitter_test.lpi index 431f5ffe..6f2b669f 100644 --- a/examples/gui/splitter/splitter_test.lpi +++ b/examples/gui/splitter/splitter_test.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=".exe"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,7 +41,18 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="splitter_test"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <CodeGeneration> <SmartLinkUnit Value="True"/> <Checks> @@ -57,8 +69,6 @@ <LinkSmart Value="True"/> </Linking> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/sprites/extrafpc.cfg b/examples/gui/sprites/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/sprites/extrafpc.cfg +++ b/examples/gui/sprites/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/sprites/spritedemo.lpi b/examples/gui/sprites/spritedemo.lpi index d5109e71..6b393910 100644 --- a/examples/gui/sprites/spritedemo.lpi +++ b/examples/gui/sprites/spritedemo.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -41,9 +42,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="spritedemo"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/stdimages/extrafpc.cfg b/examples/gui/stdimages/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/stdimages/extrafpc.cfg +++ b/examples/gui/stdimages/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/stdimages/stdimglist.lpi b/examples/gui/stdimages/stdimglist.lpi index f519fc99..e9d1ba25 100644 --- a/examples/gui/stdimages/stdimglist.lpi +++ b/examples/gui/stdimages/stdimglist.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -41,13 +41,18 @@ </ProjectOptions> <CompilerOptions> <Version Value="11"/> + <Target> + <Filename Value="stdimglist"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <Other> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/tabtest/extrafpc.cfg b/examples/gui/tabtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/tabtest/extrafpc.cfg +++ b/examples/gui/tabtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/tabtest/tabtest.lpi b/examples/gui/tabtest/tabtest.lpi index b29eb7a0..a3e5d6f7 100644 --- a/examples/gui/tabtest/tabtest.lpi +++ b/examples/gui/tabtest/tabtest.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -9,11 +9,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -39,10 +41,18 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="tabtest"/> + </Target> <SearchPaths> <UnitOutputDirectory Value="units"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Linking> <Debugging> <UseHeaptrc Value="True"/> diff --git a/examples/gui/tabtest/tabtest.lpr b/examples/gui/tabtest/tabtest.lpr index 016d5af5..3675e29a 100644 --- a/examples/gui/tabtest/tabtest.lpr +++ b/examples/gui/tabtest/tabtest.lpr @@ -6,7 +6,7 @@ uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} - Classes, + Classes, SysUtils, fpg_main, fpg_base, fpg_widget, fpg_form, fpg_tab, fpg_button, fpg_label, fpg_edit, fpg_checkbox, fpg_combobox; @@ -22,6 +22,10 @@ type btn2, btn3: TfpgButton; chkSort: TfpgCheckBox; cbTabPos: TfpgComboBox; + edtHeight: TfpgEditInteger; + lbl: TfpgLabel; + procedure TabSheet4Painting(Sender: TObject); + procedure edtHeightChanged(Sender: TObject); procedure btnQuitClick(Sender: TObject); procedure btn2Click(Sender: TObject); procedure btn3Click(Sender: TObject); @@ -33,6 +37,16 @@ type { TMainForm } +procedure TMainForm.TabSheet4Painting(Sender: TObject); +begin + lbl.Text := 'H: ' + IntToStr(tsFour.Height); +end; + +procedure TMainForm.edtHeightChanged(Sender: TObject); +begin + pcMain.FixedTabHeight := edtHeight.Value; +end; + procedure TMainForm.btnQuitClick(Sender: TObject); begin Close; @@ -79,6 +93,7 @@ begin inherited Create(AOwner); WindowTitle := 'Tab control test'; SetPosition(100, 100, 566, 350); + ShowHint := True; btnQuit := CreateButton(self, 476, 320, 80, 'Quit', @btnQuitClick); btnQuit.ImageName := 'stdimg.Quit'; @@ -115,7 +130,9 @@ begin tsFour := TfpgTabSheet.Create(pcMain); tsFour.Text := 'This is one long text caption'; tsFour.BackgroundColor := clMediumSeaGreen; - + tsFour.OnPaint := @TabSheet4Painting; + lbl := CreateLabel(tsFour, 30, 50, 'TabSheet Four'); + pcMain.ActivePage := tsOne; btn2 := CreateButton(self, 10, 320, 80, 'Page 1', @btn2Click); @@ -136,7 +153,14 @@ begin cbTabPos.Items.Add('tpNone'); cbTabPos.FocusItem := 0; cbTabPos.Anchors := [anBottom, anLeft]; + cbTabPos.Hint := 'Tab position'; cbTabPos.OnChange := @cbTabPosChanged; + + CreateLabel(self, 390, 325, 'Height:'); + edtHeight := CreateEditInteger(self, 435, 320, 30, 24, False); + edtHeight.Value := 0; + edtHeight.Hint := 'Tab height'; + edtHeight.OnChange := @edtHeightChanged; end; procedure MainProc; diff --git a/examples/gui/timertest/extrafpc.cfg b/examples/gui/timertest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/timertest/extrafpc.cfg +++ b/examples/gui/timertest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/timertest/timertest.lpi b/examples/gui/timertest/timertest.lpi index a27e074a..c9494ac4 100644 --- a/examples/gui/timertest/timertest.lpi +++ b/examples/gui/timertest/timertest.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,10 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="timertest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/treeviewtest/extrafpc.cfg b/examples/gui/treeviewtest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/treeviewtest/extrafpc.cfg +++ b/examples/gui/treeviewtest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/treeviewtest/treeviewtest.lpi b/examples/gui/treeviewtest/treeviewtest.lpi index 6c19a1a9..8f925b0d 100644 --- a/examples/gui/treeviewtest/treeviewtest.lpi +++ b/examples/gui/treeviewtest/treeviewtest.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -46,7 +46,13 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> + <Target> + <Filename Value="treeviewtest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> <Parsing> <SyntaxOptions> <CStyleOperator Value="False"/> @@ -57,7 +63,6 @@ <CompilerMessages> <UseMsgFile Value="True"/> </CompilerMessages> - <CustomOptions Value="-FUunits"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/examples/gui/video_vlc/frmvlcplayer.pas b/examples/gui/video_vlc/frmvlcplayer.pas new file mode 100644 index 00000000..7b44c1e1 --- /dev/null +++ b/examples/gui/video_vlc/frmvlcplayer.pas @@ -0,0 +1,340 @@ +unit frmvlcplayer; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, fpg_base, fpg_panel, fpg_button, fpg_main, fpg_form, + fpg_editbtn, fpg_memo, fpg_label, libvlc, vlc, fpg_vlc; + +type + + { TVLCPlayerDemoForm } + + TVLCPlayerDemoForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: VLCPlayerDemo} + Panel1: TfpgPanel; + FilenameEdit1: TfpgFileNameEdit; + Label1: TfpgLabel; + Button1: TfpgButton; + Button2: TfpgButton; + Button3: TfpgButton; + Button4: TfpgButton; + Memo1: TfpgMemo; + procedure Sync; + {@VFD_HEAD_END: VLCPlayerDemo} + public + P : TFpgVLCPlayer; + FMsg: String; + procedure AfterCreate; override; + Procedure InitPlayer; + Procedure Log(Const Msg : String); + Procedure DoPlay(sender : TObject); + Procedure DoPause(sender : TObject); + Procedure DoResume(sender : TObject); + Procedure DoStop(sender : TObject); + // Event callbacks + procedure DoOnBackward(Sender: TObject); + procedure DoOnMediaChanged(Sender: TObject); + procedure DoOnNothingSpecial(Sender: TObject); + procedure DoOnBuffering(Sender: TObject); + procedure DoOnEOF(Sender: TObject); + procedure DoOnError(Sender: TObject; const AError: string); + procedure DoOnForward(Sender: TObject); + procedure DoOnLengthChanged(Sender: TObject; const time: TDateTime); + procedure DoOnOpening(Sender: TObject); + procedure DoOnPause(Sender: TObject); + procedure DoOnPlaying(Sender: TObject); + procedure DoOnStop(Sender: TObject); + procedure DoOnPausableChanged(Sender: TObject; const AValue: Boolean); + procedure DoOnPositionChanged(Sender: TObject; const APos: Double); + procedure DoOnSeekableChanged(Sender: TObject; const AValue: Boolean); + procedure DoOnTimeChanged(Sender: TObject; const time: TDateTime); + procedure DoOnSnapshot(Sender: TObject; const AfileName: string); + procedure DoOnTitleChanged(Sender: TObject; const ATitle: Integer); + end; + +{@VFD_NEWFORM_DECL} + +implementation + +{@VFD_NEWFORM_IMPL} + +procedure TVLCPlayerDemoForm.DoOnBackward(Sender: TObject); +begin + Log('Backward'); +end; + +procedure TVLCPlayerDemoForm.DoOnMediaChanged(Sender: TObject); +begin + Log('Media changed'); +end; + +procedure TVLCPlayerDemoForm.DoOnNothingSpecial(Sender: TObject); +begin + Log('Idle'); +end; + +procedure TVLCPlayerDemoForm.DoOnBuffering(Sender: TObject); +begin + Log('Buffering'); +end; + +procedure TVLCPlayerDemoForm.DoOnEOF(Sender: TObject); +begin + Log('EOF'); +end; + +procedure TVLCPlayerDemoForm.DoOnError(Sender: TObject; const AError: string); +begin + Log('Error : '+AError); +end; + +procedure TVLCPlayerDemoForm.DoOnForward(Sender: TObject); +begin + Log('Forward'); +end; + +procedure TVLCPlayerDemoForm.DoOnLengthChanged(Sender: TObject; + const time: TDateTime); +begin + Log('Length changed : '+TimeToStr(Time)); +end; + +procedure TVLCPlayerDemoForm.DoOnOpening(Sender: TObject); +begin + Log('Opening'); +end; + +procedure TVLCPlayerDemoForm.DoOnPause(Sender: TObject); +begin + Log('Pause'); +end; + +procedure TVLCPlayerDemoForm.DoOnPlaying(Sender: TObject); +begin + Log('Playing'); +end; + +procedure TVLCPlayerDemoForm.DoOnStop(Sender: TObject); +begin + Log('Stop'); +end; + +procedure TVLCPlayerDemoForm.DoOnPausableChanged(Sender: TObject; + const AValue: Boolean); +begin + Log('Pausable changed : '+BoolToStr(AValue,True)); +end; + +procedure TVLCPlayerDemoForm.DoOnPositionChanged(Sender: TObject; + const APos: Double); +begin + Log('Position changed : '+FloatToStr(APos)); +end; + +procedure TVLCPlayerDemoForm.DoOnSeekableChanged(Sender: TObject; + const AValue: Boolean); +begin + Log('Seekable changed : '+BoolToStr(AValue,True)); +end; + +procedure TVLCPlayerDemoForm.DoOnTimeChanged(Sender: TObject; + const time: TDateTime); +begin + Log('Time changed : '+TimeToStr(Time)); +end; + +procedure TVLCPlayerDemoForm.DoOnSnapshot(Sender: TObject; + const AfileName: string); +begin + Log('Wrote snapshot to file : '+AFileName); +end; + +procedure TVLCPlayerDemoForm.DoOnTitleChanged(Sender: TObject; + const ATitle: Integer); +begin + Log('Title changed : '+IntToStr(ATitle)); +end; + +procedure TVLCPlayerDemoForm.AfterCreate; +begin + + {@VFD_BODY_BEGIN: VLCPlayerDemo} + Name := 'VLCPlayerDemo'; + SetPosition(424, 319, 813, 574); + WindowTitle := 'VLCPlayerDemo'; + Hint := ''; + + Panel1 := TfpgPanel.Create(self); + with Panel1 do + begin + Name := 'Panel1'; + SetPosition(28, 40, 754, 422); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Select a video'; + end; + + FilenameEdit1 := TfpgFileNameEdit.Create(self); + with FilenameEdit1 do + begin + Name := 'FilenameEdit1'; + SetPosition(108, 8, 566, 24); + Anchors := [anLeft,anRight,anTop]; + ExtraHint := ''; + FileName := ''; + Filter := 'Video files|*.avi;*.flv;*.mp4'; + InitialDir := ''; + TabOrder := 2; + end; + + Label1 := TfpgLabel.Create(self); + with Label1 do + begin + Name := 'Label1'; + SetPosition(32, 12, 72, 20); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Play file:'; + end; + + Button1 := TfpgButton.Create(self); + with Button1 do + begin + Name := 'Button1'; + SetPosition(698, 8, 80, 24); + Anchors := [anRight,anTop]; + Text := 'Play'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 4; + OnClick:=@DoPlay; + end; + + Button2 := TfpgButton.Create(self); + with Button2 do + begin + Name := 'Button2'; + SetPosition(28, 472, 80, 28); + Anchors := [anLeft,anBottom]; + Text := 'Pause'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 5; + OnClick:=@DoPause; + end; + + Button3 := TfpgButton.Create(self); + with Button3 do + begin + Name := 'Button3'; + SetPosition(116, 472, 80, 28); + Anchors := [anLeft,anBottom]; + Text := 'Resume'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 6; + OnClick:=@DoResume; + end; + + Button4 := TfpgButton.Create(self); + with Button4 do + begin + Name := 'Button4'; + SetPosition(204, 472, 80, 28); + Anchors := [anLeft,anBottom]; + Text := 'Stop'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 7; + OnClick:=@DoStop; + end; + + Memo1 := TfpgMemo.Create(self); + with Memo1 do + begin + Name := 'Memo1'; + SetPosition(288, 469, 494, 100); + Anchors := [anLeft,anRight,anBottom]; + FontDesc := '#Edit1'; + Hint := ''; + TabOrder := 8; + end; + + {@VFD_BODY_END: VLCPlayerDemo} + {%endregion} +end; + +procedure TVLCPlayerDemoForm.InitPlayer; +begin + If P<>Nil then + exit; + P:=TFpgVLCPlayer.Create(Self); + P.UseEvents:=True; + P.ParentWindow:=Panel1; + P.OnMediaChanged:=@DoOnMediaChanged; + P.OnNothingSpecial:=@DoOnNothingSpecial; + P.OnBackward:=@DoOnBackward; + P.OnBuffering:=@DoOnBuffering; + P.OnEOF:=@DoOnEOF; + P.OnError:=@DoOnError; + P.OnForward:=@DoOnForward; + P.OnOpening:=@DoOnOpening; + P.OnPause:=@DoOnPause; + P.OnPlaying:=@DoOnPlaying; + P.OnStop:=@DoOnStop; + P.OnLengthChanged:=@DoOnLengthChanged; + P.OnTimeChanged:=@DoOnTimeChanged; + P.OnPausableChanged:=@DoOnPausableChanged; + P.OnPositionChanged:=@DoOnPositionChanged; + P.OnSeekableChanged:=@DoOnSeekableChanged; + P.OnTitleChanged:=@DoOnTitleChanged; + P.OnSnapshot:=@DoOnSnapshot; + +end; + +procedure TVLCPlayerDemoForm.Sync; +begin + Memo1.Lines.Add(FMsg); +end; + +procedure TVLCPlayerDemoForm.Log(const Msg: String); +begin + FMsg:=Msg; + TThread.Synchronize(Nil,@Self.Sync); +end; + +procedure TVLCPlayerDemoForm.DoPlay(sender: TObject); +begin + InitPlayer; + P.PlayFile(FileNameEdit1.FileName); +end; + +procedure TVLCPlayerDemoForm.DoPause(sender: TObject); +begin + If Assigned(P) then + P.Pause; +end; + +procedure TVLCPlayerDemoForm.DoResume(sender: TObject); +begin + if Assigned(P) then + P.Resume; +end; + +procedure TVLCPlayerDemoForm.DoStop(sender: TObject); +begin + If Assigned(P) then + P.Stop; +end; + + +end. diff --git a/examples/gui/video_vlc/testfpguivlc.lpi b/examples/gui/video_vlc/testfpguivlc.lpi new file mode 100644 index 00000000..d7a4ad2a --- /dev/null +++ b/examples/gui/video_vlc/testfpguivlc.lpi @@ -0,0 +1,99 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="testfpguivlc"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="5"> + <Unit0> + <Filename Value="testfpguivlc.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="testfpguivlc"/> + </Unit0> + <Unit1> + <Filename Value="frmvlcplayer.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frmvlcplayer"/> + </Unit1> + <Unit2> + <Filename Value="../fpg_vlc.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="fpg_vlc"/> + </Unit2> + <Unit3> + <Filename Value="../../libvlc/libvlc.pp"/> + <IsPartOfProject Value="True"/> + <UnitName Value="libvlc"/> + </Unit3> + <Unit4> + <Filename Value="../../libvlc/vlc.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="vlc"/> + </Unit4> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="testfpguivlc"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../../../src/3rdparty/libvlc"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gui/video_vlc/testfpguivlc.lpr b/examples/gui/video_vlc/testfpguivlc.lpr new file mode 100644 index 00000000..3846a69c --- /dev/null +++ b/examples/gui/video_vlc/testfpguivlc.lpr @@ -0,0 +1,31 @@ +program testfpguivlc; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Math, + Classes, frmvlcplayer, fpg_vlc, libvlc, vlc, fpg_main; + +procedure MainProc; +var + frm: TVLCPlayerDemoForm; +begin + fpgApplication.Initialize; + frm := TVLCPlayerDemoForm.Create(nil); + frm.Show; + fpgApplication.Run; + frm.Free; +end; + + +begin + With TThread.Create(False) do + Terminate; + setexceptionmask([exInvalidOp, exDenormalized, exZeroDivide, + exOverflow, exUnderflow, exPrecision]); + MainProc; +end. + diff --git a/examples/gui/wulinetest/extrafpc.cfg b/examples/gui/wulinetest/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/examples/gui/wulinetest/extrafpc.cfg +++ b/examples/gui/wulinetest/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/examples/gui/wulinetest/wuline_test.lpi b/examples/gui/wulinetest/wuline_test.lpi index 7a54bb83..55fd3864 100644 --- a/examples/gui/wulinetest/wuline_test.lpi +++ b/examples/gui/wulinetest/wuline_test.lpi @@ -1,20 +1,21 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> + <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -40,10 +41,19 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Target> + <Filename Value="wulinetest"/> + </Target> + <SearchPaths> + <UnitOutputDirectory Value="units"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> - <CustomOptions Value="-FUunits -"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> diff --git a/extras/code_templates/lazarus.dci b/extras/code_templates/lazarus.dci index 7bd7f9e0..b9eeae7f 100644 --- a/extras/code_templates/lazarus.dci +++ b/extras/code_templates/lazarus.dci @@ -98,7 +98,7 @@ end. { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 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/extras/contributed/ats/extrafpc.cfg b/extras/contributed/ats/extrafpc.cfg index 775d592f..7c0fe0a0 100644 --- a/extras/contributed/ats/extrafpc.cfg +++ b/extras/contributed/ats/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/extras/contributed/nicegrid/fpg_nicegrid.pas b/extras/contributed/nicegrid/fpg_nicegrid.pas new file mode 100644 index 00000000..2a27f771 --- /dev/null +++ b/extras/contributed/nicegrid/fpg_nicegrid.pas @@ -0,0 +1,3428 @@ +unit fpg_nicegrid; +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpg_base, fpg_main, fpg_panel, fpg_scrollbar, fpg_edit; + +type + PHeaderInfo = ^THeaderInfo; + THeaderInfo = record + Str: string; + Rc: TfpgRect; + end; + + THorzAlign = (haLeft, haCenter, haRight); + TVertAlign = (vaTop, vaCenter, vaBottom); + TGutterKind = (gkNone, gkBlank, gkPointer, gkNumber, gkString); + TGridHittest = (gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox); + + TfpgNiceGrid = class; + + TfpgNiceColumn = class(TCollectionItem) + private + FTitle: string; + FFooter: string; + FWidth: Integer; + FFont: string; + FFontColor: TfpgColor; + FColor: TfpgColor; + FHorzAlign: THorzAlign; + FVertAlign: TVertAlign; + FVisible: Boolean; + FStrings: TStrings; + FTag: Integer; + FTag2: Integer; + FCanResize: Boolean; + FHint: string; + FReadOnly: Boolean; + function GetGrid: TfpgNiceGrid; + function IsFontStored: Boolean; + procedure SetTitle(Value: string); + procedure SetWidth(Value: Integer); + procedure SetFont(Value: string); + procedure SetColor(Value: TfpgColor); + procedure SetHorzAlign(Value: THorzAlign); + procedure SetVertAlign(Value: TVertAlign); + procedure SetVisible(Value: Boolean); + procedure SetStrings(Value: TStrings); + procedure SetFooter(const Value: string); + protected + function GetDisplayName: string; override; + public + constructor Create(Collec: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + published + property Grid: TfpgNiceGrid read GetGrid; + property Title: string read FTitle write SetTitle; + property Footer: string read FFooter write SetFooter; + property Width: Integer read FWidth write SetWidth; + property Font: string read FFont write SetFont stored IsFontStored; + property FontColor: TfpgColor read FFontColor write FFontColor; + property Color: TfpgColor read FColor write SetColor default clGray; //clWindow; + property HorzAlign: THorzAlign read FHorzAlign write SetHorzAlign default haLeft; + property VertAlign: TVertAlign read FVertAlign write SetVertAlign default vaCenter; + property Visible: Boolean read FVisible write SetVisible default True; + property Tag: Integer read FTag write FTag default 0; + property Tag2: Integer read FTag2 write FTag2 default 0; + property Hint: string read FHint write FHint; + property Strings: TStrings read FStrings write SetStrings; + property CanResize: Boolean read FCanResize write FCanResize default True; + property ReadOnly: Boolean read FReadOnly write FReadOnly default False; + end; + + + TfpgNiceColumns = class(TOwnedCollection) + private + FGrid: TfpgNiceGrid; + function GetItem(Index: Integer): TfpgNiceColumn; + procedure SetItem(Index: Integer; Value: TfpgNiceColumn); + protected + function GetOwner: TPersistent; override; + procedure Update(Item: TCollectionItem); override; + public + constructor Create(AOwner: TPersistent; AItemClass: TCollectionItemClass); + property Grid: TfpgNiceGrid read FGrid; + property Items[Index: Integer]: TfpgNiceColumn read GetItem write SetItem; default; + function Add: TfpgNiceColumn; + function AddItem(Item: TfpgNiceColumn; Index: Integer): TfpgNiceColumn; + function Insert(Index: Integer): TfpgNiceColumn; + end; + + + TfpgNiceInplace = class(TfpgEdit) + private + FGrid: TfpgNiceGrid; + FAlignment: THorzAlign; + CellX, CellY: Integer; + BuffTmp: string; + procedure SetAlignment(Value: THorzAlign); + protected + procedure Change(Sender: TObject); + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);override; + public + constructor Create(AGrid: TfpgNiceGrid);reintroduce; + procedure ShowEdit(X, Y: Integer); + procedure HideEdit; + end; + + TfpgMergeCell = class(TObject) + public + Text: string; + Rc: TfpgRect; + Color: TfpgColor; + Font: string; + HorzAlign: THorzAlign; + VertAlign: TVertAlign; + constructor Create; + destructor Destroy; override; + end; + + TOnDrawCellEvent = procedure (Sender: TObject; ACanvas: TfpgCanvas; X, Y: Integer; + Rc: TfpgRect; var Handled: Boolean) of object; + + TOnDrawHeaderEvent = procedure (Sender: TObject; ACanvas: TfpgCanvas; Rc: TfpgRect; + Str: string; var Handled: Boolean) of object; + + TOnHeaderClick = procedure (Sender: TObject; ACol: Integer; + Button: TMouseButton; Shift: TShiftState) of object; + + TOnGutterClick = procedure (Sender: TObject; ARow: Integer; + Button: TMouseButton; Shift: TShiftState) of object; + + TOnCellAssignment = procedure (Sender: TObject; ACol, ARow: Integer; + var Str: string) of object; + + TOnCellChange = procedure (Sender: TObject; ACol, ARow: Integer; var Str: string) + of object; + + TOnCellChanging = procedure (Sender: TObject; ACol, ARow: Integer; + var CanChange: Boolean) of object; + + TOnRowEvent = procedure (Sender: TObject; ARow: Integer) of object; + + TOnColRowChanged = procedure (Sender: TObject; ACol, ARow: Integer) of object; + + TfpgNiceGridSync = class; + + TfpgNiceGrid = class(TfpgPanel) + private + ForcedColumn: Integer; + FixedWidth, FixedHeight: Integer; + BodyWidth, BodyHeight: Integer; + AllWidth, AllHeight: Integer; + FooterTop: Integer; + CellBox: TfpgRect; + + FHorzOffset: Integer; + FVertOffset: Integer; + FMaxHScroll: Integer; + FMaxVScroll: Integer; + FSmallChange: Integer; + FLargeChange: Integer; + + FAutoAddRow: Boolean; + FRowCount: Integer; + FDefRowHeight: Integer; + FDefColWidth: Integer; + FFlat: Boolean; + + FHeaderLine: Integer; + FHeaderInfos: TList; + FUpdating: Boolean; + FColor: TfpgColor; + FAlternateColor: TfpgColor; + FGridColor: TfpgColor; + FShowGrid: Boolean; + FHeaderColor: TfpgColor; + FHeaderLightColor: TfpgColor; + FHeaderDarkColor: TfpgColor; + FSelectionColor: TfpgColor; + FHeaderFont: string; + FHeaderFontColor: TfpgColor; + FGutterFont: string; + FGutterFontColor: TfpgColor; + FFooterFont: string; + FFooterFontColor: TfpgColor; + + FGutterKind: TGutterKind; + FGutterWidth: Integer; + + FFitToWidth: Boolean; + FAutoColWidth: Boolean; + FReadOnly: Boolean; + FColumns: TfpgNiceColumns; + + FEdit: TfpgNiceInplace; + FCol: Integer; + FRow: Integer; + FCol2, FRow2: Integer; // Selection + FSelectArea: TfpgRect; + + SmallBox: TfpgRect; + SmallBoxArea: TfpgRect; + SmallBoxPos: Byte; + + BuffString: string; + IsEditing: Boolean; + SizingCol: Integer; + SizingColX: Integer; + LastHover: Integer; + Sync: TfpgNiceGridSync; + Mergeds: TList; + + FOnDrawCell: TOnDrawCellEvent; + FOnDrawHeader: TOnDrawHeaderEvent; + FOnDrawGutter: TOnDrawHeaderEvent; + FOnDrawFooter: TOnDrawHeaderEvent; + FOnHeaderClick: TOnHeaderClick; + FOnGutterClick: TOnGutterClick; + FOnCellChange: TOnCellChange; + FOnCellChanging: TOnCellChanging; + FOnColRowChanged: TOnColRowChanged; + FOnInsertRow: TOnRowEvent; + FOnDeleteRow: TOnRowEvent; + FOnCellAssignment: TOnCellAssignment; + FGutterStrings: TStrings; + FShowFooter: Boolean; + + //************************* + FVScrollBar: TfpgScrollBar; + FHScrollBar: TfpgScrollBar; + procedure UpdateScrollBars; virtual; + procedure HScrollBarMove(Sender: TObject; position: integer); + procedure VScrollBarMove(Sender: TObject; position: integer); + //***************************** + + function TotalWidth: Integer; + procedure ClearHeaderInfos; + + procedure ClearUnused; + procedure RenderGutter; + procedure RenderHeader; + procedure DrawSelection; + + procedure SetHorzOffset(Value: Integer); + procedure SetVertOffset(Value: Integer); + function GetColCount: Integer; + procedure SetColCount(Value: Integer); + procedure SetRowCount(Value: Integer); + procedure SetDefColWidth(Value: Integer); + procedure SetDefRowHeight(Value: Integer); + procedure SetFlat(Value: Boolean); + procedure SetColor(Value: TfpgColor); + procedure SetAlternateColor(Value: TfpgColor); + procedure SetGridColor(Value: TfpgColor); + procedure SetShowGrid(Value: Boolean); + procedure SetHeaderLine(Value: Integer); + procedure SetHeaderColor(Value: TfpgColor); + procedure SetHeaderLightColor(Value: TfpgColor); + procedure SetHeaderDarkColor(Value: TfpgColor); + procedure SetHeaderFont(Value: string); + procedure SetHeaderFontColor(Value: TfpgColor); + procedure SetSelectionColor(Value: TfpgColor); + procedure SetFitToWidth(Value: Boolean); + procedure SetAutoColWidth(Value: Boolean); + procedure SetReadOnly(Value: Boolean); + procedure InternalSetCell(X, Y: Integer; Value: string; FireOnChange: Boolean); + procedure SetCell(X, Y: Integer; Value: string); + function GetColWidths(Idx: Integer): Integer; + procedure SetColWidths(Idx: Integer; Value: Integer); + procedure SetColumns(Value: TfpgNiceColumns); + procedure SetCol(Value: Integer); + procedure SetRow(Value: Integer); + procedure AdjustSelection(Value: TfpgRect; Force: Boolean); + procedure SetSelectArea(Value: TfpgRect); + procedure SetGutterKind(Value: TGutterKind); + procedure SetGutterWidth(Value: Integer); + procedure SetGutterFont(const Value: string); + procedure SetGutterFontColor(Value: TfpgColor); + procedure SetFooterFont(const Value: string); + procedure SetFooterFontColor(Value: TfpgColor); + function CreateColumn: TfpgNiceColumn; + procedure UpdateColumn(Index: Integer); + procedure UpdateColumns; + procedure UpdateHeader; + + function GetCellRect(x, y: Integer): TfpgRect; + function CellRectToClient(R: TfpgRect): TfpgRect; + function GetCellAtPos(X, Y: Integer): TPoint; + function GetColFromX(X: Integer): Integer; + function GetRowFromY(Y: Integer): Integer; + function GetColCoord(I: Integer): Integer; + function GetCell(X, Y: Integer): string; + function SafeGetCell(X, Y: Integer): string; + function GetCellColor(X, Y: Integer): TfpgColor; + procedure DrawCell(X, Y: Integer); + function FastDrawCell(X, Y: Integer): TPoint; + procedure NormalizeVertOffset; + + function GetFirstVisible: Integer; + function GetLastVisible: Integer; + function GetNextVisible(Index: Integer): Integer; + function GetPrevVisible(Index: Integer): Integer; + procedure ColRowChanged; + procedure SetGutterStrings(const Value: TStrings); + function GetObject(X, Y: Integer): TObject; + procedure SetObject(X, Y: Integer; const Value: TObject); + procedure BuildMergeData; + procedure DrawMergedCell(Index: Integer); + procedure SetShowFooter(const Value: Boolean); + procedure RenderFooter; + procedure DrawFixCell(Rc: TfpgRect; Str: string; AFont: string;AFontColor: TfpgColor; AEvent: TOnDrawHeaderEvent); + procedure SetEnabled(const Value: Boolean); reintroduce; + + protected +// ******************************************* + property VScrollBar: TfpgScrollBar read FVScrollBar write FVScrollBar; + property HScrollBar: TfpgScrollBar read FHSCrollBar write FHScrollBar; + procedure HandleShow; override; +//******************************************* + + function GetMergedCellsData: TList; + function GetHeaderInfo: TList; + procedure SetScrollBar(AKind: TfpgScrollBar; AMax, APos, AStep: Integer); virtual; + procedure ShowHideScrollBar(HorzVisible, VertVisible: Boolean); virtual; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure Recalculate; virtual; + procedure HandlePaint; override; + //********************************* + procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);override; + procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState);override; + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);override; + procedure HandleResize(awidth, aheight: TfpgCoord); override; +// **************** + + public + ClientWidth: integer; + ClientHeight: integer; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure BeginUpdate; + procedure EndUpdate; + procedure Clear; + property Cells[X, Y: Integer]: string read GetCell write SetCell; default; + property Objects[X, Y: Integer]: TObject read GetObject write SetObject; + property ColWidths[Index: Integer]: Integer read GetColWidths write SetColWidths; + procedure EnsureVisible(X, Y: Integer); overload; + procedure CutToClipboard; + procedure CopyToClipboard; + procedure PasteFromClipboard; + function GetHitTestInfo(X, Y: Integer): TGridHitTest; + function HeaderCellsCount: Integer; + function HeaderCells(I: Integer): THeaderInfo; + property Col: Integer read FCol write SetCol; + property Row: Integer read FRow write SetRow; + property SelectArea: TfpgRect read FSelectArea write SetSelectArea; + procedure DeleteRow(ARow: Integer); + procedure InsertRow(ARow: Integer); + function AddRow: Integer; + property HorzOffset: Integer read FHorzOffset write SetHorzOffset; + property VertOffset: Integer read FVertOffset write SetVertOffset; + function MergeCells(const X1, Y1, X2, Y2: Integer; ACaption: string): TfpgMergeCell; + procedure ClearMergeCells; + + published + property Enabled: Boolean read FEnabled write SetEnabled default True; + property ColCount: Integer read GetColCount write SetColCount; + property RowCount: Integer read FRowCount write SetRowCount default 5; + property AutoAddRow: Boolean read FAutoAddRow write FAutoAddRow default False; + property DefRowHeight: Integer read FDefRowHeight write SetDefRowHeight default 18; + property DefColWidth: Integer read FDefColWidth write SetDefColWidth default 80; + property Flat: Boolean read FFlat write SetFlat default True; + property Color: TfpgColor read FColor write SetColor default clGray; + property AlternateColor: TfpgColor read FAlternateColor write SetAlternateColor default clGray; + property GridColor: TfpgColor read FGridColor write SetGridColor default clButtonFace; + property ShowGrid: Boolean read FShowGrid write SetShowGrid default True; + property HeaderLine: Integer read FHeaderLine write SetHeaderLine default 1; + property HeaderColor: TfpgColor read FHeaderColor write SetHeaderColor default clButtonFace; + property HeaderLightColor: TfpgColor read FHeaderLightColor write SetHeaderLightColor default clHilite1; + property HeaderDarkColor: TfpgColor read FHeaderDarkColor write SetHeaderDarkColor default clHilite2; + property HeaderFont: string read FHeaderFont write SetHeaderFont; + property HeaderFontColor: TfpgColor read FHeaderFontColor write SetHeaderFontColor; + property FooterFont: string read FFooterFont write SetFooterFont; + property FooterFontColor: TfpgColor read FFooterFontColor write SetFooterFontColor; + property SelectionColor: TfpgColor read FSelectionColor write SetSelectionColor default $00CAFFFF; + property FitToWidth: Boolean read FFitToWidth write SetFitToWidth default False; + property AutoColWidth: Boolean read FAutoColWidth write SetAutoColWidth default False; + property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; + property Columns: TfpgNiceColumns read FColumns write SetColumns; + property GutterKind: TGutterKind read FGutterKind write SetGutterKind default gkBlank; + property GutterWidth: Integer read FGutterWidth write SetGutterWidth default 20; + property GutterFont: string read FGutterFont write SetGutterFont; + property GutterFontColor: TfpgColor read FGutterFontColor write SetGutterFontColor; + property GutterStrings: TStrings read FGutterStrings write SetGutterStrings; + property ShowFooter: Boolean read FShowFooter write SetShowFooter; + property OnDrawCell: TOnDrawCellEvent read FOnDrawCell write FOnDrawCell; + property OnDrawHeader: TOnDrawHeaderEvent read FOnDrawHeader write FOnDrawHeader; + property OnDrawGutter: TOnDrawHeaderEvent read FOnDrawGutter write FOnDrawGutter; + property OnDrawFooter: TOnDrawHeaderEvent read FOnDrawFooter write FOnDrawFooter; + property OnHeaderClick: TOnHeaderClick read FOnHeaderClick write FOnHeaderClick; + property OnGutterClick: TOnGutterClick read FOnGutterClick write FOnGutterClick; + property OnCellChange: TOnCellChange read FOnCellChange write FOnCellChange; + property OnCellChanging: TOnCellChanging read FOnCellChanging write FOnCellChanging; + property OnColRowChanged: TOnColRowChanged read FOnColRowChanged write FOnColRowChanged; + property OnInsertRow: TOnRowEvent read FOnInsertRow write FOnInsertRow; + property OnDeleteRow: TOnRowEvent read FOnDeleteRow write FOnDeleteRow; + property OnCellAssignment: TOnCellAssignment read FOnCellAssignment write FOnCellAssignment; + property Font; + property Anchors; + property Align; + property BorderStyle default bsSingle; + property TabOrder; + property Tag; + property OnClick; + property OnDoubleClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnKeyPress; + end; + + TfpgNiceGridSync = class(TfpgNiceGrid) + private + FMasterGrid: TfpgNiceGrid; + procedure SetMasterGrid(const Value: TfpgNiceGrid); + procedure SyncDeleteRow(Sender: TObject; ARow: Integer); + procedure SyncInsertRow(Sender: TObject; ARow: Integer); + procedure SyncColRow(Sender: TObject; ACol, ARow: Integer); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure SetScrollBar(AKind: TfpgScrollBar; AMax, APos,AStep: Integer); override; + procedure ShowHideScrollBar(HorzVisible, VertVisible: Boolean); override; + property OnDeleteRow; + property OnInsertRow; + property OnColRowChanged; + public + constructor Create(AOwner: TComponent); override; + published + property MasterGrid: TfpgNiceGrid read FMasterGrid write SetMasterGrid; + end; + + + function DrawStringUni(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect; + HorzAlign: THorzAlign; VertAlign: TVertAlign): TPoint; + + procedure DrawStringMulti(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect; + HorzAlign: THorzAlign; VertAlign: TVertAlign); + + +implementation + +uses + Math; + +const + { crPlus = 101; + crSmallCross = 102; + crRight = 103; + crDown = 104; + crLeftTop = 105;} + + CursorArray: array [TGridHitTest] of TMouseCursor = + //(gtNone, gtLeftTop, gtLeft, gtTop, gtCell, gtColSizing, gtSmallBox); + // (crDefault, crLeftTop, crRight, crDown, crPlus, crHSplit, crSmallCross); + (mcDefault,mcSizeNWSE ,mcSizeEW,mcSizeNS, mcCross,mcMove,mcHand); + + MergeID = -2; + + +{ TfpgNiceGrid } + +constructor TfpgNiceGrid.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FisContainer:=true; + Width := 200; + Height := 200; + BorderStyle := bsSingle; + Text:=''; + FFlat := True; + FEnabled := True; + FColor := clWindowBackground; + FAlternateColor := clWindowBackground; + FGridColor := clButtonFace; + FShowGrid := True; + FHeaderColor := clButtonface; + FHeaderLightColor := clHilite1; + FHeaderDarkColor := clShadow1; + FHeaderFont:='Arial-8'; + FSelectionColor := $00CAFFFF; + FFooterFont := 'Arial-8'; + FooterFontColor := clRed; + FDefRowHeight := 18; + FDefColWidth := 60; + FRowCount := 5; + FAutoAddRow := False; + FGutterKind := gkBlank; + FGutterWidth := 20; + FGutterFont:='Arial-8'; + FGutterFontColor:=clBlack; + + FHorzOffset := 0; + FVertOffset := 0; + FMaxHScroll := 0; + FMaxVScroll := 0; + FSmallChange := FDefRowHeight; + FLargeChange := FDefRowHeight * 5; + ForcedColumn := -1; + AllWidth := 200; + AllHeight := 200; + ClientWidth:=Width -2; + ClientHeight:=Height -2; + + FHeaderLine := 1; + FHeaderInfos := TList.Create; + + CellBox:=fpgRect(0, 0, 0, 0); + FCol := 0; + FRow := 0; + FCol2 := 0; + FRow2 := 0; + FSelectArea:=fpgRect(0, 0, 0, 0); + IsEditing := False; + BuffString := ''; + SmallBox := fpgRect(-1, -1,0, 0); + SmallBoxArea:=fpgRect(-1, -1, 0,0); + SmallBoxPos := 0; + SizingCol := -1; + SizingColX := -1; + MouseCursor := mcCross; + FColumns := TfpgNiceColumns.Create(Self,TfpgNiceColumn); + FEdit := TfpgNiceInplace.Create(Self); + + FGutterStrings := TStringList.Create; + Mergeds := TList.Create; + Sync:=nil; +// ************************ + FVScrollBar := TfpgScrollBar.Create(self); + FVScrollBar.Orientation := orVertical; + FVScrollBar.Visible := false; + FVScrollBar.ScrollStep:= FDefRowHeight; + FVScrollBar.OnScroll:=@VScrollBarMove; + + FHScrollBar := TfpgScrollBar.Create(self); + FHScrollBar.Orientation := orHorizontal; + FHScrollBar.Visible := false; + FHScrollBar.ScrollStep := 5; + FHScrollBar.OnScroll:=@HScrollBarMove; +//******************************* + +end; + +destructor TfpgNiceGrid.Destroy; +begin + ClearMergeCells; + Mergeds.Free; + FGutterStrings.Free; + FEdit.Free; + FColumns.Free; + ClearHeaderInfos; + FHeaderInfos.Free; + inherited Destroy; +end; + +procedure TfpgNiceGrid.SetScrollBar(AKind: TfpgScrollbar; AMax, APos, AStep: Integer); +begin + with AKind do + begin + Min:=0; + Max:=AMax; + ScrollStep:=AStep; + Position:=APos; + RepaintSlider; + end; + if (AKind = FVScrollBar) and Assigned(Sync) then + begin + Sync.FMaxVScroll := AMax; + Sync.VertOffset := APos; + end; +end; + +procedure TfpgNiceGrid.ShowHideScrollBar(HorzVisible, VertVisible: Boolean); +begin + FVScrollBar.Visible:= VertVisible; + FHScrollBar.Visible:= HorzVisible; +end; + +procedure TfpgNiceGrid.HScrollBarMove(Sender: TObject; position: integer); +begin + if FHorzOffset <> position then + begin + if Position < 0 then + Position := 0; + FHorzOffset:= position; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.VScrollBarMove(Sender: TObject; position: integer); +begin + FVertOffset := position; + FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset)); + NormalizeVertOffset; + Invalidate; +end; + +procedure TfpgNiceGrid.HandleShow; +begin + inherited HandleShow; + if (csLoading in ComponentState) then + Exit; + UpdateScrollBars; +end; + +procedure TfpgNiceGrid.SetColCount(Value: Integer); +begin + if (ColCount <> Value) then + begin + FColumns.BeginUpdate; + while (ColCount > Value) + do FColumns.Delete(FColumns.Count-1); + while (ColCount < Value) + do FColumns.Add; + FHorzOffset := 0; + FVertOffset := 0; + FCol := Max(0, Min(FCol, ColCount-1)); + FRow := Max(0, Min(FRow, FRowCount-1)); + if (FRowCount = 0) or (ColCount = 0) then + begin + FCol := -1; + FRow := -1; + end; + FSelectArea:=fpgRect(FCol, FRow, FCol, FRow); + FColumns.EndUpdate; + ColRowChanged; + end; +end; + +procedure TfpgNiceGrid.SetRowCount(Value: Integer); +begin + if (FRowCount <> Value) then + begin + FRowCount := Value; + FCol := Max(0, Min(FCol, ColCount-1)); + FRow := Max(0, Min(FRow, FRowCount-1)); + if (FRowCount = 0) or (ColCount = 0) then + begin + FCol := -1; + FRow := -1; + end; + FSelectArea:=fpgRect(FCol, FRow, FCol, FRow); + Recalculate; + Invalidate; + UpdateScrollBars; + ColRowChanged; + end; +end; + +procedure TfpgNiceGrid.ClearHeaderInfos; +var + x: Integer; + P: PHeaderInfo; +begin + for x := 0 to FHeaderInfos.Count-1 do + begin + P := PHeaderInfo(FHeaderInfos[x]); + Dispose(P); + end; + FHeaderInfos.Clear; +end; + +procedure TfpgNiceGrid.Recalculate; +var + x: Integer; + HVisible, VVisible: Boolean; + VisCount: Integer; + WidthAvail, HeightAvail: Integer; + v: Integer; + LastBodyWidth: Integer; + + function GetColAutoWidth(i: Integer): Integer; + var + n: Integer; + t: TStrings; + begin + Result := 0; + t := Columns[i].FStrings; + for n := 0 to t.Count-1 + do Result := Max(Result, Canvas.Font.TextWidth(t[n]) + 7); + Result := Max(Result, 20); + end; + +begin + + BuildMergeData; + + VisCount := 0; + for x := 0 to FColumns.Count-1 do + begin + if FColumns[x].FVisible + then Inc(VisCount); + end; + + if (VisCount = 0) then + begin + FixedHeight := 0; + FixedWidth := 0; + BodyWidth := 0; + BodyHeight := 0; + ShowHideScrollBar(False, False); + Exit; + end; + + ClientHeight:= Height-2; + ClientWidth:= Width-2; + + if FAutoColWidth then + begin + for x := 0 to FColumns.Count-1 + do FColumns[x].FWidth := Max(FDefColWidth, GetColAutoWidth(x)); + end; + + FixedWidth := 0; + if (FGutterKind <> gkNone) + then FixedWidth := FGutterWidth; + + FixedHeight := FHeaderLine * FDefRowHeight; + BodyHeight := FRowCount * FDefRowHeight; + + WidthAvail := ClientWidth - FixedWidth; + HeightAvail := ClientHeight - FixedHeight; + if FShowFooter then + HeightAvail := HeightAvail - FDefRowHeight; + + BodyWidth := 0; + for x := 0 to FColumns.Count-1 do + begin + if FColumns[x].FVisible + then BodyWidth := BodyWidth + FColumns[x].FWidth; + end; + + if FFitToWidth then + begin + if (BodyWidth < WidthAvail) then + begin + LastBodyWidth := BodyWidth; + x := 0; + while (BodyWidth < WidthAvail) do + begin + if (x > ColCount-1) then + begin + if (BodyWidth = LastBodyWidth) + then Break + else x := 0; + end; + if FColumns[x].FVisible and FColumns[x].FCanResize then + begin + FColumns[x].FWidth := FColumns[x].FWidth + 1; + Inc(BodyWidth); + end; + Inc(x); + end; + end; + if (BodyWidth > WidthAvail) then + begin + LastBodyWidth := BodyWidth; + x := 0; + while (BodyWidth > WidthAvail) do + begin + if (x > ColCount-1) then + begin + if (BodyWidth = LastBodyWidth) + then Break + else x := 0; + end; + if FColumns[x].FVisible and (x <> ForcedColumn) and FColumns[x].FCanResize then + begin + FColumns[x].FWidth := FColumns[x].FWidth - 1; + Dec(BodyWidth); + end; + Inc(x); + end; + end; + ForcedColumn := -1; + end; + + if (BodyWidth < WidthAvail) + then FHorzOffset := 0; + + if (BodyHeight < HeightAvail) + then FVertOffset := 0; + + HVisible := BodyWidth > WidthAvail; + VVisible := BodyHeight > HeightAvail; + + ShowHideScrollBar(HVisible, VVisible); + + if FHScrollBar.Visible then + dec(ClientHeight,FHScrollBar.Height); + if FVScrollBar.Visible then + dec(ClientWidth,FVScrollBar.Width); + + FMaxHScroll := Max(0, BodyWidth - ClientWidth + FixedWidth); + + if FShowFooter + then FMaxVScroll := Max(0, BodyHeight - ClientHeight + FixedHeight + FDefRowHeight) + else FMaxVScroll := Max(0, BodyHeight - ClientHeight + FixedHeight); + + // Align to FDefRowHeight + v := FMaxVScroll div FDefRowHeight; + if (FMaxVScroll mod FDefRowHeight) > 0 + then Inc(v); + FMaxVScroll := v * FDefRowHeight; + + if FShowFooter then + begin + if VVisible then + FooterTop := (((ClientHeight div FDefRowHeight) - 1) * FDefRowHeight) - 1 + else FooterTop := (FDefRowHeight * (FHeaderLine + FRowCount)) - 1; + end; + + FHorzOffset := Max(0, Min(FHorzOffset, FMaxHScroll)); + FVertOffset := Max(0, Min(FVertOffset, FMaxVScroll)); + + SetScrollBar(FHScrollBar, FMaxHScroll, FHorzOffset, 1); + SetScrollBar(FVScrollBar, FMaxVScroll, FVertOffset, FDefRowHeight); + + AllWidth := Min(ClientWidth, BodyWidth + FixedWidth); + if FShowFooter then + begin + AllHeight := Min(ClientHeight, BodyHeight + FixedHeight + FDefRowHeight); + CellBox:=fpgRect(FixedWidth, FixedHeight, ClientWidth, FooterTop); + end else + begin + AllHeight := Min(ClientHeight, BodyHeight + FixedHeight); + CellBox:=fpgRect(FixedWidth, FixedHeight, ClientWidth, ClientHeight); + end; +end; + +function DrawStringUni(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect; + HorzAlign: THorzAlign; VertAlign: TVertAlign): TPoint; +var + w, h, x, y: Integer; + rw: Integer; +begin + w := Canvas.Font.TextWidth(Str); + h := Canvas.Font.Height; + x := 0; + y := 0; + rw := Rc.Right - rc.Left; + case HorzAlign of + haLeft: x := Rc.Left; + haCenter: x := Rc.Left + ((rw - w) div 2); + haRight: x := Rc.Right - w; + end; + case VertAlign of + vaTop: y := Rc.Top; + vaCenter: y := Rc.Top + (((Rc.Bottom - Rc.Top) - h) div 2); + vaBottom: y := Rc.Bottom - h; + end; + Canvas.DrawString(x, y, Str); + // Return next cursor position + Result := Point(Min(x + w + 1, Rc.Right), Rc.Top - 1); +end; + +procedure DrawStringMulti(Canvas: TfpgCanvas; Str: string; Rc: TfpgRect; + HorzAlign: THorzAlign; VertAlign: TVertAlign); +var + w, h, x, y: Integer; + t: TStringList; + i: Integer; + dh: Integer; + +begin + if Pos(';', Str) = 0 then + begin + DrawStringUni(Canvas, Str, Rc, HorzAlign, VertAlign); + Exit; + end; + + t := TStringList.Create; + t.Text := StringReplace(Str, ';', #13, [rfReplaceAll]); + h := Canvas.Font.Height; + dh := Rc.Top + (((Rc.Bottom - Rc.Top) - (h * t.Count)) div 2); + for i := 0 to t.Count-1 do + begin + w := Canvas.Font.TextWidth(t[i]); + x := 0; + y := 0; + case HorzAlign of + haLeft: x := Rc.Left; + haCenter: x := Rc.Left + (((Rc.Right - Rc.Left) - w) div 2); + haRight: x := Rc.Right - w; + end; + case VertAlign of + vaTop: y := Rc.Top + (i * h); + vaCenter: y := dh + (i * h); + vaBottom: y := Rc.Bottom - (h * (t.Count-i)); + end; + Canvas.DrawString(x, y, t[i]); + end; + t.Free; +end; + +Function PtInSelectArea(ARect: TfpgRect; P: TPoint): boolean; +begin + Result:=(p.y >= ARect.Top) and + (p.y <= ARect.Height) and + (p.x >= ARect.Left) and + (p.x <= ARect.Width); +end; + +function TfpgNiceGrid.GetCellColor(X, Y: Integer): TfpgColor; +var + cl: TfpgColor; + R: TfpgRect; +begin + cl := FColumns[x].Color; + if FEnabled then + begin + with FSelectArea + do R:=fpgRect(Left, Top, Width, Height); + + if PtInSelectArea(R, Point(X, Y)) then + begin + if not ((X = FCol) and (y = FRow)) + then cl := FSelectionColor; + end; + end; + Result := cl; +end; + +procedure TfpgNiceGrid.DrawFixCell(Rc: TfpgRect; Str: string; AFont: string;AFontColor: TfpgColor; AEvent: TOnDrawHeaderEvent); +var + Rt: TfpgRect; + Handled: Boolean; +begin + Handled := False; + with Canvas do + begin + Font := fpgGetFont(AFont); + if not FEnabled then + SetTextColor(FHeaderDarkColor) + else SetTextColor(AFontColor); + + if Assigned(AEvent) + then AEvent(Self, Canvas, Rc, Str, Handled); + if Handled + then Exit; + + SetColor(FHeaderColor); + FillRectangle(Rc); + SetColor(FHeaderDarkColor); + DrawRectangle(Rc); + + // Draw text immediately + Rt := fpgRect(Rc.Left + 2, Rc.Top + 2, Rc.Width - 4, Rc.Height - 4); + DrawStringMulti(Canvas, Str, Rt, haCenter, vaCenter); + + // cosmetics + SetColor(FHeaderLightColor); + DrawLine(Rc.Left + 1, Rc.Bottom - 2, Rc.Left + 1, Rc.Top + 1); + DrawLine(Rc.Left + 1, Rc.Top + 1, Rc.Right - 1, Rc.Top + 1); + + if not FFlat then + begin + SetColor(clBlack); + DrawLine(Rc.Right - 2, Rc.Top + 1,Rc.Right - 2, Rc.Bottom - 2); + DrawLine(Rc.Right - 2, Rc.Bottom - 2,Rc.Left, Rc.Bottom - 2); + end; + end; +end; + +procedure TfpgNiceGrid.RenderGutter; +const + ArrowWidth = 8; +var + x: Integer; + R, Dummy: TfpgRect; + Str: string; + l, t, m: Integer; + GutterBox: TfpgRect; +begin + if (FGutterKind = gkNone) + then Exit; + CopyRect(GutterBox, CellBox); + GutterBox.Left := 0; + for x := 0 to FRowCount-1 do + begin + R := fpgRect(-1, (x * FDefRowHeight) -1, FGutterWidth, FDefRowHeight +1); + OffsetRect(R, 2, -FVertOffset + FixedHeight); + if IntersectRect(Dummy, R, GutterBox) then + begin + case FGutterKind of + gkBlank, gkPointer: + Str := ''; + gkNumber: + Str := IntToStr(x + 1); + gkString: + if (x > FGutterStrings.Count-1) + then Str := '' + else Str := FGutterStrings[x]; + end; + DrawFixCell(R, Str, FGutterFont, FGutterFontColor, FOnDrawGutter); + // Draw pointer triangle + if (FGutterKind = gkpointer) and (x = FRow) then + begin + with Canvas do + begin + l := (FGutterWidth - ArrowWidth) div 2; + t := (FDefRowHeight - ArrowWidth) div 2; + m := R.Top + (FDefRowHeight div 2); + SetColor(FHeaderDarkColor); + DrawLine(l, R.Bottom - t,l, R.Top + t); + DrawLine(l, R.Top + t,l + ArrowWidth, m); + SetColor(FHeaderLightColor); + DrawLine(l + ArrowWidth, m,l, R.Bottom - t); + end; + end; + end; + end; +end; + +procedure TfpgNiceGrid.RenderHeader; +var + x: Integer; + R, Dummy: TfpgRect; + P: PHeaderInfo; +begin + for x := 0 to FHeaderInfos.Count-1 do + begin + P := PHeaderInfo(FHeaderInfos[x]); + R := fpgRect( + GetColCoord(P^.Rc.Left)-1 , + FDefRowHeight * P^.Rc.Top, + GetColCoord(P^.Rc.Width+1) - GetColCoord(P^.Rc.Left)+1, + FDefRowHeight * (P^.Rc.Height+1)+1 + ); + OffsetRect(R, -FHorzOffset + FixedWidth, 0); + if IntersectRect(Dummy, R, fpgRect(1,1,ClientWidth,ClientHeight)) + then DrawFixCell(R, P^.Str, FHeaderFont, FHeaderFontColor, FOnDrawHeader); + end; + R := fpgRect(1,1, FixedWidth, FixedHeight ); + DrawFixCell(R, '', FHeaderFont, FHeaderFontColor, FOnDrawHeader); +end; + +procedure TfpgNiceGrid.RenderFooter; +var + x: Integer; + R, Dummy: TfpgRect; + FooterBottom: Integer; + ARight: Integer; +begin + FooterBottom := FooterTop + FDefRowHeight+1; + for x := 0 to FColumns.Count-1 do + begin + R := fpgRect(GetColCoord(x)-1, + FooterTop, + GetColCoord(x+1)-GetColCoord(x)+1, + FooterBottom-FooterTop+1 + ); + OffsetRect(R, -FHorzOffset + FixedWidth, 0); + + if IntersectRect(Dummy, R, fpgRect(1,1,ClientWidth,ClientHeight)) + then DrawFixCell(R, FColumns[x].FFooter, FFooterFont, FFooterFontColor, FOnDrawFooter); + end; + R := fpgRect(1, FooterTop, FixedWidth, FooterBottom-FooterTop); + DrawFixCell(R, '', FFooterFont, FFooterFontColor, FOnDrawFooter); + ARight := Min(AllWidth, ClientWidth); + + R := fpgRect(1, FooterBottom, ARight-1, ClientHeight-FooterBottom+1); + DrawFixCell(R, '', FFooterFont, FFooterFontColor, FOnDrawFooter); +end; + +procedure TfpgNiceGrid.DrawCell(X, Y: Integer); +var + Rc, Dummy: TfpgRect; + Column: TfpgNiceColumn; + Handled: Boolean; +begin + Handled := False; + Rc := GetCellRect(x, y); + OffsetRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight); + if IntersectRect(Dummy, Rc, CellBox) then + begin + Column := FColumns[x]; + with Canvas do + begin + Font:=fpgGetFont(Column.Font); + SetTextColor(Column.FontColor); + + if not FEnabled then + SetTextColor(FGridColor); + + SetColor(GetCellColor(X, Y)); + if Assigned(FOnDrawCell) + then FOnDrawCell(Self, Canvas, X, Y, Rc, Handled); + + if not Handled then + begin + FillRectangle(Rc); + if FShowGrid then + begin + SetColor(FGridColor); + inc(Rc.Width,1); + inc(Rc.Height,1); + DrawRectangle(Rc); + end; + InflateRect(Rc, -4, -2); + DrawStringUni(Canvas, SafeGetCell(x, y), Rc, Column.HorzAlign, Column.VertAlign); + end; + end; + end; +end; + +function TfpgNiceGrid.FastDrawCell(X, Y: Integer): TPoint; +var + R, Dummy: TfpgRect; + Handled: Boolean; + Column: TfpgNiceColumn; +begin + Handled := False; + Result := Point(-1, -1); + R := GetCellRect(x, y); + OffsetRect(R, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight); + if IntersectRect(Dummy, R, CellBox) then + begin + Column := FColumns[x]; + with Canvas do + begin + Font:=fpgGetFont(Column.Font); + end; + if Assigned(FOnDrawCell) + then FOnDrawCell(Self, Canvas, X, Y, R, Handled); + if not Handled then + begin + with Canvas do + begin + InflateRect(R, -4, -2); + FillRectangle(R); + end; + Result := DrawStringUni(Canvas, SafeGetCell(x, y), R, Column.HorzAlign, + Column.VertAlign); + end; + end; +end; + +procedure TfpgNiceGrid.DrawSelection; +var + R, R1, R2: TfpgRect; + HOffset, VOffset: Integer; + +begin + + if (FCol = -1) or (FRow = -1) + then Exit; + + HOffset := - FHorzOffset + FixedWidth; + VOffset := - FVertOffset + FixedHeight; + R1 := GetCellRect(FSelectArea.Left, FSelectArea.Top); + R2 := GetCellRect(FSelectArea.Width, FSelectArea.Height); + R := fpgRect(R1.Left+2, R1.Top+2, R2.Right - R1.Left, R2.Bottom - R1.Top); + OffsetRect(R, HOffset, VOffset); + + with Canvas do + begin + if Focused then + SetColor(clBlack) + else + SetColor(FGridColor); + SetLineStyle(2, lsDash); + DrawRectangle(R); + SetLineStyle(1, lsSolid); + SetColor(clRed); + case SmallBoxPos of + 0: SmallBox := fpgRect(R.Right - 3, R.Bottom - 3, 6,6); + 1: SmallBox := fpgRect(R.Right - 3, R.Top + 2, 6,8); + 2: SmallBox := fpgRect(R.Left - 3 + 5, R.Bottom - 3,8,3); + end; + + FillRectangle(SmallBox); + SmallBoxPos := 0; // Reset to Right Bottom + end; +end; + +procedure TfpgNiceGrid.ClearUnused; +var + t: Integer; +begin + if (AllWidth < ClientWidth) then + begin + with Canvas do + begin + SetColor(FColor); + FillRectangle(fpgRect(AllWidth, 0, ClientWidth, ClientHeight)); + end; + end; + if FShowFooter + then Exit; + if (AllHeight < ClientHeight) then + begin + with Canvas do + begin + SetColor(FColor); + FillRectangle(fpgRect(0, AllHeight, ClientWidth, ClientHeight)); + end; + end; + if ((FMaxVScroll - FVertOffset) < FDefRowHeight) then + begin + with Canvas do + begin + SetColor(FColor); + t := FixedHeight + (((ClientHeight - FixedHeight) div FDefRowHeight) * FDefRowHeight); + FillRectangle(fpgRect(0, t, ClientWidth, ClientHeight)); + end; + end; +end; + +procedure TfpgNiceGrid.HandlePaint; +var + x, y: Integer; + R1: TfpgRect; +begin + if FUpdating then Exit; + if not (HasHandle) then Exit; + Canvas.Setcolor(FColor); + Canvas.FillRectangle(fpgRect(0, 0, Width, Height)); + + if (FRowCount > 0) then + begin + for x := 0 to ColCount-1 do + begin + if FColumns[x].FVisible then + begin + for y := 0 to FRowCount-1 do + begin + if (GetObject(x, y) <> TObject(MergeID)) then + DrawCell(X, Y); + end; + end; + end; + for x := 0 to Mergeds.Count-1 do + DrawMergedCell(x); + if FEnabled then + DrawSelection; + end + else + ClearUnused; + RenderGutter; + RenderHeader; + if FShowFooter then RenderFooter; + // The little square in the bottom right corner + if FHScrollBar.Visible and FVScrollBar.Visible then + begin + Canvas.ClearClipRect; + Canvas.SetColor(clButtonFace); + R1:=fpgRect(HScrollBar.Left+FHScrollBar.Width, + FVScrollBar.Top+FVScrollBar.Height, + FVScrollBar.Width, + FHScrollBar.Height); + Canvas.FillRectangle(R1); + SetColor(FHeaderLightColor); + Canvas.DrawLine(R1.Left + 1, R1.Bottom+1, R1.Left + 1, R1.Top + 1); + Canvas.DrawLine(R1.Left + 1, R1.Top + 1, R1.Right - 1, R1.Top + 1); + end; + Canvas.Setcolor(clBlack); + Canvas.DrawRectangle(fpgRect(0, 0, Width, Height)); +end; + +procedure TfpgNiceGrid.UpdateHeader; +var + P: PHeaderInfo; + x, y: Integer; + t: TStringList; + s: string; + LastX: TList; + LastY: PHeaderInfo; + Blank: PHeaderInfo; + +begin + ClearHeaderInfos; + + LastX := TList.Create; + t := TStringList.Create; + + Blank := New(PHeaderInfo); + Blank^.Str := '^%%%%%^******^'; + Blank^.Rc:=fpgRect(0,0,0,0); + + while (LastX.Count < FHeaderLine) + do LastX.Add(Blank); + + P := nil; + for x := 0 to FColumns.Count-1 do + begin + if not FColumns[x].FVisible then + begin + for y := 0 to FHeaderLine-1 + do LastX[y] := Blank; + Continue; + end; + t.Text := StringReplace(FColumns[x].Title, '|', #13, [rfReplaceAll]); + while (t.Count < FHeaderLine) do + begin + if (t.Count = 0) + then t.Add('') + else t.Add( t[t.Count-1]); + end; + LastY := Blank; + for y := 0 to FHeaderLine-1 do + begin + s := t[y]; + if (s = LastY^.Str) then + begin + LastY^.Rc.Height := Min(FHeaderLine-1, Max(LastY^.Rc.Height, y)); + end + else + begin + if (s = PHeaderInfo(LastX[y])^.Str) then + begin + P := PHeaderInfo(LastX[y]); + P^.Rc.Width := P^.Rc.Width + 1; + end + else + begin + P := New(PHeaderInfo); + P^.Rc := fpgRect(x, y, x,0); + P^.Str := s; + FHeaderInfos.Add(P); + end; + LastX[y] := P; + end; + LastY := P; + end; + end; + + LastX.Free; + t.Free; + Dispose(Blank); + Recalculate; +end; + +function TfpgNiceGrid.GetColCoord(I: Integer): Integer; +var + x: Integer; + Column: TfpgNiceColumn; +begin + Result := 0; + for x := 0 to I-1 do + begin + Column := FColumns[x]; + if Column.FVisible + then Result := Result + Column.FWidth; + end; +end; + +function TfpgNiceGrid.GetCellRect(x, y: Integer): TfpgRect; +var + l, t, w, h: Integer; +begin + if (x = -1) or (y = -1) then + begin + Result := fpgRect(0, 0, 0, 0); + Exit; + end; + l := GetColCoord(x); + t := FDefRowheight * y; + w := 0; + if (FColumns[x].FVisible) + then w := FColumns[x].FWidth; + h := FDefRowHeight; + Result := fpgRect(l-1, t-1, w, h); +end; + +function TfpgNiceGrid.CellRectToClient(R: TfpgRect): TfpgRect; +begin + Result := R; + OffsetRect(Result, - FHorzOffset + FixedWidth, - FVertOffset + FixedHeight); +end; + +function TfpgNiceGrid.GetCellAtPos(X, Y: Integer): TPoint; +var + ax, ay: Integer; +begin + ax := (FHorzOffset + X) - FixedWidth; + ay := (FVertOffset + Y) - FixedHeight; + Result.X := 0; + while (GetColCoord(Result.X) < ax) do + begin + Result.X := Result.X + 1; + if (Result.X > FColumns.Count-1) + then Break; + end; + Result.X := Max(0, Result.X - 1); + Result.Y := Max(0, Min(ay div FDefRowHeight, FRowCount-1)); +end; + +function TfpgNiceGrid.GetColFromX(X: Integer): Integer; +var + ax: Integer; +begin + if (X < FixedWidth) then + begin + Result := -1; + Exit; + end; + Result := 0; + ax := (FHorzOffset + X) - FixedWidth; + while (GetColCoord(Result) < ax) do + begin + Result := Result + 1; + if (Result > FColumns.Count-1) + then Break; + end; + Result := Result - 1; + if (Result > FColumns.Count-1) or (Result < 0) + then Result := -1; +end; + +function TfpgNiceGrid.GetRowFromY(Y: Integer): Integer; +var + ay: Integer; +begin + if (Y < FixedHeight) then + begin + Result := -1; + Exit; + end; + ay := (FVertOffset + Y) - FixedHeight; + Result := ay div FDefRowHeight; + if (Result > FRowCount-1) + then Result := -1; +end; + +function TfpgNiceGrid.SafeGetCell(X, Y: Integer): string; +var + t: TStringList; +begin + Result := ''; + t := TStringList(Columns[X].FStrings); + if (Y < t.Count) + then Result := t[Y]; +end; + +function TfpgNiceGrid.GetCell(X, Y: Integer): string; +var + t: TStrings; +begin + Result := ''; + if (X > ColCount-1) or (Y > FRowCount-1) + then raise Exception.Create('Cell Index out of bound.'); + t := Columns[X].FStrings; + if (Y < t.Count) + then Result := t[Y]; +end; + +procedure TfpgNiceGrid.InternalSetCell(X, Y: Integer; Value: string; + FireOnChange: Boolean); +var + t: TStringList; + s: string; + CanChange: Boolean; +begin + if (ColCount = 0) or (FRowCount = 0) + then Exit; + if FireOnChange and FColumns[X].FReadOnly + then Exit; + if (X > ColCount-1) or (Y > FRowCount-1) + then raise Exception.Create('Cell Index out of bound.'); + t := TStringList(FColumns[X].FStrings); + while (Y > t.Count-1) + do t.Add(''); + if (t[Y] = Value) + then Exit; + if FireOnChange then + begin + s := Value; + CanChange := True; + if Assigned(FOnCellChanging) + then FOnCellChanging(Self, X, Y, CanChange); + if not CanChange + then Exit; + if Assigned(FOnCellChange) + then FOnCellChange(Self, X, Y, s); + t[Y] := s; + end else + t[Y] := Value; + if (not FUpdating) and (not IsEditing) then + FastDrawCell(X, Y); +end; + +procedure TfpgNiceGrid.SetCell(X, Y: Integer; Value: string); +begin + InternalSetCell(X, Y, Value, False); +end; + +procedure TfpgNiceGrid.BeginUpdate; +begin + FUpdating := True; +end; + +procedure TfpgNiceGrid.EndUpdate; +begin + FUpdating := False; + UpdateHeader; + Invalidate; +end; + +procedure TfpgNiceGrid.SetFlat(Value: Boolean); +begin + if (FFlat <> Value) then + begin + FFlat := Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetColor(Value: TfpgColor); +begin + if (FColor <> Value) then + begin + FColor := Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetAlternateColor(Value: TfpgColor); +begin + if (FAlternateColor <> Value) then + begin + FAlternateColor := Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetGridColor(Value: TfpgColor); +begin + if (FGridColor <> Value) then + begin + FGridColor := Value; + Invalidate; + end; +end; + +function TfpgNiceGrid.GetColWidths(Idx: Integer): Integer; +begin + Result := FColumns[Idx].FWidth; +end; + +procedure TfpgNiceGrid.SetColWidths(Idx, Value: Integer); +begin + if not FAutoColWidth then + begin + if (ColWidths[Idx] <> Value) + then FColumns[Idx].Width := Value; + end; +end; + +procedure TfpgNiceGrid.SetAutoColWidth(Value: Boolean); +begin + if (FAutoColWidth <> Value) then + begin + FAutoColWidth := Value; + Recalculate; + Invalidate; + UpdateScrollbars; + end; +end; + +procedure TfpgNiceGrid.SetDefColWidth(Value: Integer); +begin + if (FDefColWidth <> Value) then + begin + FDefColWidth := Value; + if not FAutoColWidth then + begin + Recalculate; + Invalidate; + end; + end; +end; + +procedure TfpgNiceGrid.SetDefRowHeight(Value: Integer); +begin + if (FDefRowHeight <> Value) then + begin + FDefRowHeight := Value; + FSmallChange := Value; + FLargeChange := Value * 5; + Recalculate; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetFitToWidth(Value: Boolean); +begin + if (FFitToWidth <> Value) then + begin + FFitToWidth := Value; + FHorzOffset := 0; + Recalculate; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetHeaderColor(Value: TfpgColor); +begin + if (FHeaderColor <> Value) then + begin + FHeaderColor := Value; + if not FUpdating then + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetHeaderDarkColor(Value: TfpgColor); +begin + if (FHeaderDarkColor <> Value) then + begin + FHeaderDarkColor := Value; + if not FUpdating then + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetHeaderLightColor(Value: TfpgColor); +begin + if (FHeaderLightColor <> Value) then + begin + FHeaderLightColor := Value; + if not FUpdating then + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetHeaderLine(Value: Integer); +begin + if (FHeaderLine <> Value) then + begin + FHeaderLine := Value; + UpdateHeader; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetSelectionColor(Value: TfpgColor); +begin + if (FSelectionColor <> Value) then + begin + FSelectionColor := Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +var + l, t, r, b: Integer; + x, y: Integer; + Empty: Boolean; + Str: string; + Old: Integer; + OldS: string; + + procedure UpdateColRow; + begin + FUpdating := True; + BuffString := ''; + FCol2 := FCol; + FRow2 := FRow; + EnsureVisible(FCol, FRow); + FUpdating := False; + SetSelectArea(fpgRect(FCol, FRow, FCol, FRow)); + ColRowChanged; + SetScrollBar(FVScrollBar,FMaxVScroll, FVertOffset,FDefRowHeight); + SetScrollBar(FHScrollBar, FMaxHScroll, FHorzOffset, 1); + end; + + procedure UpdateSelectArea; + begin + l := Min(FCol2, FCol); + t := Min(FRow2, FRow); + r := Max(FCol2, FCol); + b := Max(FRow2, FRow); + SetSelectArea(fpgRect(l, t, r, b)); + EnsureVisible(FCol2, FRow2); + end; + +begin + if not FEnabled + then Exit; + + if (ColCount = 0) or (FRowCount = 0) + then Exit; + + inherited HandleKeyPress(keycode, shiftstate, consumed); + + Consumed := true; + if (ssCtrl in shiftstate) then + begin + case KeyCode of + + Ord('X'), Ord('x'): + if not FReadOnly then CutToClipboard; + + Ord('C'), Ord('c'): + CopyToClipboard; + + Ord('V'), Ord('v'): + if not FReadOnly + then PasteFromClipboard; + + Ord('E'), Ord('e'): + begin + if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then + begin + IsEditing := True; + FEdit.ShowEdit(FCol, FRow); + end; + end; + + keyHome : + begin + FCol := GetFirstVisible; + FRow := 0; + UpdateColRow; + end; + + keyEnd : + begin + FCol := GetLastVisible; + FRow := FRowCount-1; + UpdateColRow; + end; + + keyDelete : + begin + if not FReadOnly and (FRowCount > 1) then + begin + Old := FRow; + DeleteRow(FRow); + if Assigned(FOnDeleteRow) + then FOnDeleteRow(Self, Old); + UpdateColRow; + end; + end; + + keyInsert: + begin + if not FReadOnly then + begin + InsertRow(Max(0, FRow)); + if Assigned(FOnInsertRow) + then FOnInsertRow(Self, FRow); + UpdateColRow; + end; + end; + else Consumed:=false; + end; {case} + end + else + if (ssShift in ShiftState) then + begin + case KeyCode of + keyLeft: + begin + FCol2 := Max(GetPrevVisible(FCol2), GetFirstVisible); + UpdateSelectArea; + end; + + keyRight: + begin + FCol2 := Min(GetNextVisible(FCol2), GetLastVisible); + UpdateSelectArea; + end; + + keyUp: + begin + FRow2 := Max(FRow2 - 1, 0); + UpdateSelectArea; + end; + + keyDown: + begin + FRow2 := Min(FRow2 + 1, FRowCount-1); + UpdateSelectArea; + end; + else Consumed:=false; + end; {case} + + end else + begin + case KeyCode of + keyHome: + begin + FCol := GetFirstVisible; + UpdateColRow; + end; + + keyEnd: + begin + FCol := GetLastVisible; + UpdateColRow; + end; + + keyPrior: + begin + FRow := 0; + UpdateColRow; + end; + + keyNext: + begin + FRow := FRowCount-1; + UpdateColRow; + end; + + keyLeft: + begin + FCol := Max(GetPrevVisible(FCol), GetFirstVisible); + UpdateColRow; + end; + + keyRight: + begin + FCol := Min(GetNextVisible(FCol), GetLastVisible); + UpdateColRow; + end; + + keyUp: + begin + if FAutoAddRow and (FRow = (FRowCount-1)) and (FRow > 0) and not FReadOnly then + begin + Empty := True; + for x := 0 to ColCount-1 do + begin + if (SafeGetCell(x, FRowCount-1) <> '') then + begin + Empty := False; + Break; + end; + end; + if Empty then + begin + RowCount := RowCount - 1; + FRow := FRowCount - 1; + if Assigned(FOnDeleteRow) + then FOnDeleteRow(Self, FRowCount); + end else + FRow := Max(0, FRow - 1); + end else + FRow := Max(0, FRow - 1); + UpdateColRow; + end; + + keyDown: + begin + if FAutoAddRow and (FRow = (FRowCount-1)) and not FReadOnly then + begin + Inc(FRow); + RowCount := RowCount + 1; + if Assigned(FOnInsertRow) + then FOnInsertRow(Self, FRow); + end + else + FRow := Min(FRowCount - 1, FRow + 1); + UpdateColRow; + end; + + keyReturn, keyPEnter: + begin + OldS := GetCell(Col, Row); + Str := OldS; + if Assigned(FOnCellAssignment) + then FOnCellAssignment(Self, Col, Row, Str); + if (Str <> Olds) + then InternalSetCell(Col, Row, Str, True); + if (FSelectArea.Left = FSelectArea.Width) and + (FSelectArea.Top = FSelectArea.Height) then + begin + FRow := Min(FRowCount - 1, FRow + 1); + UpdateColRow; + end + else + begin + if (FCol = FSelectArea.Width) and (FRow = FSelectArea.Height) then + begin + FCol := FSelectArea.Left; + FRow := FSelectArea.Top; + end + else if (FRow = FSelectArea.Height) then + begin + FCol := FCol + 1; + FRow := FSelectArea.Top; + end + else + begin + FRow := Row + 1; + end; + BuffString := ''; + EnsureVisible(FCol, FRow); + ColRowChanged; + end; + end; + + keyDelete: + begin + if (BuffString = '') then + begin + if not FReadOnly then + begin + FUpdating := True; + for x := SelectArea.Left to SelectArea.Width do + begin + for y := SelectArea.Top to SelectArea.Height + do InternalSetCell(X, Y, '', True); + end; + FUpdating := False; + end; + end; + end; + else Consumed:=false; + end; {case} + + end; + if consumed then Invalidate; +end; + + +function TfpgNiceGrid.GetHitTestInfo(X, Y: Integer): TGridHitTest; +var + a, i1, i2: Integer; + ax, ay: Integer; + IsSizing: Boolean; + +begin + Result := gtNone; + IsSizing := False; + + ax := (FHorzOffset + X) - FixedWidth; + ay := (FVertOffset + Y) - FixedHeight; + + if not FAutoColWidth then + begin + for a := 1 to ColCount do + begin + i1 := GetColCoord(a); + i2 := X + FHorzOffset - FixedWidth; + if (i2 > (i1-2)) and (i2 < (i1+2)) then + begin + SizingCol := a - 1; + IsSizing := FColumns[SizingCol].FCanResize; + Break; + end; + end; + end; + + if PtInRect(SmallBox, Point(X, Y)) + then Result := gtSmallBox else + if IsSizing + then Result := gtColSizing else + if ((X < FixedWidth) and (Y < FixedHeight)) + then Result := gtLeftTop else + if ((X < FixedWidth) and (Y > FixedHeight) and (ay < BodyHeight)) + then Result := gtLeft else + if ((Y < FixedHeight) and (X > FixedWidth) and (ax < BodyWidth)) + then Result := gtTop else + if ((X > FixedWidth) and (Y > FixedHeight) and (ax < BodyWidth) and (ay < BodyHeight)) + then Result := gtCell; + +end; + +procedure TfpgNiceGrid.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); +var + Pt: TPoint; +begin + if not FEnabled then + begin + inherited; + Exit; + end; + if (MouseCursor = mcMove) then + begin + SizingColX := GetColCoord(SizingCol); + end else + if (MouseCursor = mcHand) then + begin + SmallBoxArea := FSelectArea; + end + else + if (MouseCursor = mcSizeNWSE) then + begin + FRow := 0; + FCol := 0; + BuffString := ''; + EnsureVisible(0, 0); + FCol2 := ColCount-1; + FRow2 := FRowCount-1; + SetSelectArea(fpgRect(0, 0, ColCount-1, FRowCount-1)); + ColRowChanged; + end + else + if (MouseCursor = mcSizeEW) then + begin + FRow := GetRowFromY(Y); + FCol := 0; + LastHover := FRow; + BuffString := ''; + EnsureVisible(FCol, FRow); + FCol2 := ColCount-1; + FRow2 := FRow; + SmallBoxPos := 2; + AdjustSelection(fpgRect(0, FRow, ColCount-1, FRow), True); + ColRowChanged; + if Assigned(OnGutterClick) + then FOnGutterClick(Self, FRow, mbLeft, ShiftState); + end + else + if (MouseCursor = mcSizeNS) then + begin + FCol := GetColFromX(X); + FRow := 0; + LastHover := FCol; + BuffString := ''; + EnsureVisible(FCol, FRow); + FCol2 := FCol; + FRow2 := FRowCount-1; + SmallBoxPos := 1; + AdjustSelection(fpgRect(FCol, 0, FCol, FRowCount-1), True); + ColRowChanged; + if Assigned(FOnHeaderClick) + then FOnHeaderClick(Self, FCol, mbLeft, ShiftState); + end + else + if (MouseCursor = mcCross) then + begin + BuffString := ''; + Pt := GetCellAtPos(X, Y); + if (Pt.X = FCol) and (Pt.Y = FRow) then + begin + EnsureVisible(FCol, FRow); + if (not FReadOnly) and (not FColumns[FCol].FReadOnly) then + begin + IsEditing := True; + FEdit.ShowEdit(FCol, FRow); + end; + end + else + if (Pt.X <> -1) and (pt.Y <> -1) then + begin + FEdit.HideEdit; + IsEditing := False; + + EnsureVisible(Pt.X, Pt.Y); + FCol := Pt.X; + FRow := Pt.Y; + BuffString := ''; + FCol2 := FCol; + FRow2 := FRow; + SetSelectArea(fpgRect(FCol, FRow, FCol, FRow)); + end; + ColRowChanged; + end; + + CaptureMouse; + Invalidate; + inherited; +end; + +procedure TfpgNiceGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); +var + Total2Col: Integer; + Suggested: Integer; + Pt: TPoint; + l, t, r, b: Integer; + i: Integer; + +begin + if not FEnabled then + begin + MouseCursor := mcDefault; + inherited; + Exit; + end; + + if (ssLeft in ShiftState) then + begin + + if (MouseCursor = mcCross) then + begin + Pt := GetCellAtPos(X, Y); + if (Pt.X <> -1) and (Pt.Y <> -1) then + begin + l := Min(Pt.X, FCol); + t := Min(Pt.Y, FRow); + r := Max(Pt.X, FCol); + b := Max(Pt.Y, FRow); + FCol2 := Pt.X; + FRow2 := Pt.Y; + SetSelectArea(fpgRect(l, t, r, b)); + EnsureVisible(FCol2, FRow2); + Invalidate; + end; + end else + + if (MouseCursor = mcHand) then + begin + Pt := GetCellAtPos(X, Y); + if (Pt.X <> -1) and (Pt.Y <> -1) then + begin + l := Min(Pt.X, SmallBoxArea.Left); + t := Min(Pt.Y, SmallBoxArea.Top); + r := Max(Pt.X, SmallBoxArea.Width); + b := Max(Pt.Y, SmallBoxArea.Height); + FCol2 := Pt.X; + FRow2 := Pt.Y; + SetSelectArea(fpgRect(l, t, r, b)); + EnsureVisible(FCol2, FRow2); + Invalidate; + end; + end else + + if (MouseCursor = mcSizeEW) then + begin + i := GetRowFromY(Y); + if (i <> -1) and (i <> LastHover) then + begin + LastHover := i; + t := Min(i, FRow); + b := Max(i, FRow); + FRow2 := i; + SmallBoxPos := 2; + AdjustSelection(fpgRect(0, t, ColCount-1, b), True); + Invalidate; + end; + end else + + if (MouseCursor = mcSizeNS) then + begin + i := GetColFromX(X); + if (i <> -1) and (i <> LastHover) then + begin + LastHover := i; + l := Min(i, FCol); + r := Max(i, FCol); + FCol2 := i; + SmallBoxPos := 1; + AdjustSelection(fpgRect(l, 0, r, FRowCount-1), True); + Invalidate; + end; + end else + + if (MouseCursor = mcMove) then + begin + Suggested := Max(5, X + FHorzOffset - SizingColX - FixedWidth); + if FFitToWidth then + begin + if (SizingCol = ColCount-1) or (SizingCol = -1) then + begin + inherited; + Exit; + end; + Total2Col := (ClientWidth - FixedWidth) - (TotalWidth - Columns[SizingCol].FWidth - Columns[SizingCol+1].FWidth); + if (Total2Col > 10) then + begin + Columns[SizingCol].FWidth := Suggested; + Columns[SizingCol+1].FWidth := Total2Col - Suggested; + end; + if (Columns[SizingCol+1].FWidth < 5) then + begin + Columns[SizingCol].FWidth := Total2Col - 5; + Columns[SizingCol+1].FWidth := 5; + end; + end else + begin + Columns[SizingCol].FWidth := Suggested; + end; + Recalculate; + Invalidate; + end; + end + else + MouseCursor := CursorArray[GetHitTestInfo(X, Y)]; + inherited; +end; + +procedure TfpgNiceGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +var + Ls: TList; + ax, ay: Integer; + l, t, w, h: Integer; + + function GetCopy(nx, ny: Integer): string; + var + ix, iy: Integer; + begin + ix := nx; + iy := ny; + while (ix < l) + do ix := ix + w; + while (iy < t) + do iy := iy + h; + ix := ((ix - l) mod w) + l; + iy := ((iy - t) mod h) + t; + Result := SafeGetCell(TfpgNiceColumn(Ls[ix]).Index, iy); + end; + +begin + if (MouseCursor = mcHand) then + begin + if FReadOnly then + begin + SmallBoxArea := fpgRect(-1, -1, -1,-1); + Invalidate; + end + else + begin + FUpdating := True; + Ls := TList.Create; + for ax := FSelectArea.Left to FSelectArea.Width do + if FColumns[ax].FVisible + then Ls.Add(FColumns[ax]); + l := 0; + for ax := 0 to Ls.Count-1 do + begin + if (TfpgNiceColumn(Ls[ax]).Index = SmallBoxArea.Left) then + begin + l := ax; + Break; + end; + end; + t := SmallBoxArea.Top; + w := (SmallBoxArea.Width - SmallBoxArea.Left) + 1; + h := (SmallBoxArea.Height- SmallBoxArea.Top) + 1; + for ax := 0 to Ls.Count-1 do + for ay := FSelectArea.Top to FSelectArea.Height + do InternalSetCell(TfpgNiceColumn(Ls[ax]).Index, ay, GetCopy(ax, ay), True); + Ls.Free; + SmallBoxArea := fpgRect(-1, -1, -1,-1); + BuffString := ''; + FUpdating := False; + Invalidate; + end; + end; + + MouseCursor := CursorArray[GetHitTestInfo(X, Y)]; + ReleaseMouse; + LastHover := -1; + + inherited; +end; + +procedure TfpgNiceGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +begin + inherited HandleMouseScroll(x, y, shiftstate, delta); + FVertOffset := FVertOffset + (delta*FDefRowHeight); + FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset)); + NormalizeVertOffset; + SetScrollBar(FVScrollBar, FMaxVScroll, FVertOffset, FDefRowHeight); + Invalidate; +end; + +procedure TfpgNiceGrid.SetColumns(Value: TfpgNiceColumns); +begin + FColumns.Assign(Value); +end; + +function TfpgNiceGrid.CreateColumn: TfpgNiceColumn; +begin + Result := TfpgNiceColumn.Create(Columns); +end; + +procedure TfpgNiceGrid.UpdateColumn(Index: Integer); +var + i: Integer; +begin + for i := 0 to FRowCount-1 do + if (GetObject(Index, i) <> TObject(MergeID)) then + DrawCell(Index, i); +end; + +procedure TfpgNiceGrid.UpdateColumns; +begin + UpdateHeader; + Invalidate; +end; + +function TfpgNiceGrid.GetColCount: Integer; +begin + Result := FColumns.Count; +end; + +function TfpgNiceGrid.TotalWidth: Integer; +var + x: Integer; +begin + Result := 0; + for x := 0 to FColumns.Count-1 do + begin + if FColumns[x].FVisible + then Result := Result + FColumns[x].FWidth; + end; +end; + +procedure TfpgNiceGrid.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + if (csLoading in ComponentState) then + Exit; //==> + if csUpdating in ComponentState then + Exit; //==> + Recalculate; + if (FColumns.Count > 0) + then EnsureVisible(FCol, FRow); + if HasHandle then + UpdateScrollBars; +end; + +procedure TfpgNiceGrid.UpdateScrollBars; +var + HWidth: integer; + VHeight: integer; + HeightAvail: integer; + vw: integer; + cw: integer; + i: integer; +begin + VHeight := Height -2; + HWidth := Width - 2; + + if FVScrollBar.Visible then + vw := Width - FVScrollBar.Width + else + vw := Width; + + cw := 0; + for i := 0 to FColumns.Count-1 do + cw := cw + FColumns[i].Width; + + // This needs improving while resizing + if cw > vw then + FHScrollBar.Visible := true + else + begin + FHScrollBar.Visible := False; + FHorzOffset:=0; + end; + + HeightAvail := Height - FixedHeight; + if FShowFooter + then HeightAvail := HeightAvail - FDefRowHeight; + + if FVScrollBar.Visible then + begin + Dec(HWidth, FVScrollBar.Width); + if FRowCount > 0 then + FVScrollBar.SliderSize := HeightAvail / BodyHeight + else + FVScrollBar.SliderSize := 0; + FVScrollBar.Max:= FMaxVScroll; + FVScrollBar.Position:=FVertOffset; + FVScrollBar.RepaintSlider; + end; + + if FHScrollBar.Visible then + begin + Dec(VHeight, FHScrollBar.Height); + FHScrollBar.SliderSize := 0.2; + FHScrollBar.RepaintSlider; + end; + + FHScrollBar.Top := Height -FHScrollBar.Height-1; + FHScrollBar.Left := 1; + FHScrollBar.Width := HWidth; + + FVScrollBar.Top := 1; + FVScrollBar.Left := Width - FVScrollBar.Width-1; + FVScrollBar.Height := VHeight; + + FVScrollBar.UpdateWindowPosition; + FHScrollBar.UpdateWindowPosition; +end; + +procedure TfpgNiceGrid.SetShowGrid(Value: Boolean); +begin + if (FShowGrid <> Value) then + begin + FShowGrid := Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetShowFooter(const Value: Boolean); +begin + if (FShowFooter <> Value) then + begin + FShowFooter := Value; + Recalculate; + Invalidate; + UpdateScrollBars; + end; +end; + +procedure TfpgNiceGrid.Clear; +var + x: Integer; +begin + for x := 0 to ColCount-1 + do FColumns[x].FStrings.Clear; + Invalidate; +end; + +procedure TfpgNiceGrid.SetHorzOffset(Value: Integer); +begin + if (FHorzOffset <> Value) then + begin + FHorzOffset := Max(0, Min(FMaxHScroll, Value)); + SetScrollBar(FHScrollBar, 0, FHorzOffset, 1); + end; +end; + +procedure TfpgNiceGrid.SetVertOffset(Value: Integer); +begin + if (FVertOffset <> Value) then + begin + FVertOffset := Max(0, Min(FMaxVScroll, Value)); + NormalizeVertOffset; + SetScrollBar(FVScrollBar, 0, FVertOffset, FDefRowHeight); + end; +end; + +procedure TfpgNiceGrid.EnsureVisible(X, Y: Integer); +var + t, b, h: Integer; + l, r: Integer; + Horz, Vert: Boolean; + SuggestedHorz, SuggestedVert: Integer; + +begin + + if (X = -1) or (Y = -1) + then Exit; + + if (AllWidth < ClientWidth) and (AllHeight < ClientHeight) + then Exit; + + SuggestedVert := FVertOffset; + t := FVertOffset div FDefRowHeight; + h := ((ClientHeight - FixedHeight) div FDefRowHeight) - 1; + if FShowFooter + then h := h-1; + b := t + h; + Vert := (Y < t) or (Y > b); + if (Y < t) + then SuggestedVert := Y * FDefRowHeight; + if (Y > b) + then SuggestedVert := (Y - h) * FDefRowHeight; + + SuggestedHorz := FHorzOffset; + l := GetColCoord(X) - FHorzOffset + FixedWidth; + r := l + FColumns[x].FWidth; + Horz := (l < FixedWidth) or (r > ClientWidth); + if (l < FixedWidth) + then SuggestedHorz := Max(0, SuggestedHorz + (l - FixedWidth)); + if (r > ClientWidth) + then SuggestedHorz := Min(FMaxHScroll, SuggestedHorz - (ClientWidth - r) + 1); + + if Vert and not Horz + then SetVertOffset(SuggestedVert) else + + if Horz and not Vert + then SetHorzOffset(SuggestedHorz) else + + if Horz and Vert + then + begin + FHorzOffset := SuggestedHorz; + FVertOffset := SuggestedVert; + SetScrollBar(FHScrollBar, 0, FHorzOffset, 1); + SetScrollBar(FVScrollBar, 0, FVertOffset, FDefRowHeight); + Invalidate; + end; +end; + +function TfpgNiceGrid.HeaderCells(I: Integer): THeaderInfo; +begin + Result := PHeaderInfo(FHeaderInfos[I])^; +end; + +function TfpgNiceGrid.HeaderCellsCount: Integer; +begin + Result := FHeaderInfos.Count; +end; + +procedure TfpgNiceGrid.SetReadOnly(Value: Boolean); +begin + if (FReadOnly <> Value) then + begin + FReadOnly := Value; + end; +end; + +procedure TfpgNiceGrid.SetCol(Value: Integer); +begin + if (FCol <> Value) then + begin + FCol := Value; + FCol2 := Value; + FRow2 := FRow; + BuffString := ''; + SetSelectArea(fpgRect(FCol, FRow, FCol, FRow)); + ColRowChanged; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetRow(Value: Integer); +begin + if (FRow <> Value) then + begin + FRow := Value; + FRow2 := Value; + FCol2 := FCol; + BuffString := ''; + SetSelectArea(fpgRect(FCol, FRow, FCol, FRow)); + ColRowChanged; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.AdjustSelection(Value: TfpgRect; Force: Boolean); +begin + if (FSelectArea = Value) and not Force then + Exit; //==> + FSelectArea := Value; +end; + +procedure TfpgNiceGrid.SetSelectArea(Value: TfpgRect); +begin + AdjustSelection(Value, False); +end; + +procedure TfpgNiceGrid.SetGutterKind(Value: TGutterKind); +var + Old: TGutterKind; +begin + Old := FGutterKind; + if (FGutterKind <> Value) then + begin + FGutterKind := Value; + Recalculate; + if (Old = gkNone) or (Value = gkNone) then + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetGutterWidth(Value: Integer); +begin + if (FGutterWidth <> Value) then + begin + FGutterWidth := Value; + Recalculate; + Invalidate; + UpdateScrollBars; + end; +end; + +procedure TfpgNiceGrid.CopyToClipboard; +var + s: string; + t: TStringList; + x, y: Integer; +begin + t := TStringList.Create; + with Fselectarea do + for y := FSelectArea.Top to FSelectArea.Height do + begin + s := ''; + for x := FSelectArea.Left to FSelectArea.Width do + begin + if FColumns[x].FVisible then + begin + if (x = FSelectArea.Left) + then s := SafeGetCell(X, Y) + else s := s + #9 + SafeGetCell(X, Y); + end; + end; + t.Add(s); + end; + fpgClipboard.Text := t.Text; + t.Free; +end; + +procedure TfpgNiceGrid.CutToClipboard; +var + s: string; + t: TStringList; + x, y: Integer; +begin + FUpdating := True; + t := TStringList.Create; + for y := FSelectArea.Top to FSelectArea.Height do + begin + s := ''; + for x := FSelectArea.Left to FSelectArea.Width do + begin + if FColumns[x].FVisible then + begin + if (x = FSelectArea.Left) + then s := SafeGetCell(X, Y) + else s := s + #9 + SafeGetCell(X, Y); + InternalSetCell(X, Y, '', True); + end; + end; + t.Add(s); + end; + fpgClipboard.Text := t.Text; + t.Free; + FUpdating := False; + Invalidate; +end; + +procedure TfpgNiceGrid.PasteFromClipboard; +var + tr, tc: TStringList; + x, y: Integer; + s: string; + n: Integer; + TabCnt: Integer; + ax, ay: Integer; + ColCnt: Integer; + +begin + FUpdating := True; + tr := TStringList.Create; + tc := TStringList.Create; + tr.Text := fpgClipboard.Text; + TabCnt := 1; + + for y := 0 to tr.Count-1 do + begin + n := 1; + s := tr[y]; + for x := 1 to Length(s) do + if (s[x] = #9) + then Inc(n); + TabCnt := Max(TabCnt, n); + end; + + ColCnt := ColCount; // Just to make it fast + + if (FSelectArea.Left = FSelectArea.Width) and (FSelectArea.Top = FSelectArea.Height) then + begin + + for y := 0 to tr.Count-1 do + begin + tc.Text := StringReplace(tr[y], #9, #13#10, [rfReplaceAll]); + while (tc.Count < TabCnt) + do tc.Add(''); + x := 0; + ax := FCol; + while (x < tc.Count) do + begin + ay := FRow + y; + if FColumns[ax].FVisible then + begin + if (ax < ColCnt) and (ay < FRowCount) + then InternalSetCell(ax, ay, tc[x], True); + Inc(x); + end; + Inc(ax); + end; + end; + + end else + begin + + ay := FSelectArea.Top; + while (ay <= FSelectArea.Height) do + begin + tc.Text := StringReplace(tr[(ay - FSelectArea.Top) mod tr.Count], #9, #13#10, [rfReplaceAll]); + while (tc.Count < TabCnt) + do tc.Add(''); + ax := FSelectArea.Left; + x := 0; + while (ax <= FSelectArea.Width) do + begin + if FColumns[ax].FVisible then + begin + InternalSetCell(ax, ay, tc[x], True); + Inc(x); + if (x = tc.Count) + then x := 0; + end; + Inc(ax); + end; + Inc(ay); + end; + + end; + + tr.Free; + tc.Free; + + FUpdating := False; + Invalidate; +end; + +procedure TfpgNiceGrid.NormalizeVertOffset; +begin + FVertOffset := (FVertOffset div FDefRowHeight) * FDefRowHeight; +end; + +procedure TfpgNiceGrid.SetGutterFont(const Value: string); +begin + if FGutterFont <> Value then + begin + FGutterFont:= Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetGutterFontColor(Value: TfpgColor); +begin + if FGutterFontColor <> Value then + begin + FGutterFontColor:= Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetHeaderFont(Value: string); +begin + FHeaderFont:=Value; + Invalidate; +end; + +procedure TfpgNiceGrid.SetHeaderFontColor(Value: TfpgColor); +begin + if FHeaderFontColor <> Value then + begin + FHeaderFontColor:= Value; + Invalidate; + end; +end; + +procedure TfpgNiceGrid.SetFooterFont(const Value: string); +begin + FFooterFont:= Value; + Invalidate; +end; + +procedure TfpgNiceGrid.SetFooterFontColor(Value: TfpgColor); +begin + if FFooterFontColor <> Value then + begin + FFooterFontColor:= Value; + Invalidate; + end; +end; + +function TfpgNiceGrid.GetFirstVisible: Integer; +var + x: Integer; +begin + Result := -1; + if (ColCount > 0) then + begin + for x := 0 to ColCount-1 do + begin + if Columns[x].Visible then + begin + Result := x; + Break; + end; + end; + end; +end; + +function TfpgNiceGrid.GetLastVisible: Integer; +var + x: Integer; +begin + Result := -1; + if (ColCount > 0) then + begin + for x := ColCount-1 downto 0 do + begin + if Columns[x].Visible then + begin + Result := x; + Break; + end; + end; + end; +end; + +function TfpgNiceGrid.GetNextVisible(Index: Integer): Integer; +var + x: Integer; +begin + Result := Index; + if (ColCount > 0) and (Index < ColCount) then + begin + for x := (Index + 1) to (ColCount - 1) do + begin + if Columns[x].Visible then + begin + Result := x; + Break; + end; + end; + end; +end; + +function TfpgNiceGrid.GetPrevVisible(Index: Integer): Integer; +var + x: Integer; +begin + Result := Index; + if (ColCount > 0) and (Index > 0) then + begin + for x := (Index - 1) downto 0 do + begin + if Columns[x].Visible then + begin + Result := x; + Break; + end; + end; + end; +end; + +procedure TfpgNiceGrid.DeleteRow(ARow: Integer); +var + x, y: Integer; +begin + if (ARow >= 0) and (ARow < FRowCount) then + begin + for x := 0 to ColCount-1 do + begin + with FColumns[x].Strings do + begin + if (Count > ARow) then + begin + for y := ARow to Count-2 + do Strings[y] := Strings[y + 1]; + Strings[Count-1] := ''; + end; + end; + end; + if (FRow = FRowCount-1) + then Dec(FRow); + RowCount := RowCount - 1; + UpdateScrollBars; + end; +end; + +procedure TfpgNiceGrid.InsertRow(ARow: Integer); +var + x: Integer; +begin + if (ARow >= 0) and (ARow < FRowCount) then + begin + for x := 0 to ColCount-1 do + begin + with FColumns[x].Strings do + begin + while (Count < ARow) + do Add(''); + Insert(ARow, ''); + end; + end; + RowCount := RowCount + 1; + end; + UpdateScrollBars; +end; + +function TfpgNiceGrid.AddRow: Integer; +var + x: Integer; + n: Integer; +begin + n := FRowCount + 1; + for x := 0 to ColCount-1 do + begin + with FColumns[x].Strings do + begin + while (Count < n) + do Add(''); + Strings[FRowCount] := ''; + end; + end; + RowCount := RowCount + 1; + Result := FRowCount-1; +end; + +procedure TfpgNiceGrid.ColRowChanged; +begin + if Assigned(Sync) + then Sync.Row := FRow; + if Assigned(FOnColRowChanged) + then FOnColRowChanged(Self, FCol, FRow); +end; + +procedure TfpgNiceGrid.Notification(AComponent: TComponent; + Operation: TOperation); +begin + if (AComponent = Sync) and (Operation = opRemove) + then Sync := nil; + inherited; +end; + +procedure TfpgNiceGrid.SetGutterStrings(const Value: TStrings); +begin + FGutterStrings.Assign(Value); + if (FGutterKind = gkString) then + Invalidate; +end; + +function TfpgNiceGrid.GetObject(X, Y: Integer): TObject; +var + t: TStrings; +begin + Result := nil; + if (X > ColCount-1) or (Y > FRowCount-1) + then raise Exception.Create('Cell Index out of bound.'); + t := Columns[X].FStrings; + if (Y < t.Count) + then Result := t.Objects[Y]; +end; + +procedure TfpgNiceGrid.SetObject(X, Y: Integer; const Value: TObject); +var + t: TStrings; +begin + if (X > ColCount-1) or (Y > FRowCount-1) + then raise Exception.Create('Cell Index out of bound.'); + t := Columns[X].FStrings; + while (Y > t.Count-1) + do t.Add(''); + t.Objects[Y] := Value; +end; + +procedure TfpgNiceGrid.ClearMergeCells; +var + x, y: Integer; + List: TStrings; +begin + for x := 0 to FColumns.Count-1 do + begin + List := FColumns[x].FStrings; + for y := 0 to List.Count-1 + do List.Objects[y] := nil; + end; + for x := 0 to Mergeds.Count-1 + do TfpgMergeCell(Mergeds[x]).Free; + Mergeds.Clear; +end; + +function TfpgNiceGrid.MergeCells(const X1, Y1, X2, Y2: Integer; + ACaption: string): TfpgMergeCell; +begin + Result := TfpgMergeCell.Create; + Result.Font:= Font.FontDesc; + Result.Color := Color; + Result.Text := ACaption; + Result.HorzAlign := haCenter; + Result.VertAlign := vaCenter; + Result.Rc := fpgRect(Min(X1, X2), Min(Y1, Y2), Max(X1, X2)-Min(X1, X2), Max(Y1, Y2)-Min(Y1, Y2)); + Mergeds.Add(Result); + if not FUpdating then + begin + Recalculate; + writeln('MergeCells'); + Invalidate; + end; +end; + +procedure TfpgNiceGrid.BuildMergeData; +var + Rc: TfpgRect; + x, y, z: Integer; +begin + for x := 0 to Mergeds.Count-1 do + begin + CopyRect(Rc, TfpgMergeCell(Mergeds[x]).Rc); + for y := Rc.Left to Rc.Right do + begin + if (y >= FColumns.Count) + then Continue; + for z := Rc.Top to Rc.Bottom do + begin + InternalSetCell(y, z, '', False); + SetObject(y, z, TObject(MergeID)); + end; + end; + end; +end; + +procedure TfpgNiceGrid.DrawMergedCell(Index: Integer); +var + Data: TfpgMergeCell; + Rc, Dummy: TfpgRect; + l1, l2, t, h: Integer; +begin + Data := TfpgMergeCell(Mergeds[Index]); + l1 := GetColCoord(Data.Rc.Left); + l2 := GetColCoord(Data.Rc.Right + 1); + t := FDefRowHeight * Data.Rc.Top; + h := FDefRowHeight * (Data.Rc.Bottom - Data.Rc.Top + 1); + Rc := fpgRect(l1-1, t-1, l2-l1, h); + OffsetRect(Rc, -FHorzOffset + FixedWidth, -FVertOffset + FixedHeight); + if IntersectRect(Dummy, Rc, CellBox) then + begin + with Canvas do + begin + Font:= fpgGetFont(Data.Font); + if not FEnabled + then SetTextColor(FGridColor); + if FShowGrid then + begin + SetColor(FGridColor); + DrawRectangle(Rc); + end + else + begin + SetColor(Data.Color); + FillRectangle(Rc); + end; + InflateRect(Rc, -4, -2); + DrawStringUni(Canvas, Data.Text, Rc, Data.HorzAlign, Data.VertAlign); + end; + end; +end; + +function TfpgNiceGrid.GetHeaderInfo: TList; +begin + Result := FHeaderInfos; +end; + +function TfpgNiceGrid.GetMergedCellsData: TList; +begin + Result := Mergeds; +end; + +procedure TfpgNiceGrid.SetEnabled(const Value: Boolean); +begin + if (FEnabled <> Value) then + begin + FEnabled := Value; + Invalidate; + end; +end; + +{ TfpgNiceColumn } + +constructor TfpgNiceColumn.Create(Collec: TCollection); +begin + FStrings := TStringList.Create; + FFont:= 'Arial-8'; + FHorzAlign := haLeft; + FVertAlign := vaCenter; + FVisible := True; + FCanResize := True; + FReadOnly := False; + FTag := 0; + FTag2 := 0; + with TfpgNiceColumns(Collec).Grid do + begin + Self.FFont:=Font.FontDesc; + Self.FWidth := DefColWidth; + Self.FColor := Color; + end; + inherited Create(Collec); +end; + +destructor TfpgNiceColumn.Destroy; +begin + inherited Destroy; + FStrings.Free; +end; + +procedure TfpgNiceColumn.Assign(Source: TPersistent); +begin + if (Source is TfpgNiceColumn) then + begin + Title := TfpgNiceColumn(Source).Title; + Footer := TfpgNiceColumn(Source).Footer; + Width := TfpgNiceColumn(Source).Width; + Font := TfpgNiceColumn(Source).Font; + Color := TfpgNiceColumn(Source).Color; + HorzAlign := TfpgNiceColumn(Source).HorzAlign; + VertAlign := TfpgNiceColumn(Source).VertAlign; + Visible := TfpgNiceColumn(Source).Visible; + Tag := TfpgNiceColumn(Source).Tag; + Tag2 := TfpgNiceColumn(Source).Tag2; + Hint := TfpgNiceColumn(Source).Hint; + CanResize := TfpgNiceColumn(Source).CanResize; + ReadOnly := TfpgNiceColumn(Source).ReadOnly; + Strings.Assign(TfpgNiceColumn(Source).Strings); + Changed(False); + end; +end; + +procedure TfpgNiceColumn.SetColor(Value: TfpgColor); +begin + if (FColor <> Value) then + begin + FColor := Value; + Changed(False); + end; +end; + +procedure TfpgNiceColumn.SetFont(Value: string); +begin + FFont:=Value; + Changed(False); +end; + +procedure TfpgNiceColumn.SetHorzAlign(Value: THorzAlign); +begin + if (FHorzAlign <> Value) then + begin + FHorzAlign := Value; + Changed(False); + end; +end; + +procedure TfpgNiceColumn.SetTitle(Value: string); +begin + if (FTitle <> Value) then + begin + FTitle := Value; + Changed(True); + end; +end; + +procedure TfpgNiceColumn.SetFooter(const Value: string); +begin + if (FFooter <> Value) then + begin + FFooter := Value; + Changed(False); + end; +end; + +procedure TfpgNiceColumn.SetVertAlign(Value: TVertAlign); +begin + if (FVertAlign <> Value) then + begin + FVertAlign := Value; + Changed(False); + end; +end; + +procedure TfpgNiceColumn.SetWidth(Value: Integer); +begin + if (FWidth <> Value) then + begin + FWidth := Value; + Changed(True); + end; +end; + +procedure TfpgNiceColumn.SetVisible(Value: Boolean); +begin + if (FVisible <> Value) then + begin + FVisible := Value; + TfpgNiceColumns(Collection).FGrid.ForcedColumn := Index; + Changed(True); + end; +end; + +procedure TfpgNiceColumn.SetStrings(Value: TStrings); +begin + FStrings.Assign(Value); + Changed(False); +end; + +function TfpgNiceColumn.IsFontStored: Boolean; +begin + Result := True; + if (TfpgNiceColumns(Collection).FGrid.Font.FontDesc = FFont) then + Result:= false; +end; + +function TfpgNiceColumn.GetGrid: TfpgNiceGrid; +begin + Result := TfpgNiceColumns(Collection).FGrid; +end; + +function TfpgNiceColumn.GetDisplayName: string; +begin + if (FTitle <> '') + then Result := FTitle + else Result := 'Column ' + IntToStr(Index); +end; + +{ TfpgNiceColumns } + +constructor TfpgNiceColumns.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass); +begin + FGrid := TfpgNiceGrid(AOwner); + inherited Create(FGrid,TfpgNiceColumn); +end; + +function TfpgNiceColumns.Add: TfpgNiceColumn; +begin + Result := TfpgNiceColumn(inherited Add); +end; + +function TfpgNiceColumns.GetItem(Index: Integer): TfpgNiceColumn; +begin + Result := TfpgNiceColumn(inherited GetItem(Index)); +end; + +procedure TfpgNiceColumns.SetItem(Index: Integer; Value: TfpgNiceColumn); +begin + inherited SetItem(Index, Value); +end; + +function TfpgNiceColumns.GetOwner: TPersistent; +begin + Result := FGrid; +end; + +function TfpgNiceColumns.Insert(Index: Integer): TfpgNiceColumn; +begin + Result := AddItem(nil, Index); +end; + +function TfpgNiceColumns.AddItem(Item: TfpgNiceColumn; + Index: Integer): TfpgNiceColumn; +begin + if (Item = nil) + then Result := FGrid.CreateColumn + else + begin + Result := Item; + if Assigned(Item) then + begin + Result.Collection := Self; + if (Index < 0) + then Index := Count - 1; + Result.Index := Index; + end; + end; +end; + +procedure TfpgNiceColumns.Update(Item: TCollectionItem); +begin + if not (Grid.HasHandle) then + Exit; // ==> + if (Item <> nil) + then FGrid.UpdateColumn(Item.Index) + else FGrid.UpdateColumns; +end; + + +{ TInplaceEdit } + +constructor TfpgNiceInplace.Create(AGrid: TfpgNiceGrid); +begin + inherited Create(AGrid); + FGrid := AGrid; + Name:='EditGrid'; + BorderStyle:=ebsSingle; + Left := 0; + Top := 0; + BuffTmp:=''; + Visible := False; + OnChange:=@Change; +end; + +procedure TfpgNiceInplace.SetAlignment(Value: THorzAlign); +begin + if (FAlignment <> Value) then + FAlignment := Value; +end; + +procedure TfpgNiceInplace.ShowEdit(X, Y: Integer); +var + Rc: TfpgRect; + Column: TfpgNiceColumn; +begin + CellX := X; + CellY := Y; + Column := FGrid.FColumns[x]; + + SetAlignment(Column.FHorzAlign); + BackgroundColor := FGrid.GetCellColor(X, Y); + + FontDesc:=Column.Font; + Text := Trim(FGrid.SafeGetCell(X, Y)); + BuffTmp:= Text; + + Rc := FGrid.GetCellRect(X, Y); + Rc := FGrid.CellRectToClient(Rc); + InflateRect(Rc, -2, -2); + SetPosition(Rc.Left, Rc.Top,Rc.Width,Rc.Height); + Visible:=true; + SetFocus; +end; + +procedure TfpgNiceInplace.HideEdit; +begin + KillFocus; + if Visible + then Visible:=false; + FGrid.IsEditing := False; +end; + +procedure TfpgNiceInplace.Change(Sender: TObject); +begin + if Visible then // Because when tfpgWidget is disabled it still receive keyboard msg + FGrid.InternalSetCell(CellX, CellY, Text, True); +end; + +procedure TfpgNiceInplace.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +begin + if not Visible then +Exit; //==> + if not Visible then + exit; + case KeyCode of + KeyEscape : + begin + Text:= BuffTmp; + HideEdit; + end; + KeyReturn, KeyPEnter, KeyUp, keyDown: + begin + HideEdit; + end; + else + begin + inherited HandleKeyPress(keycode, shiftstate, consumed); + if (keycode= KeyLeft) and (FCursorPos=0) then + consumed:=true; + end; + end; +end; + + +{ TfpgNiceGridSync } + +constructor TfpgNiceGridSync.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FOnDeleteRow := @SyncDeleteRow; + FOnInsertRow := @SyncInsertRow; + FOnColRowChanged := @SyncColRow; + FMasterGrid:=nil; +end; + +procedure TfpgNiceGridSync.Notification(AComponent: TComponent; + Operation: TOperation); +begin + if (AComponent = FMasterGrid) and (Operation = opRemove) + then FMasterGrid := nil; + inherited; +end; + +procedure TfpgNiceGridSync.SetMasterGrid(const Value: TfpgNiceGrid); +begin + if (FMasterGrid <> Value) then + begin + FMasterGrid := Value; + FMasterGrid.Sync := Self; + FMasterGrid.RowCount := RowCount; + end; +end; + +procedure TfpgNiceGridSync.SetScrollBar(AKind: TfpgScrollbar; AMax, APos, AStep: Integer); +begin + if (AKind = FVScrollBar) and Assigned(FMasterGrid) then + FMasterGrid.VertOffset := APos; +end; + +procedure TfpgNiceGridSync.ShowHideScrollBar(HorzVisible, + VertVisible: Boolean); +begin + FVScrollBar.Visible:= VertVisible; + FHScrollBar.Visible:= HorzVisible; + FHScrollBar.Enabled:=false; +end; + +procedure TfpgNiceGridSync.SyncColRow(Sender: TObject; ACol, ARow: Integer); +begin + if Assigned(FMasterGrid) + then FMasterGrid.Row := ARow; +end; + +procedure TfpgNiceGridSync.SyncDeleteRow(Sender: TObject; ARow: Integer); +begin + if Assigned(FMasterGrid) + then FMasterGrid.DeleteRow(ARow); +end; + +procedure TfpgNiceGridSync.SyncInsertRow(Sender: TObject; ARow: Integer); +begin + if Assigned(FMasterGrid) then + begin + if (ARow = FMasterGrid.RowCount) + then FMasterGrid.AddRow + else FMasterGrid.InsertRow(ARow); + end; +end; + +{ TfpgMergeCell } + +constructor TfpgMergeCell.Create; +begin + inherited Create; + Font := fpgApplication.DefaultFont.FontDesc; +end; + +destructor TfpgMergeCell.Destroy; +begin + inherited Destroy; +end; + +end. diff --git a/extras/contributed/nicegrid/main1.pas b/extras/contributed/nicegrid/main1.pas new file mode 100644 index 00000000..67a39621 --- /dev/null +++ b/extras/contributed/nicegrid/main1.pas @@ -0,0 +1,368 @@ +unit main1; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_menu, + fpg_nicegrid, fpg_button, fpg_checkbox, fpg_label; + +type + + TfrmMain = class(TfpgForm) + private + FFileSubMenu: TfpgPopupMenu; + FMenuBar : TfpgMenuBar; + Grid1: TfpgNiceGrid; + CheckBox1: TfpgCheckBox; + CheckBox2: TfpgCheckBox; + CheckBox3: TfpgCheckBox; + CheckBox4: TfpgCheckBox; + CheckBox5: TfpgCheckBox; + CheckBox6: TfpgCheckBox; + Label1: TfpgLabel; + Button1: TfpgButton; + Button2: TfpgButton; + Button3: TfpgButton; + Button4: TfpgButton; + procedure CheckBox1Click(Sender: TObject); + procedure CheckBox2Click(Sender: TObject); + procedure CheckBox3Click(Sender: TObject); + procedure CheckBox4Click(Sender: TObject); + procedure CheckBox5Click(Sender: TObject); + procedure CheckBox6Click(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas; + Rc: TfpgRect; Str: string; var Handled: Boolean); + procedure Grid1InsertRow(Sender: TObject; ARow: Integer); + + procedure miExitClicked(Sender: TObject); + public + procedure AfterCreate; override; + end; + + +implementation + + +procedure TfrmMain.AfterCreate; +var x: integer; +begin + Name := 'frmMain'; + SetPosition(252, 121, 638, 575); + WindowTitle := 'NiceGrid - Demo 1'; + Hint := ''; + FFileSubMenu := TfpgPopupMenu.Create(self); + with FFileSubMenu do + begin + Name := 'FFileSubMenu'; + SetPosition(0, 0, 120, 32); + end; + FFileSubMenu.AddMenuItem('&Quit', 'Ctrl-Q', @miExitClicked); + FMenuBar := CreateMenuBar(self); + FMenuBar.AddMenuItem('&File', nil).SubMenu := FFileSubMenu; + + Grid1 := TfpgNiceGrid.Create(self); + with Grid1 do + begin + Name := 'Grid1'; + SetPosition(16, 88, 597, 370); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#Grid'; + Hint := ''; + // Cursor = 1 + RowCount := 20; + AutoAddRow := True; + DefColWidth := 100; + Color:=$ECE9D8; + GridColor := clSilver; + HeaderLine := 2; + HeaderColor := clButtonFace; + HeaderLightColor := clHilite1; + HeaderDarkColor := clShadow1; + HeaderFontColor := clWhite; + HeaderFont := 'MS Sans Serif'; + FooterFontColor := clRed; + SelectionColor := 13816575; + BeginUpdate; // JP + with Columns.Add do + begin + Title := 'Merged;Multilined|Merged;Multilined'; + Footer := 'Footer 0'; + Font:='Arial-8'; + FontColor:=clBlack; + Width := 100; + CanResize := False; + end; + with Columns.Add do + begin + Title:='First Group|One'; + Footer:='Footer 1'; + Width:=100; + Font:='Arial-8'; + FontColor:=clRed; + Color:=$FFFACD;//14024703; + HorzAlign:=haCenter; + end; + with Columns.Add do + begin + Title:='First Group|Two'; + Footer:='Footer 2'; + Font:='Arial-8'; + FontColor:=clBlack; + Width:=100; + end; + with Columns.Add do + begin + Title:='Second Group|One'; + Footer:='Footer 3'; + Width:=100; + Font:='Arial-8'; + FontColor:=clBlack; + Color:=clWhite; + HorzAlign:=haRight; + end; + with Columns.Add do + begin + Title:='Second Group|Two'; + Footer:='Footer 4'; + Font:='Arial-8'; + FontColor:=clBlack; + Width:=100; + HorzAlign:=haCenter; + end; + GutterKind:=gkNumber; + GutterWidth:=40; + GutterFont:='Arial-8'; + GutterFontColor:=clBlack; + ShowFooter:=True; + OnDrawHeader:=@Grid1DrawHeader; + OnInsertRow:=@Grid1InsertRow; + TabOrder:=0; + EndUpdate; + end; {Grid1} + + Label1:= TfpgLabel.Create(self); + with Label1 do + begin + SetPosition(16, 42, 300, 18); + Text:= '- Try to copy paste a cell with Ctrl+c and Ctrl+v' + end; + CheckBox1:= TfpgCheckBox.Create(self); + with CheckBox1 do + begin + Name:='CheckBox1'; + SetPosition(16,470,49,17); + Anchors := [anLeft, anBottom]; + Text := 'Flat'; + Checked := True; + TabOrder := 1; + OnChange := @CheckBox1Click; + end; + CheckBox2:= TfpgCheckBox.Create(self); + with CheckBox2 do + begin + Name:='CheckBox2'; + SetPosition(78,470,110,17); + Anchors := [anLeft, anBottom]; + Text:= 'System Colors'; + Checked := True; + TabOrder := 2; + OnChange := @CheckBox2Click; + end; + CheckBox3:= TfpgCheckBox.Create(self); + with CheckBox3 do + begin + Name:='CheckBox3'; + SetPosition(192,470,90,17); + Anchors := [anLeft, anBottom]; + Text := 'Fit to Width'; + TabOrder := 3; + OnChange := @CheckBox3Click; + end; + CheckBox4:= TfpgCheckBox.Create(self); + with CheckBox4 do + begin + Name:='CheckBox4'; + SetPosition(288,470,135,17); + Anchors := [anLeft, anBottom]; + Text := 'Auto Column Width'; + TabOrder := 4; + OnChange := @CheckBox4Click; + end; + CheckBox5:= TfpgCheckBox.Create(self); + with CheckBox5 do + begin + Name:='CheckBox5'; + SetPosition(424,470,90,17); + Anchors := [anLeft, anBottom]; + Text := 'Show Grids'; + Checked := True; + TabOrder := 5; + OnChange := @CheckBox5Click; + end; + CheckBox6:= TfpgCheckBox.Create(self); + with CheckBox6 do + begin + Name:='CheckBox6'; + SetPosition(528,470,95,17); + Anchors := [anLeft, anBottom]; + Text := 'Show Footer'; + Checked := True; + TabOrder := 10; + OnChange:= @CheckBox6Click; + end; + + Button1:= TfpgButton.Create(self); + with Button1 do + begin + Name:='Button1'; + SetPosition(272,505,129,25); + Anchors:= [anLeft, anBottom]; + Text:= 'Hide 3rd Column'; + TabOrder:= 8; + OnClick:= @Button1Click; + end; + Button2:= TfpgButton.Create(self); + with Button2 do + begin + Name:='Button2'; + SetPosition(16,505,121,25); + Anchors:= [anLeft, anBottom]; + Text:= 'Insert New Row'; + TabOrder:= 6; + OnClick:= @Button2Click; + end; + Button3:= TfpgButton.Create(self); + with Button3 do + begin + Name:='Button3'; + SetPosition(144,505,121,25); + Anchors:= [anLeft, anBottom]; + Text:= 'Delete Current Row'; + TabOrder:= 7; + OnClick:= @Button3Click; + end; + Button4:= TfpgButton.Create(self); + with Button4 do + begin + Name:='Button4'; + SetPosition(416,505,180,25); + Anchors:= [anLeft, anBottom]; + Text:= 'Toggle ReadOnly 3rd Column'; + TabOrder:= 9; + OnClick:=@Button4Click; + end; + + Grid1.BeginUpdate; + for x := 0 to 9 do + begin + Grid1[0, x] := 'Sample Text'; + Grid1[1, x] := 'Centered Text'; + Grid1[2, x] := 'Left Alignment'; + Grid1[3, x] := FormatFloat('### ### ##0.##', Random(20000000)); + Grid1[4, x] := IntToStr(Random(2000)); + end; + Grid1.EndUpdate; +end; + +procedure TfrmMain.miExitClicked(Sender: TObject); +begin + Close; +end; + +procedure TfrmMain.CheckBox1Click(Sender: TObject); +begin + Grid1.Flat := CheckBox1.Checked; +end; + +procedure TfrmMain.CheckBox2Click(Sender: TObject); +begin + if CheckBox2.Checked then + begin + with Grid1 do + begin + BeginUpdate; + GridColor := clSilver; + HeaderColor := clButtonFace; + HeaderDarkColor := clShadow1; + HeaderLightColor := clHilite1; + HeaderFontColor := clBlack; + GutterFontColor:=clBlack; + EndUpdate; + end; + end + else + begin + with Grid1 do + begin + BeginUpdate; + GridColor := clGray; + HeaderColor := $000000DF; + HeaderDarkColor := clBlack; + HeaderLightColor := $000080FF; + HeaderFontColor := clWhite; + GutterFontColor:=clWhite; + EndUpdate; + end; + end; + Grid1.Invalidate; +end; + +procedure TfrmMain.CheckBox3Click(Sender: TObject); +begin + Grid1.FitToWidth := CheckBox3.Checked; +end; + +procedure TfrmMain.CheckBox4Click(Sender: TObject); +begin + Grid1.AutoColWidth := CheckBox4.Checked; +end; + +procedure TfrmMain.CheckBox5Click(Sender: TObject); +begin + Grid1.ShowGrid := CheckBox5.Checked; +end; + +procedure TfrmMain.CheckBox6Click(Sender: TObject); +begin + Grid1.ShowFooter := CheckBox6.Checked; +end; + +procedure TfrmMain.Button1Click(Sender: TObject); +begin + Grid1.Columns[2].Visible := not Grid1.Columns[2].Visible; +end; + +procedure TfrmMain.Button2Click(Sender: TObject); +begin + Grid1.InsertRow(Grid1.Row); +end; + +procedure TfrmMain.Button3Click(Sender: TObject); +begin + Grid1.DeleteRow(Grid1.Row); +end; + +procedure TfrmMain.Button4Click(Sender: TObject); +begin + Grid1.Columns[2].ReadOnly := not Grid1.Columns[2].ReadOnly; +end; + +procedure TfrmMain.Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas; + Rc: TfpgRect; Str: String; var Handled: Boolean); +begin + if (Str = 'One') + then ACanvas.SetTextColor(clRed); +end; + +procedure TfrmMain.Grid1InsertRow(Sender: TObject; ARow: Integer); +begin + Grid1.Cells[0, ARow] := 'New Row'; +end; + +end. diff --git a/extras/contributed/nicegrid/main2.pas b/extras/contributed/nicegrid/main2.pas new file mode 100644 index 00000000..11696d0d --- /dev/null +++ b/extras/contributed/nicegrid/main2.pas @@ -0,0 +1,104 @@ +unit main2; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_nicegrid; + +type + TfrmMain = class(TfpgForm) + private + Grid1: TfpgNiceGrid; + procedure Grid1DrawCell(Sender: TObject; ACanvas: TfpgCanvas; X, Y: Integer; Rc: TfpgRect; var Handled: Boolean); + public + procedure AfterCreate; override; + end; + + +implementation + + +procedure TfrmMain.AfterCreate; +var + x: Integer; +begin + Name := 'frmMain'; + SetPosition(471, 120, 472, 419); + WindowTitle := 'Customizing Cells Based on Conditions'; + Hint := ''; + Grid1 := TfpgNiceGrid.Create(self); + with Grid1 do + begin + BeginUpdate; //JP + Name := 'Grid1'; + SetPosition(16, 16, 441, 385); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#Grid'; + Color:=$ECE9D8; + GridColor := clSilver; + ColCount:= 5; + RowCount:= 20; + FooterFontColor:= clBlack; + FitToWidth:= True; + + with Columns.Items[0]do + begin + Title:= 'Column 1'; + Width:= 84; + end; + with Columns.Items[1]do + begin + Title:= 'Column 2'; + Width:= 84; + end; + with Columns.Items[2]do + begin + Title:= 'Column 3'; + Width:= 83; + end; + with Columns.Items[3]do + begin + Title:= 'Column 4'; + Width:= 83; + end; + with Columns.Items[4]do + begin + Title:= 'Column 5'; + Width:= 83; + end; + GutterFont:='Arial-8'; + GutterFontColor:=clBlack; + ShowFooter:= False; + OnDrawCell:= @Grid1DrawCell; + TabOrder:= 0; + EndUpdate; //JP + end; + + Grid1.BeginUpdate; //JP + for x := 0 to 19 do + begin + Grid1.Cells[0, x] := IntToStr(Random(100)); + Grid1.Cells[1, x] := IntToStr(Random(100)); + Grid1.Cells[2, x] := IntToStr(Random(100)); + Grid1.Cells[3, x] := IntToStr(Random(100)); + Grid1.Cells[4, x] := IntToStr(Random(100)); + end; + Grid1.EndUpdate; //JP +end; + +procedure TfrmMain.Grid1DrawCell(Sender: TObject; ACanvas: TfpgCanvas; X, + Y: Integer; Rc: TfpgRect; var Handled: Boolean); +var + i: Integer; +begin + i := StrToIntDef(Grid1.Cells[X, Y], 0); + if Odd(i) + then ACanvas.SetTextColor (clRed); + if ((i mod 10) = 0) + then ACanvas.SetColor(clYellow); +end; + + +end. diff --git a/extras/contributed/nicegrid/main3.pas b/extras/contributed/nicegrid/main3.pas new file mode 100644 index 00000000..84853b42 --- /dev/null +++ b/extras/contributed/nicegrid/main3.pas @@ -0,0 +1,204 @@ +unit main3; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_panel, fpg_splitter, + fpg_nicegrid; + +type + TfrmMain = class(TfpgForm) + private + Panel1: TfpgPanel; + Splitter1: TfpgSplitter; + Grid1: TfpgNiceGrid; + GridSync1: TfpgNiceGridSync; + public + procedure AfterCreate; override; + end; + + + +implementation + +procedure TfrmMain.AfterCreate; +begin + Name := 'frmMain'; + SetPosition(260, 99, 719, 570); + WindowTitle := 'Tabel Budget'; + Hint := ''; + WindowAttributes := [waSizeable, waScreenCenterPos]; + + Panel1:= TfpgPanel.Create(self); + with Panel1 do + begin + Left:= 16; + Top:= 16; + Width:= 682; + Height:= 504; + Anchors:= [anLeft, anTop, anRight, anBottom]; + TabOrder:= 0; + end; + + GridSync1:= TfpgNiceGridSync.Create(Panel1); + with GridSync1 do + begin + BeginUpdate; + Name := 'GridSync1'; + Left:= 1; + Top:= 1; + Width:= 329; + Height:= 502; + ColCount:= 3; + RowCount:= 20; + AutoAddRow:= True; + GridColor:= clSilver; + HeaderLine:= 2; + FooterFontColor:= clBlack; + FitToWidth:= True; + + with Columns.Items[0]do + begin + Title:= 'Unit Name'; + Width:= 135; + end; + with Columns.Items[1]do + begin + Title:= 'Unit Cost|Capital'; + Width:= 80; + Color:= 15790335; + CanResize:= False; + end; + with Columns.Items[2]do + begin + Title:= 'Unit Cost|Non Capital'; + Width:= 80; + Color:= 14671871; + CanResize:= False; + end; + GutterKind:= gkNumber; + GutterWidth:= 30; + ShowFooter:= False; + GutterFont:='Arial-8'; + GutterFontColor:=clBlack; + Align:= alLeft; + TabOrder:= 1; + EndUpdate; + end; + + Splitter1:= TfpgSplitter.Create(Panel1); + with Splitter1 do + begin + Name:='Splitter1'; + SetPosition(330,1,8,502); + Align := alLeft; + end; + + Grid1:= TfpgNiceGrid.Create(Panel1); + with Grid1 do + begin + BeginUpdate; + Name := 'Grid1'; + Left:= 338; + Top:= 1; + Width:= 344; + Height:= 502; + ColCount:= 12; + RowCount:= 20; + GridColor:= clSilver; + HeaderLine:= 2; + HeaderColor := clButtonFace; + HeaderLightColor := clHilite1; + HeaderDarkColor := clShadow1; + FooterFontColor:= clBlack; + + with Columns.Items[0]do + begin + Title:= '0|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[1]do + begin + Title:= '0|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + with Columns.Items[2]do + begin + Title:= '2000|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[3]do + begin + Title:= '2000|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + with Columns.Items[4]do + begin + Title:= '2001|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[5]do + begin + Title:= '2001|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + with Columns.Items[6]do + begin + Title:= '2002|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[7]do + begin + Title:= '2002|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + with Columns.Items[8]do + begin + Title:= '2003|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[9]do + begin + Title:= '2003|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + with Columns.Items[10]do + begin + Title:= '2004|Capital'; + Width:= 80; + Color:= 16775924; + end; + with Columns.Items[11]do + begin + Title:= '2004|Non Capital'; + Width:= 80; + Color:= 16773601; + end; + GutterKind:= gkNone; + GutterWidth:= 40; + Align:= alClient; + + GutterFont:='Arial-8'; + GutterFontColor:=clBlack; + ShowFooter:=True; + + TabOrder:= 0; + EndUpdate; + end; + + GridSync1.MasterGrid:= Grid1; +end; + +end. diff --git a/extras/contributed/nicegrid/nicegrid1.lpi b/extras/contributed/nicegrid/nicegrid1.lpi new file mode 100644 index 00000000..d135cef7 --- /dev/null +++ b/extras/contributed/nicegrid/nicegrid1.lpi @@ -0,0 +1,72 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="nicegrid1"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="nicegrid1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main1.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="main1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="nicegrid1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="."/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <AllowLabel Value="False"/> + </SyntaxOptions> + </Parsing> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/uidesigner/tests/menutest.lpr b/extras/contributed/nicegrid/nicegrid1.lpr index 80b985be..c63e4942 100644 --- a/uidesigner/tests/menutest.lpr +++ b/extras/contributed/nicegrid/nicegrid1.lpr @@ -1,13 +1,15 @@ -program menutest; +program nicegrid1; -{$mode objfpc}{$H+} +{$mode objfpc} +{$h+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} - Classes, frm_menutest, fpgfx; - + Classes, SysUtils, + fpg_base, fpg_main, fpg_form, + main1; procedure MainProc; @@ -16,12 +18,15 @@ var begin fpgApplication.Initialize; frm := TfrmMain.Create(nil); - frm.Show; - fpgApplication.Run; + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; end; begin MainProc; end. - diff --git a/extras/contributed/nicegrid/nicegrid2.lpi b/extras/contributed/nicegrid/nicegrid2.lpi new file mode 100644 index 00000000..71538a5e --- /dev/null +++ b/extras/contributed/nicegrid/nicegrid2.lpi @@ -0,0 +1,72 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="nicegrid2"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="nicegrid2.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main2.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="main2"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="nicegrid2"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="."/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <AllowLabel Value="False"/> + </SyntaxOptions> + </Parsing> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/extras/contributed/nicegrid/nicegrid2.lpr b/extras/contributed/nicegrid/nicegrid2.lpr new file mode 100644 index 00000000..db26713f --- /dev/null +++ b/extras/contributed/nicegrid/nicegrid2.lpr @@ -0,0 +1,32 @@ +program nicegrid2; + +{$mode objfpc} +{$h+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, + fpg_base, fpg_main, fpg_form, + main2; + + +procedure MainProc; +var + frm: TfrmMain; +begin + fpgApplication.Initialize; + frm := TfrmMain.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + diff --git a/extras/contributed/nicegrid/nicegrid3.lpi b/extras/contributed/nicegrid/nicegrid3.lpi new file mode 100644 index 00000000..8efb6f56 --- /dev/null +++ b/extras/contributed/nicegrid/nicegrid3.lpi @@ -0,0 +1,73 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <UseDefaultCompilerOptions Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="nicegrid3"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/local/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="nicegrid3.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main3.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="main3"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="nicegrid3"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="."/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <AllowLabel Value="False"/> + </SyntaxOptions> + </Parsing> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/uidesigner/tests/tabsheet_design.lpr b/extras/contributed/nicegrid/nicegrid3.lpr index 7acb50aa..d54eb521 100644 --- a/uidesigner/tests/tabsheet_design.lpr +++ b/extras/contributed/nicegrid/nicegrid3.lpr @@ -1,20 +1,23 @@ -program tabsheet_design; +program nicegrid3; -{$mode objfpc}{$H+} +{$mode objfpc} +{$h+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} - Classes, fpgfx, tabtest; + Classes, SysUtils, + fpg_base, fpg_main, + main3; procedure MainProc; var - frm: TfrmTabTest; + frm: TfrmMain; begin fpgApplication.Initialize; - frm := TfrmTabTest.Create(nil); + frm := TfrmMain.Create(nil); try frm.Show; fpgApplication.Run; @@ -27,4 +30,3 @@ begin MainProc; end. - diff --git a/extras/contributed/nicegrid/readme.txt b/extras/contributed/nicegrid/readme.txt new file mode 100644 index 00000000..0ed766d5 --- /dev/null +++ b/extras/contributed/nicegrid/readme.txt @@ -0,0 +1,42 @@ +Name: NiceGrid +Author: "Jean Pierre Anghel" <jean-pierre.anghel@orange.fr> +Date: 2012-01-21 +Description: +This grid widget is a port of the VCL NiceGrid component found at +[http://www.priyatna.org]. The original author gave permission to port this +component to Free Pascal and fpGUI. Below is the emails giving permission. + + + +******************************************************************************** +Dear Jean-Pierre, + +Sure, I will be glad if NiceGrid can be ported to FreePascal. + +There's however an important bug that needs to be solved. It's when +handling scrollbar messages. Current version can only handle 2 bytes +(word) scrollbar offset, due to Windows limitation in the past. This +will limit NiceGrid to only able to handle only a few thousands rows. +Current Windows OS-es use 4 bytes (integer) scrollbar offsets. It should +be easy to fix, I can help. + +Also I prefer to have one source code for NiceGrid using IFDEFs, instead +a version for Delphi and another for FreePascal. I don't have much +experience in LCL or fpGUI. Is it possible? + +Regards, +Priyatna + + +On 8/10/2011 2:52 PM, jean-pierre anghel wrote: +> Hello, +> I participate, modestly, in the fpGui project which works under FreePascal and allows to have, +> with the same source code, executables files under Linux and Windows : http://fpgui.sourceforge.net/ +> I was seduced by your NiceGrid and I adapted it to FreePascal. +> Before passing on the result to Graeme Geldenhuys I wanted at first to present it to you and to have +> your agreement. +> Regards. +> Jean Pierre ANGHEL +> +******************************************************************************** + diff --git a/extras/freetype_windows/readme.txt b/extras/freetype_windows/readme.txt index e371fcac..d56ed51b 100644 --- a/extras/freetype_windows/readme.txt +++ b/extras/freetype_windows/readme.txt @@ -2,9 +2,9 @@ This directory contains a zipped copy of the freetype.dll file. This is required if you use the Agg enabled Canvas, and have the FreeType font engine enabled. -The FreeType font engine has more functiolity and better looking output +The FreeType font engine has more functionality and better looking output than the Win32 font engine. Regards, Graeme. - + diff --git a/extras/mseide_templates/fpdoc_element.mct b/extras/mseide_templates/fpdoc_element.mct new file mode 100644 index 00000000..07ac1678 --- /dev/null +++ b/extras/mseide_templates/fpdoc_element.mct @@ -0,0 +1,16 @@ +[header] +name=docelem +comment=Documentation Element +select=0 +indent=0 +cursorcol=15 +cursorrow=0 +params=1 + name +paramdefaults=1 + +[] +<element name="${name}"> +<short></short> +<descr></descr> +</element>
\ No newline at end of file diff --git a/extras/mseide_templates/fpdoc_link.mct b/extras/mseide_templates/fpdoc_link.mct new file mode 100644 index 00000000..78d1b80a --- /dev/null +++ b/extras/mseide_templates/fpdoc_link.mct @@ -0,0 +1,8 @@ +[header] +name=doclink +comment=Documentation Link tag +noselect=1 +cursorrow=0 +cursorcol=10 +[] +<link id=""></link>
\ No newline at end of file diff --git a/extras/mseide_templates/fpdoc_module.mct b/extras/mseide_templates/fpdoc_module.mct new file mode 100644 index 00000000..786ab4ed --- /dev/null +++ b/extras/mseide_templates/fpdoc_module.mct @@ -0,0 +1,23 @@ +[header] +name=docmod +comment=Documentation Module (new XML file) +noselect=1 +cursorrow=5 +cursorcol=7 +params=2 + pkgname + modname +[] +<?xml version="1.0" encoding="UTF-8"?> +<fpdoc-descriptions> +<package name="${pkgname}"> + +<module name="${modname}"> +<short></short> +<descr> +</descr> + +</module> + +</package> +</fpdoc-descriptions> diff --git a/extras/mseide_templates/fpdoc_ps.mct b/extras/mseide_templates/fpdoc_ps.mct new file mode 100644 index 00000000..aeeaf6ab --- /dev/null +++ b/extras/mseide_templates/fpdoc_ps.mct @@ -0,0 +1,8 @@ +[header] +name=docps +comment=Documentation PrintShort tag +noselect=1 +cursorrow=0 +cursorcol=16 +[] +<printshort id=""/>.
\ No newline at end of file diff --git a/extras/mseide_templates/fpdoc_sa.mct b/extras/mseide_templates/fpdoc_sa.mct new file mode 100644 index 00000000..60414c76 --- /dev/null +++ b/extras/mseide_templates/fpdoc_sa.mct @@ -0,0 +1,15 @@ +[header] +name=docsa +comment=Documentation SeeAlso tag +select=0 +indent=0 +cursorcol=22 +cursorrow=1 +params=1 + linkid +paramdefaults=1 + +[] +<seealso> +<link id="${linkid}"></link> +</seealso>
\ No newline at end of file diff --git a/extras/mseide_templates/fpgui_app.mct b/extras/mseide_templates/fpgui_app.mct new file mode 100644 index 00000000..413adb7d --- /dev/null +++ b/extras/mseide_templates/fpgui_app.mct @@ -0,0 +1,53 @@ +[header] +name=fpguiapp1 +comment=fpGUI template application (with form) +select=0 +indent=0 +cursorcol=0 +cursorrow=0 +params=0 +paramdefaults=0 +[] +{$mode objfpc}{$h+} +{$ifdef mswindows}{$apptype gui}{$endif} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpg_main, fpg_form; + +type + TMainForm = class(TfpgForm) + public + constructor Create(AOwner: TComponent); override; + end; + +{ TMainForm } + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WindowTitle := 'My Title'; + WindowPosition := wpUser; + SetPosition(100, 100, 300, 200); +end; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. diff --git a/extras/mseide_templates/fpgui_app0.mct b/extras/mseide_templates/fpgui_app0.mct new file mode 100644 index 00000000..542cd09d --- /dev/null +++ b/extras/mseide_templates/fpgui_app0.mct @@ -0,0 +1,37 @@ +[header] +name=fpguiapp +comment=fpGUI template application (no forms) +select=0 +indent=0 +cursorcol=0 +cursorrow=0 +params=0 +paramdefaults=0 +[] +{$mode objfpc}{$h+} +{$ifdef mswindows}{$apptype gui}{$endif} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpg_main, frm_main; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. diff --git a/extras/mseide_templates/fpgui_app_with_designer.mct b/extras/mseide_templates/fpgui_app_with_designer.mct new file mode 100644 index 00000000..68665213 --- /dev/null +++ b/extras/mseide_templates/fpgui_app_with_designer.mct @@ -0,0 +1,65 @@ +[header] +name=fpguiapp2 +comment=fpGUI with UI Designer template application +select=0 +indent=0 +cursorcol=0 +cursorrow=0 +params=0 +paramdefaults=0 +[] +{$mode objfpc}{$h+} +{$ifdef mswindows}{$apptype gui}{$endif} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpg_main, fpg_form; + +type + + TMainForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: MainForm} + {@VFD_HEAD_END: MainForm} + public + procedure AfterCreate; override; + end; + +{@VFD_NEWFORM_DECL} + + + +{@VFD_NEWFORM_IMPL} + +procedure TMainForm.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(316, 186, 300, 250); + WindowTitle := 'MainForm'; + + {@VFD_BODY_END: MainForm} + {%endregion} +end; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. diff --git a/extras/mseide_templates/fpgui_license_header.mct b/extras/mseide_templates/fpgui_license_header.mct new file mode 100644 index 00000000..93a5bbdb --- /dev/null +++ b/extras/mseide_templates/fpgui_license_header.mct @@ -0,0 +1,26 @@ +[header] +name=fpguihdr +comment=fpGUI unit header +select=0 +indent=0 +cursorcol=6 +cursorrow=14 +params=0 +paramdefaults=0 +[] +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + +}
\ No newline at end of file diff --git a/extras/mseide_templates/general_todo.mct b/extras/mseide_templates/general_todo.mct new file mode 100644 index 00000000..4278bbe5 --- /dev/null +++ b/extras/mseide_templates/general_todo.mct @@ -0,0 +1,8 @@ +[header] +name=todo +comment=Add a todo comment item +noselect=1 +cursorrow=0 +cursorcol=9 +[] +{ TODO : }
\ No newline at end of file diff --git a/extras/mseide_templates/general_unitcomment.mct b/extras/mseide_templates/general_unitcomment.mct new file mode 100644 index 00000000..d86a43d6 --- /dev/null +++ b/extras/mseide_templates/general_unitcomment.mct @@ -0,0 +1,25 @@ +[header] +name=cu +comment=Unit header comment +select=0 +indent=0 +cursorcol=6 +cursorrow=11 +params=1 + project +paramdefaults=1 + fpGUI +[] +{ + This file is part of the ${project} project. + + See the file license.txt, included in this distribution, + for details about redistributing ${project}. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + . +}
\ No newline at end of file diff --git a/extras/mseide_templates/tiopf_log_enter.mct b/extras/mseide_templates/tiopf_log_enter.mct new file mode 100644 index 00000000..fe27d895 --- /dev/null +++ b/extras/mseide_templates/tiopf_log_enter.mct @@ -0,0 +1,13 @@ +[header] +name=logenter +comment=tiOPF Log call +select=0 +indent=0 +cursorcol=33 +cursorrow=0 +params=1 + procedure +paramdefaults=1 + * +[] +Log('>> '+Classname+'.${procedure} - ' + Name, lsDebug);
\ No newline at end of file diff --git a/extras/mseide_templates/tiopf_log_exit.mct b/extras/mseide_templates/tiopf_log_exit.mct new file mode 100644 index 00000000..2e284dd4 --- /dev/null +++ b/extras/mseide_templates/tiopf_log_exit.mct @@ -0,0 +1,13 @@ +[header] +name=logexit +comment=tiOPF Log: method exit +select=0 +indent=0 +cursorcol=33 +cursorrow=0 +params=1 + procedure +paramdefaults=1 + * +[] +Log('<< '+Classname+'.${procedure} - ' + Name, lsDebug);
\ No newline at end of file diff --git a/images/themes/win8/checkboxes.bmp b/images/themes/win8/checkboxes.bmp Binary files differnew file mode 100644 index 00000000..3fc3ae6c --- /dev/null +++ b/images/themes/win8/checkboxes.bmp diff --git a/images/themes/win8/radiobuttons.bmp b/images/themes/win8/radiobuttons.bmp Binary files differnew file mode 100644 index 00000000..f058c37b --- /dev/null +++ b/images/themes/win8/radiobuttons.bmp diff --git a/prototypes/fpgui2/tests/edittest.lpr b/prototypes/fpgui2/tests/edittest.lpr index 16b32e58..ec7d5626 100644 --- a/prototypes/fpgui2/tests/edittest.lpr +++ b/prototypes/fpgui2/tests/edittest.lpr @@ -103,7 +103,6 @@ procedure TMyWidget.HandlePaint; var r: TfpgRect; begin - Canvas.BeginDraw; inherited HandlePaint; Canvas.Clear(clBlue); @@ -117,13 +116,12 @@ begin InflateRect(r, -1, -1); // Canvas.DrawControlFrame(2, 2, Width-4, Height-4); - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); { Canvas.SetColor(clGreen); Canvas.FillRectangle(r); } - Canvas.EndDraw; end; constructor TMyWidget.Create(AOwner: TComponent); @@ -151,7 +149,6 @@ var w: integer; pofs: integer; begin - Canvas.BeginDraw; // inherited HandlePaint; Canvas.ClearClipRect; Canvas.Clear(clButtonFace); @@ -244,7 +241,6 @@ begin x := 3; Canvas.DrawString(x + pofs, y + pofs, FText); - Canvas.EndDraw; end; procedure TXPButton.HandleLMouseDown(X, Y: integer; ShiftState: TShiftState); @@ -388,6 +384,8 @@ begin listbox.Enabled := not checkbox1.Checked; xpluna.Enabled := not checkbox1.Checked; xpsilver.Enabled := not checkbox1.Checked; + trackbar1.Enabled := not checkbox1.Checked; + trackbar2.Enabled := not checkbox1.Checked; end; procedure TMainForm.TrackBarChanged(Sender: TObject; APosition: integer); @@ -441,7 +439,7 @@ begin btn.ShowImage := True; btn.Height := 55; - combo1 := CreateComboBox(self, 10, 200, 120, nil); + combo1 := CreateComboBox(self, 10, 200, 120, nil, 22); combo1.BackgroundColor := clYellow; combo1.TextColor := clBlue; combo1.Items.Add('ilImageLeft'); @@ -451,7 +449,7 @@ begin combo1.FocusItem := 0; combo1.OnChange := @Combo1Changed; - combo2 := CreateComboBox(self, 10, 230, 120, nil); + combo2 := CreateComboBox(self, 10, 230, 120, nil, 22); for i := 1 to 20 do combo2.Items.Add(Format('Items %.2d', [i])); diff --git a/prototypes/fpgui2/tests/fpg_styler.pas b/prototypes/fpgui2/tests/fpg_styler.pas index ad967214..d0c298cc 100644 --- a/prototypes/fpgui2/tests/fpg_styler.pas +++ b/prototypes/fpgui2/tests/fpg_styler.pas @@ -331,7 +331,7 @@ begin InflateRect(r, -3, -3); oldColor := Canvas.Color; - oldLineWidth := Canvas.LineWidth; + oldLineWidth := Canvas.GetLineWidth; oldLineStyle := Canvas.LineStyle; Canvas.SetColor(clText1); diff --git a/prototypes/fpgui2/tests/themetest.lpr b/prototypes/fpgui2/tests/themetest.lpr index c9ec5c19..1484e957 100644 --- a/prototypes/fpgui2/tests/themetest.lpr +++ b/prototypes/fpgui2/tests/themetest.lpr @@ -807,7 +807,7 @@ begin img.Free; nr.SetRect(20, 250, 100, 4); - Canvas.DrawControlFrame(nr); + fpgStyle.DrawControlFrame(Canvas, nr); nr.SetRect(70, 241, 11, 21); Canvas.DrawButtonFace(nr, []); diff --git a/prototypes/fpgui2/tests/threedee.lpi b/prototypes/fpgui2/tests/threedee.lpi index 73845ab0..c5361e9e 100644 --- a/prototypes/fpgui2/tests/threedee.lpi +++ b/prototypes/fpgui2/tests/threedee.lpi @@ -1,7 +1,7 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="7"/> + <Version Value="9"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> @@ -11,11 +11,13 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=""/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> @@ -46,7 +48,12 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/prototypes/fpgui2/tests/threedee.lpr b/prototypes/fpgui2/tests/threedee.lpr index 380d431b..158f3c54 100644 --- a/prototypes/fpgui2/tests/threedee.lpr +++ b/prototypes/fpgui2/tests/threedee.lpr @@ -6,6 +6,7 @@ program threedee; {$mode objfpc}{$H+} +{$IFDEF MSWINDOWS} {$apptype gui} {$ENDIF} uses {$IFDEF UNIX}{$IFDEF UseCThreads} diff --git a/prototypes/mdi/fpg_mdi.pas b/prototypes/mdi/fpg_mdi.pas index ac127a33..88bb4d33 100644 --- a/prototypes/mdi/fpg_mdi.pas +++ b/prototypes/mdi/fpg_mdi.pas @@ -9,357 +9,398 @@ uses fpg_button; type - // forward declarations - TfpgMDIChildForm = class; - - - TfpgMDIWorkArea = class(TfpgWidget) - private - FHorBar: TfpgScrollbar; - FVerBar: TfpgScrollbar; - FList: TList; - FActiveWindow: TfpgMDIChildForm; - procedure InternalMsgFreeMe(var msg: TfpgMessageRec); message FPGM_FREEME; - procedure SetActiveWindow(AValue: TfpgMDIChildForm); - function GetChildWindowCount: integer; - protected - procedure HandlePaint; override; - procedure PositionScrollBars; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function AddWindow(AWindowClass: TfpgFrameClass): TfpgFrame; - property ActiveWindow: TfpgMDIChildForm read FActiveWindow write SetActiveWindow; - property ChildWindowCount: integer read GetChildWindowCount; - end; - - - TfpgMDIChildForm = class(TfpgWidget) - private - {@VFD_HEAD_BEGIN: MDIChildForm} - Panel1: TfpgPanel; - bevLeft: TfpgBevel; - Bevel2: TfpgBevel; - bevBottom: TfpgBevel; - Bevel4: TfpgBevel; - bevRight: TfpgBevel; - Button1: TfpgButton; - Button2: TfpgButton; - Button3: TfpgButton; - Button4: TfpgButton; - bvlClientArea: TfpgBevel; - {@VFD_HEAD_END: MDIChildForm} - FMDIWorkArea: TfpgMDIWorkArea; - FWindowTitle: TfpgString; - FIsMouseDown: boolean; - FLastPos: TPoint; - FActive: boolean; - procedure SetWindowTitle(AValue: TfpgString); - procedure TitleMouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint); - procedure TitleMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure TitleMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure TitleMouseExit(Sender: TObject); - procedure CloseMDIWindowClicked(Sender: TObject); - procedure SetActive(AValue: boolean); - protected - property Active: boolean read FActive write SetActive; - public - constructor Create(AOwner: TfpgMDIWorkArea); reintroduce; - property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle; - procedure SetClientFrame(AFrame: TfpgFrame); - procedure UpdateWindowTitle; - procedure Close; - end; + + TfpgMDIChildMoveEvent = procedure(Sender: TObject; const rec: TfpgMoveEventRec) of object; + + // forward declarations + TfpgMDIChildForm = class; + + + TfpgMDIWorkArea = class(TfpgWidget) + private + FHorBar: TfpgScrollbar; + FVerBar: TfpgScrollbar; + FList: TList; + FActiveWindow: TfpgMDIChildForm; + FScrollingHorizonal: Boolean; + FLastHorizonalPos: integer; + procedure InternalMsgFreeMe(var msg: TfpgMessageRec); message FPGM_FREEME; + procedure SetActiveWindow(AValue: TfpgMDIChildForm); + function GetChildWindowCount: integer; + procedure MDIChildMoved(Sender: TObject; const rec: TfpgMoveEventRec); + function CalcVirtualWidth: integer; + procedure HorizontalScrollBarScrolled(Sender: TObject; position: integer); + protected + procedure HandlePaint; override; + procedure HandleResize(AWidth, AHeight: TfpgCoord); override; + procedure PositionScrollBars; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function AddWindow(AWindowClass: TfpgFrameClass): TfpgFrame; + procedure CascadeWindows; + property ActiveWindow: TfpgMDIChildForm read FActiveWindow write SetActiveWindow; + property ChildWindowCount: integer read GetChildWindowCount; + end; + + + TfpgMDIChildForm = class(TfpgWidget) + private + {@VFD_HEAD_BEGIN: MDIChildForm} + Panel1: TfpgPanel; + bevLeft: TfpgBevel; + Bevel2: TfpgBevel; + bevBottom: TfpgBevel; + Bevel4: TfpgBevel; + bevRight: TfpgBevel; + Button1: TfpgButton; + Button2: TfpgButton; + Button3: TfpgButton; + Button4: TfpgButton; + bvlClientArea: TfpgBevel; + {@VFD_HEAD_END: MDIChildForm} + FMDIWorkArea: TfpgMDIWorkArea; + FWindowTitle: TfpgString; + FIsMouseDown: boolean; + FLastPos: TPoint; + FActive: boolean; + FOnMove: TfpgMDIChildMoveEvent; + procedure SetWindowTitle(AValue: TfpgString); reintroduce; + procedure TitleMouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint); + procedure TitleMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure TitleMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure TitleMouseExit(Sender: TObject); + procedure CloseMDIWindowClicked(Sender: TObject); + procedure SetActive(AValue: boolean); + procedure ChildFormResized(Sender: TObject); + procedure DoOnMove(const x, y: TfpgCoord); + protected + procedure HandleMove(x, y: TfpgCoord); override; + property Active: boolean read FActive write SetActive; + public + constructor Create(AOwner: TfpgMDIWorkArea); reintroduce; + property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle; + procedure SetClientFrame(AFrame: TfpgFrame); + procedure UpdateWindowTitle; + procedure Close; + published + property OnMove: TfpgMDIChildMoveEvent read FOnMove write FOnMove; + end; implementation uses - dbugintf; + dbugintf; { TfpgMDIChildForm } procedure TfpgMDIChildForm.TitleMouseMove(Sender: TObject; AShift: TShiftState; - const AMousePos: TPoint); + const AMousePos: TPoint); var dx, dy: integer; pt: TPoint; begin - pt := WindowToScreen(self, AMousePos); - if not FIsMouseDown then - begin - FLastPos := pt; - Exit; - end; - - dx := pt.X - FLastPos.X; - dy := pt.Y - FLastPos.Y; - Left := Left + dx; - Top := Top + dy; - FLastPos := pt; - UpdateWindowPosition; + pt := WindowToScreen(self, AMousePos); + if not FIsMouseDown then + begin + FLastPos := pt; + Exit; + end; + + dx := pt.X - FLastPos.X; + dy := pt.Y - FLastPos.Y; + Left := Left + dx; + Top := Top + dy; + FLastPos := pt; + UpdateWindowPosition; end; procedure TfpgMDIChildForm.TitleMouseUp(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); + AShift: TShiftState; const AMousePos: TPoint); begin - FIsMouseDown := False; - Panel1.ReleaseMouse; + FIsMouseDown := False; + Panel1.ReleaseMouse; end; procedure TfpgMDIChildForm.TitleMouseDown(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); + AShift: TShiftState; const AMousePos: TPoint); begin - FMDIWorkArea.ActiveWindow := self; - FIsMouseDown := True; - FLastPos := Panel1.WindowToScreen(self, AMousePos); - Panel1.CaptureMouse; + FMDIWorkArea.ActiveWindow := self; + FIsMouseDown := True; + FLastPos := Panel1.WindowToScreen(self, AMousePos); + Panel1.CaptureMouse; end; procedure TfpgMDIChildForm.TitleMouseExit(Sender: TObject); begin -// FIsMouseDown := False; +// FIsMouseDown := False; end; procedure TfpgMDIChildForm.CloseMDIWindowClicked(Sender: TObject); begin - Close; + Close; end; procedure TfpgMDIChildForm.SetActive(AValue: boolean); begin - if FActive = AValue then - Exit; - FActive := AValue; - if FActive then - begin - Panel1.BackgroundColor := clNavy; - bevLeft.BackgroundColor := clNavy; - bevBottom.BackgroundColor := clNavy; - bevRight.BackgroundColor := clNavy; - Bevel2.BackgroundColor := clNavy; - Bevel4.BackgroundColor := clNavy; - end - else - begin - Panel1.BackgroundColor := clMedGray; - bevLeft.BackgroundColor := clMedGray; - bevBottom.BackgroundColor := clMedGray; - bevRight.BackgroundColor := clMedGray; - Bevel2.BackgroundColor := clMedGray; - Bevel4.BackgroundColor := clMedGray; - end; + if FActive = AValue then + Exit; + FActive := AValue; + if FActive then + begin + Panel1.BackgroundColor := clNavy; + bevLeft.BackgroundColor := clNavy; + bevBottom.BackgroundColor := clNavy; + bevRight.BackgroundColor := clNavy; + Bevel2.BackgroundColor := clNavy; + Bevel4.BackgroundColor := clNavy; + end + else + begin + Panel1.BackgroundColor := clMedGray; + bevLeft.BackgroundColor := clMedGray; + bevBottom.BackgroundColor := clMedGray; + bevRight.BackgroundColor := clMedGray; + Bevel2.BackgroundColor := clMedGray; + Bevel4.BackgroundColor := clMedGray; + end; +end; + +procedure TfpgMDIChildForm.ChildFormResized(Sender: TObject); +begin + SendDebug('ChildFormResize'); +end; + +procedure TfpgMDIChildForm.DoOnMove(const x, y: TfpgCoord); +var + rec: TfpgMoveEventRec; +begin + if Assigned(FOnMove) then + begin + rec.Sender := self; + rec.x := x; + rec.y := y; + FOnMove(self, rec); + end; +end; + +procedure TfpgMDIChildForm.HandleMove(x, y: TfpgCoord); +begin + inherited HandleMove(x, y); + DoOnMove(x, y); end; procedure TfpgMDIChildForm.SetWindowTitle(AValue: TfpgString); begin - if FWindowTitle = AValue then - Exit; - FWindowTitle := AValue; - if not (csLoading in ComponentState) then - Panel1.Text := FWindowTitle; + if FWindowTitle = AValue then + Exit; + FWindowTitle := AValue; + if not (csLoading in ComponentState) then + Panel1.Text := FWindowTitle; end; constructor TfpgMDIChildForm.Create(AOwner: TfpgMDIWorkArea); begin - inherited Create(AOwner); - FMDIWorkArea := AOwner; - FIsMouseDown := False; - FLastPos := Point(0,0); - {@VFD_BODY_BEGIN: MDIChildForm} - Name := 'MDIChildForm'; - SetPosition(369, 166, 300, 250); - WindowTitle := 'ChildForm1'; - Hint := ''; - - Panel1 := TfpgPanel.Create(self); - with Panel1 do - begin - Name := 'Panel1'; - SetPosition(0, 0, 301, 24); - Anchors := [anLeft,anRight,anTop]; - BackgroundColor := TfpgColor($0A0081); - FontDesc := '#Label2'; - Hint := ''; - Text := 'Window Title'; - TextColor := TfpgColor($FFFFFF); - OnMouseDown := @TitleMouseDown; - OnMouseUp := @TitleMouseUp; - OnMouseMove := @TitleMouseMove; - OnMouseExit := @TitleMouseExit; - end; - - bevLeft := TfpgBevel.Create(self); - with bevLeft do - begin - Name := 'bevLeft'; - SetPosition(0, 24, 3, 211); - Anchors := [anLeft,anTop,anBottom]; - BackgroundColor := TfpgColor($000080); - Hint := ''; - Shape := bsSpacer; - end; - - Bevel2 := TfpgBevel.Create(self); - with Bevel2 do - begin - Name := 'Bevel2'; - SetPosition(0, 235, 16, 16); - Anchors := [anLeft,anBottom]; - BackgroundColor := TfpgColor($000080); - Hint := ''; - end; - - bevBottom := TfpgBevel.Create(self); - with bevBottom do - begin - Name := 'bevBottom'; - SetPosition(16, 248, 269, 3); - Anchors := [anLeft,anRight,anBottom]; - BackgroundColor := TfpgColor($000080); - Hint := ''; - Shape := bsSpacer; - end; - - Bevel4 := TfpgBevel.Create(self); - with Bevel4 do - begin - Name := 'Bevel4'; - SetPosition(285, 235, 16, 16); - Anchors := [anRight,anBottom]; - BackgroundColor := TfpgColor($000080); - Hint := ''; - end; - - bevRight := TfpgBevel.Create(self); - with bevRight do - begin - Name := 'bevRight'; - SetPosition(297, 24, 3, 211); - Anchors := [anRight,anTop,anBottom]; - BackgroundColor := TfpgColor($000080); - Hint := ''; - Shape := bsSpacer; - end; - - Button1 := TfpgButton.Create(Panel1); - with Button1 do - begin - Name := 'Button1'; - SetPosition(3, 4, 16, 16); - Text := '-'; - Embedded := True; - FontDesc := '#Grid'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - TextColor := TfpgColor($000000); - end; - - Button2 := TfpgButton.Create(Panel1); - with Button2 do - begin - Name := 'Button2'; - SetPosition(251, 4, 16, 16); - Anchors := [anRight,anTop]; - Text := '_'; - Embedded := True; - FontDesc := '#Grid'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - TextColor := TfpgColor($000000); - end; - - Button3 := TfpgButton.Create(Panel1); - with Button3 do - begin - Name := 'Button3'; - SetPosition(267, 4, 16, 16); - Anchors := [anRight,anTop]; - Text := 'o'; - Embedded := True; - FontDesc := '#Grid'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - TextColor := TfpgColor($000000); - end; - - Button4 := TfpgButton.Create(Panel1); - with Button4 do - begin - Name := 'Button4'; - SetPosition(283, 4, 16, 16); - Anchors := [anRight,anTop]; - Text := 'X'; - Embedded := True; - FontDesc := '#Grid'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - TextColor := TfpgColor($000000); - OnClick := @CloseMDIWindowClicked; - end; - - bvlClientArea := TfpgBevel.Create(self); - with bvlClientArea do - begin - Name := 'bvlClientArea'; - SetPosition(2, 24, 296, 224); - Anchors := [anLeft,anRight,anTop,anBottom]; - Hint := ''; - Shape := bsSpacer; - end; - - {@VFD_BODY_END: MDIChildForm} - Name := 'MDIChildForm' + IntToStr(Random(MaxInt)); + inherited Create(AOwner); + FMDIWorkArea := AOwner; + FIsMouseDown := False; + FLastPos := Point(0,0); + {@VFD_BODY_BEGIN: MDIChildForm} + Name := 'MDIChildForm'; + SetPosition(10, 10, 300, 250); + WindowTitle := 'ChildForm1'; + Hint := ''; + OnResize := @ChildFormResized; + + Panel1 := TfpgPanel.Create(self); + with Panel1 do + begin + Name := 'Panel1'; + SetPosition(0, 0, 301, 24); + Anchors := [anLeft,anRight,anTop]; + BackgroundColor := TfpgColor($0A0081); + FontDesc := '#Label2'; + Hint := ''; + Text := 'Window Title'; + TextColor := TfpgColor($FFFFFF); + OnMouseDown := @TitleMouseDown; + OnMouseUp := @TitleMouseUp; + OnMouseMove := @TitleMouseMove; + OnMouseExit := @TitleMouseExit; + end; + + bevLeft := TfpgBevel.Create(self); + with bevLeft do + begin + Name := 'bevLeft'; + SetPosition(0, 24, 3, 211); + Anchors := [anLeft,anTop,anBottom]; + BackgroundColor := TfpgColor($000080); + Hint := ''; + Shape := bsSpacer; + end; + + Bevel2 := TfpgBevel.Create(self); + with Bevel2 do + begin + Name := 'Bevel2'; + SetPosition(0, 235, 16, 16); + Anchors := [anLeft,anBottom]; + BackgroundColor := TfpgColor($000080); + Hint := ''; + end; + + bevBottom := TfpgBevel.Create(self); + with bevBottom do + begin + Name := 'bevBottom'; + SetPosition(16, 248, 269, 3); + Anchors := [anLeft,anRight,anBottom]; + BackgroundColor := TfpgColor($000080); + Hint := ''; + Shape := bsSpacer; + end; + + Bevel4 := TfpgBevel.Create(self); + with Bevel4 do + begin + Name := 'Bevel4'; + SetPosition(285, 235, 16, 16); + Anchors := [anRight,anBottom]; + BackgroundColor := TfpgColor($000080); + Hint := ''; + end; + + bevRight := TfpgBevel.Create(self); + with bevRight do + begin + Name := 'bevRight'; + SetPosition(297, 24, 3, 211); + Anchors := [anRight,anTop,anBottom]; + BackgroundColor := TfpgColor($000080); + Hint := ''; + Shape := bsSpacer; + end; + + Button1 := TfpgButton.Create(Panel1); + with Button1 do + begin + Name := 'Button1'; + SetPosition(3, 4, 16, 16); + Text := '-'; + Embedded := True; + FontDesc := '#Grid'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + TextColor := TfpgColor($000000); + end; + + Button2 := TfpgButton.Create(Panel1); + with Button2 do + begin + Name := 'Button2'; + SetPosition(251, 4, 16, 16); + Anchors := [anRight,anTop]; + Text := '_'; + Embedded := True; + FontDesc := '#Grid'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + TextColor := TfpgColor($000000); + end; + + Button3 := TfpgButton.Create(Panel1); + with Button3 do + begin + Name := 'Button3'; + SetPosition(267, 4, 16, 16); + Anchors := [anRight,anTop]; + Text := 'o'; + Embedded := True; + FontDesc := '#Grid'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + TextColor := TfpgColor($000000); + end; + + Button4 := TfpgButton.Create(Panel1); + with Button4 do + begin + Name := 'Button4'; + SetPosition(283, 4, 16, 16); + Anchors := [anRight,anTop]; + Text := 'X'; + Embedded := True; + FontDesc := '#Grid'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + TextColor := TfpgColor($000000); + OnClick := @CloseMDIWindowClicked; + end; + + bvlClientArea := TfpgBevel.Create(self); + with bvlClientArea do + begin + Name := 'bvlClientArea'; + SetPosition(2, 24, 296, 224); + Anchors := [anLeft,anRight,anTop,anBottom]; + Hint := ''; + Shape := bsSpacer; + end; + + {@VFD_BODY_END: MDIChildForm} + Name := 'MDIChildForm' + IntToStr(Random(MaxInt)); end; procedure TfpgMDIChildForm.SetClientFrame(AFrame: TfpgFrame); begin -// AFrame.Owner := bvlClientArea; - AFrame.Align := alClient; - AFrame.Visible := True; - UpdateWindowTitle; +// AFrame.Owner := bvlClientArea; + AFrame.Align := alClient; + AFrame.Visible := True; + UpdateWindowTitle; end; procedure TfpgMDIChildForm.UpdateWindowTitle; begin - Panel1.Text := FWindowTitle; + Panel1.Text := FWindowTitle; end; procedure TfpgMDIChildForm.Close; begin - // We can't free ourselves, somebody else needs to do it - fpgPostMessage(Self, FMDIWorkArea, FPGM_FREEME); + // We can't free ourselves, somebody else needs to do it + fpgPostMessage(Self, FMDIWorkArea, FPGM_FREEME); end; { TfpgMDIWorkArea } procedure TfpgMDIWorkArea.InternalMsgFreeMe(var msg: TfpgMessageRec); var - i: integer; + i: integer; begin - if Assigned(msg.Sender) then - begin - if csDestroying in TComponent(msg.Sender).ComponentState then - Exit; - RemoveComponent(TfpgMDIChildForm(msg.Sender)); - i := FList.IndexOf(TfpgMDIChildForm(msg.Sender)); - if i = -1 then - raise Exception.Create('Could not find MDI Child Form'); - FList.Delete(i); - if FList.Count >= i+1 then - { set focus to next child window after the one just deleted } - ActiveWidget := TfpgMDIChildForm(FList.Items[i]) - else if FList.Count > 0 then - { fallback to the first child window we created } - ActiveWidget := TfpgMDIChildForm(FList.Items[0]) - else - { there simply isn't any more child windows } - ActiveWidget := nil; - TfpgMDIChildForm(msg.Sender).Free; - end; + if Assigned(msg.Sender) then + begin + if csDestroying in TComponent(msg.Sender).ComponentState then + Exit; + RemoveComponent(TfpgMDIChildForm(msg.Sender)); + i := FList.IndexOf(TfpgMDIChildForm(msg.Sender)); + if i = -1 then + raise Exception.Create('Could not find MDI Child Form'); + FList.Delete(i); + if FList.Count >= i+1 then + { set focus to next child window after the one just deleted } + ActiveWidget := TfpgMDIChildForm(FList.Items[i]) + else if FList.Count > 0 then + { fallback to the first child window we created } + ActiveWidget := TfpgMDIChildForm(FList.Items[0]) + else + { there simply isn't any more child windows } + ActiveWidget := nil; + TfpgMDIChildForm(msg.Sender).Free; + end; end; procedure TfpgMDIWorkArea.SetActiveWindow(AValue: TfpgMDIChildForm); @@ -367,71 +408,186 @@ var i: integer; w: TfpgMDIChildForm; begin - if FActiveWindow = AValue then - Exit; - FActiveWindow := AValue; - FActiveWindow.BringToFront; - ActiveWidget := FActiveWindow; - for i := 0 to FList.Count-1 do - begin - w := TfpgMDIChildForm(FList[i]); - w.Active := (w = AValue); - end; + if FActiveWindow = AValue then + Exit; + FActiveWindow := AValue; + FActiveWindow.BringToFront; + ActiveWidget := FActiveWindow; + for i := 0 to FList.Count-1 do + begin + w := TfpgMDIChildForm(FList[i]); + w.Active := (w = AValue); + end; end; function TfpgMDIWorkArea.GetChildWindowCount: integer; begin - Result := FList.Count; + Result := FList.Count; +end; + +procedure TfpgMDIWorkArea.MDIChildMoved(Sender: TObject; const rec: TfpgMoveEventRec); +var + w: integer; +begin + if FScrollingHorizonal then + Exit; // We are using the scrollbar to slide windows in/out of view + w := CalcVirtualWidth; + if w > Width then + begin + FHorBar.Max := w - Width; + FHorBar.SliderSize := Width / w; + if not FHorBar.Visible then + begin + FHorBar.Position := 0; + FLastHorizonalPos := 0; + FHorBar.Visible := True + end + else + FHorBar.RepaintSlider; + end + else + FHorBar.Visible := False; +end; + +function TfpgMDIWorkArea.CalcVirtualWidth: integer; +var + w: integer; + i: integer; + c: TfpgMDIChildForm; +begin + w := Width; + for i := 0 to ComponentCount -1 do + begin + if Components[i] is TfpgScrollBar then + continue; + if Components[i] is TfpgMDIChildForm then + begin + c := Components[i] as TfpgMDIChildForm; + if c.Left < 0 then + w := Width + Abs(c.Left); + if c.Right > w then + w := c.Right; + end; + end; + Result := w; +end; + +procedure TfpgMDIWorkArea.HorizontalScrollBarScrolled(Sender: TObject; position: integer); +var + w: integer; + i: integer; + c: TfpgMDIChildForm; +begin + FScrollingHorizonal := True; + for i := 0 to ComponentCount -1 do + begin + if Components[i] is TfpgScrollBar then + continue; + if Components[i] is TfpgMDIChildForm then + begin + c := Components[i] as TfpgMDIChildForm; + c.Left := c.Left + (FLastHorizonalPos - position); + c.UpdateWindowPosition; + fpgApplication.ProcessMessages; + end; + end; + FLastHorizonalPos := position; + FScrollingHorizonal := False; end; procedure TfpgMDIWorkArea.HandlePaint; begin - inherited HandlePaint; - Canvas.Clear(clLtGray); + inherited HandlePaint; + Canvas.Clear(clLtGray); +end; + +procedure TfpgMDIWorkArea.HandleResize(AWidth, AHeight: TfpgCoord); +var + rec: TfpgMoveEventRec; +begin + inherited HandleResize(AWidth, AHeight); + if ComponentCount > 2 then + MDIChildMoved(self, rec); end; procedure TfpgMDIWorkArea.PositionScrollBars; begin - FHorBar.Left := Left; - FHorBar.Top := Height - FHorBar.Height; - FHorBar.Width := Width; - FHorBar.Anchors := [anLeft, anBottom, anRight]; - FVerBar.Left := Width - FVerBar.Width; - FVerBar.Top := 0; - FVerBar.Height := Height; - FVerBar.Anchors := [anRight, anTop, anBottom]; + FHorBar.Left := Left; + FHorBar.Top := Height - FHorBar.Height; + FHorBar.Width := Width; + FHorBar.Anchors := [anLeft, anBottom, anRight]; + FVerBar.Left := Width - FVerBar.Width; + FVerBar.Top := 0; + FVerBar.Height := Height; + FVerBar.Anchors := [anRight, anTop, anBottom]; end; constructor TfpgMDIWorkArea.Create(AOwner: TComponent); begin - inherited Create(AOwner); - FIsContainer := True; - FHorBar := TfpgScrollbar.Create(self); - FHorBar.Visible := False; - FHorBar.Orientation := orHorizontal; - FVerBar := TfpgScrollbar.Create(self); - FVerBar.Visible := False; - FVerBar.Orientation := orVertical; - PositionScrollBars; - FList := TList.Create; - FActiveWindow := nil; + inherited Create(AOwner); + FIsContainer := True; + FScrollingHorizonal := False; + + FHorBar := TfpgScrollbar.Create(self); + FHorBar.Visible := False; + FHorBar.Orientation := orHorizontal; + FHorBar.OnScroll := @HorizontalScrollBarScrolled; + + FVerBar := TfpgScrollbar.Create(self); + FVerBar.Visible := False; + FVerBar.Orientation := orVertical; + + PositionScrollBars; + + FList := TList.Create; + FActiveWindow := nil; end; destructor TfpgMDIWorkArea.Destroy; begin - FList.Free; - inherited Destroy; + FList.Free; + inherited Destroy; end; function TfpgMDIWorkArea.AddWindow(AWindowClass: TfpgFrameClass): TfpgFrame; var - frm: TfpgMDIChildForm; + frm: TfpgMDIChildForm; +begin + frm := TfpgMDIChildForm.Create(self); + Result := AWindowClass.Create(frm.bvlClientArea); + frm.SetClientFrame(Result); + frm.OnMove := @MDIChildMoved; + FList.Add(frm); + ActiveWindow := frm; +end; + +procedure TfpgMDIWorkArea.CascadeWindows; +const + GAP = 25; +var + w: integer; + i: integer; + c: TfpgMDIChildForm; + x, y: integer; begin - frm := TfpgMDIChildForm.Create(self); - Result := AWindowClass.Create(frm.bvlClientArea); - frm.SetClientFrame(Result); - FList.Add(frm); - ActiveWindow := frm; + x := 5; + y := 5; + for i := 0 to ComponentCount -1 do + begin + if Components[i] is TfpgScrollBar then + continue; + if Components[i] is TfpgMDIChildForm then + begin + c := Components[i] as TfpgMDIChildForm; + c.Left := x; + x += GAP; + c.Top := y; + y += GAP; + c.UpdateWindowPosition; + c.BringToFront; + end; + end; + ActiveWindow := c; end; end. diff --git a/prototypes/mdi/frm_child.pas b/prototypes/mdi/frm_child.pas index a9890a3c..acc61323 100644 --- a/prototypes/mdi/frm_child.pas +++ b/prototypes/mdi/frm_child.pas @@ -5,31 +5,31 @@ unit frm_child; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_button, fpg_edit, + SysUtils, Classes, fpg_base, fpg_main, fpg_button, fpg_edit, fpg_checkbox, fpg_radiobutton, fpg_gauge, fpg_mdi, fpg_panel, fpg_trackbar; type - TChildForm = class(TfpgFrame) - private - {@VFD_HEAD_BEGIN: ChildForm} - btnClose: TfpgButton; - CheckBox1: TfpgCheckBox; - CheckBox2: TfpgCheckBox; - RadioButton1: TfpgRadioButton; - RadioButton2: TfpgRadioButton; - Edit1: TfpgEdit; - Gauge1: TfpgGauge; - TrackBar1: TfpgTrackBar; - {@VFD_HEAD_END: ChildForm} - FWindowTitle: TfpgString; - procedure btnCloseClicked(Sender: TObject); - procedure TrackBarChanged(Sender: TObject; APosition: integer); - procedure SetWindowTitle(AValue: TfpgString); - public - procedure AfterCreate; override; - property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle; - end; + TChildForm = class(TfpgFrame) + private + {@VFD_HEAD_BEGIN: ChildForm} + btnClose: TfpgButton; + CheckBox1: TfpgCheckBox; + CheckBox2: TfpgCheckBox; + RadioButton1: TfpgRadioButton; + RadioButton2: TfpgRadioButton; + Edit1: TfpgEdit; + Gauge1: TfpgGauge; + TrackBar1: TfpgTrackBar; + {@VFD_HEAD_END: ChildForm} + FWindowTitle: TfpgString; + procedure btnCloseClicked(Sender: TObject); + procedure TrackBarChanged(Sender: TObject; APosition: integer); + procedure SetWindowTitle(const ATitle: TfpgString); reintroduce; + public + procedure AfterCreate; override; + property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle; + end; {@VFD_NEWFORM_DECL} @@ -43,126 +43,126 @@ implementation procedure TChildForm.TrackBarChanged(Sender: TObject; APosition: integer); begin - Gauge1.Progress := APosition; + Gauge1.Progress := APosition; end; -procedure TChildForm.SetWindowTitle(AValue: TfpgString); +procedure TChildForm.SetWindowTitle(const ATitle: TfpgString); begin - if FWindowTitle = AValue then - Exit; - FWindowTitle := AValue; - TfpgMDIChildForm(Owner.Owner).WindowTitle := FWindowTitle; + if FWindowTitle = ATitle then + Exit; + FWindowTitle := ATitle; + TfpgMDIChildForm(Owner.Owner).WindowTitle := FWindowTitle; end; procedure TChildForm.btnCloseClicked(Sender: TObject); begin - TfpgMDIChildForm(Owner).Close; + TfpgMDIChildForm(Owner).Close; end; procedure TChildForm.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: ChildForm} - Name := 'ChildForm'; - SetPosition(391, 210, 271, 150); -// WindowTitle := 'ChildForm'; - Hint := ''; - - btnClose := TfpgButton.Create(self); - with btnClose do - begin - Name := 'btnClose'; - SetPosition(180, 116, 80, 24); - Text := 'Close'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - OnClick := @btnCloseClicked; - end; - - CheckBox1 := TfpgCheckBox.Create(self); - with CheckBox1 do - begin - Name := 'CheckBox1'; - SetPosition(164, 16, 120, 20); - FontDesc := '#Label1'; - Hint := ''; - TabOrder := 2; - Text := 'CheckBox'; - end; - - CheckBox2 := TfpgCheckBox.Create(self); - with CheckBox2 do - begin - Name := 'CheckBox2'; - SetPosition(164, 36, 120, 20); - FontDesc := '#Label1'; - Hint := ''; - TabOrder := 3; - Text := 'CheckBox'; - end; - - RadioButton1 := TfpgRadioButton.Create(self); - with RadioButton1 do - begin - Name := 'RadioButton1'; - SetPosition(164, 60, 120, 20); - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - TabOrder := 4; - Text := 'RadioButton'; - end; - - RadioButton2 := TfpgRadioButton.Create(self); - with RadioButton2 do - begin - Name := 'RadioButton2'; - SetPosition(164, 80, 120, 20); - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - TabOrder := 5; - Text := 'RadioButton'; - end; - - Edit1 := TfpgEdit.Create(self); - with Edit1 do - begin - Name := 'Edit1'; - SetPosition(8, 8, 120, 24); - ExtraHint := ''; - FontDesc := '#Edit1'; - Hint := ''; - TabOrder := 6; - Text := ''; - end; - - Gauge1 := TfpgGauge.Create(self); - with Gauge1 do - begin - Name := 'Gauge1'; - SetPosition(12, 44, 116, 25); - Color := TfpgColor($C4C4C4); - Hint := ''; - Progress := 65; - end; - - TrackBar1 := TfpgTrackBar.Create(self); - with TrackBar1 do - begin - Name := 'TrackBar1'; - SetPosition(12, 84, 116, 30); - Hint := ''; - TabOrder := 8; - Position := 65; - OnChange := @TrackBarChanged; - end; - - {@VFD_BODY_END: ChildForm} + Name := 'ChildForm'; + SetPosition(391, 210, 271, 150); +// WindowTitle := 'ChildForm'; + Hint := ''; + + btnClose := TfpgButton.Create(self); + with btnClose do + begin + Name := 'btnClose'; + SetPosition(180, 116, 80, 24); + Text := 'Close'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 1; + OnClick := @btnCloseClicked; + end; + + CheckBox1 := TfpgCheckBox.Create(self); + with CheckBox1 do + begin + Name := 'CheckBox1'; + SetPosition(164, 16, 120, 20); + FontDesc := '#Label1'; + Hint := ''; + TabOrder := 2; + Text := 'CheckBox'; + end; + + CheckBox2 := TfpgCheckBox.Create(self); + with CheckBox2 do + begin + Name := 'CheckBox2'; + SetPosition(164, 36, 120, 20); + FontDesc := '#Label1'; + Hint := ''; + TabOrder := 3; + Text := 'CheckBox'; + end; + + RadioButton1 := TfpgRadioButton.Create(self); + with RadioButton1 do + begin + Name := 'RadioButton1'; + SetPosition(164, 60, 120, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + Hint := ''; + TabOrder := 4; + Text := 'RadioButton'; + end; + + RadioButton2 := TfpgRadioButton.Create(self); + with RadioButton2 do + begin + Name := 'RadioButton2'; + SetPosition(164, 80, 120, 20); + FontDesc := '#Label1'; + GroupIndex := 0; + Hint := ''; + TabOrder := 5; + Text := 'RadioButton'; + end; + + Edit1 := TfpgEdit.Create(self); + with Edit1 do + begin + Name := 'Edit1'; + SetPosition(8, 8, 120, 24); + ExtraHint := ''; + FontDesc := '#Edit1'; + Hint := ''; + TabOrder := 6; + Text := ''; + end; + + Gauge1 := TfpgGauge.Create(self); + with Gauge1 do + begin + Name := 'Gauge1'; + SetPosition(12, 44, 116, 25); + Color := TfpgColor($C4C4C4); + Hint := ''; + Progress := 65; + end; + + TrackBar1 := TfpgTrackBar.Create(self); + with TrackBar1 do + begin + Name := 'TrackBar1'; + SetPosition(12, 84, 116, 30); + Hint := ''; + TabOrder := 8; + Position := 65; + OnChange := @TrackBarChanged; + end; + + {@VFD_BODY_END: ChildForm} {%endregion} - Name := 'ChildForm' + IntToStr(Random(MaxInt)); + Name := 'ChildForm' + IntToStr(Random(MaxInt)); end; diff --git a/prototypes/mdi/project1.lpr b/prototypes/mdi/project1.lpr index fdde8f0d..63c0882c 100644 --- a/prototypes/mdi/project1.lpr +++ b/prototypes/mdi/project1.lpr @@ -12,19 +12,20 @@ uses type - TMainForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: MainForm} - MainBar: TfpgMenuBar; - MDIWorkArea: TfpgMDIWorkArea; - Bevel1: TfpgBevel; - pmChildren: TfpgPopupMenu; - {@VFD_HEAD_END: MainForm} - procedure NewFormClicked(Sender: TObject); - procedure miQuitClicked(Sender: TObject); - public - procedure AfterCreate; override; - end; + TMainForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: MainForm} + MainBar: TfpgMenuBar; + MDIWorkArea: TfpgMDIWorkArea; + Bevel1: TfpgBevel; + pmChildren: TfpgPopupMenu; + {@VFD_HEAD_END: MainForm} + procedure NewFormClicked(Sender: TObject); + procedure miQuitClicked(Sender: TObject); + procedure miCascadeChildWindows(Sender: TObject); + public + procedure AfterCreate; override; + end; {@VFD_NEWFORM_DECL} @@ -34,61 +35,69 @@ type procedure TMainForm.NewFormClicked(Sender: TObject); begin - ChildForm := MDIWorkArea.AddWindow(TChildForm) as TChildForm; - ChildForm.WindowTitle := Format('Child %d', [MDIWorkArea.ChildWindowCount]); + ChildForm := MDIWorkArea.AddWindow(TChildForm) as TChildForm; + ChildForm.WindowTitle := Format('Child %d', [MDIWorkArea.ChildWindowCount]); end; procedure TMainForm.miQuitClicked(Sender: TObject); begin - Close; + Close; +end; + +procedure TMainForm.miCascadeChildWindows(Sender: TObject); +begin + MDIWorkArea.CascadeWindows; end; procedure TMainForm.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(351, 159, 555, 321); - WindowTitle := 'fpGUI''s MDI Demo'; - Hint := ''; - - MainBar := TfpgMenuBar.Create(self); - with MainBar do - begin - Name := 'MainBar'; - SetPosition(0, 0, 555, 24); - Anchors := [anLeft,anRight,anTop]; - end; - - MDIWorkArea := TfpgMDIWorkArea.Create(self); - with MDIWorkArea do - begin - Name := 'MDIWorkArea'; - SetPosition(3, 32, 548, 264); - Anchors := [anLeft,anRight,anTop,anBottom]; - end; - - Bevel1 := TfpgBevel.Create(self); - with Bevel1 do - begin - Name := 'Bevel1'; - SetPosition(0, 300, 555, 20); - Anchors := [anLeft,anRight,anBottom]; - Hint := ''; - Style := bsLowered; - end; - - pmChildren := TfpgPopupMenu.Create(self); - with pmChildren do - begin - Name := 'pmChildren'; - SetPosition(336, 88, 120, 20); - AddMenuItem('Add child', '', @NewFormClicked); - AddMenuItem('-', '', nil); - AddMenuItem('Quit', '', @miQuitClicked); - end; - - {@VFD_BODY_END: MainForm} + Name := 'MainForm'; + SetPosition(351, 159, 555, 360); + WindowTitle := 'fpGUI''s MDI Demo'; + Hint := ''; + + MainBar := TfpgMenuBar.Create(self); + with MainBar do + begin + Name := 'MainBar'; + SetPosition(0, 0, 555, 24); + Anchors := [anLeft,anRight,anTop]; + end; + + MDIWorkArea := TfpgMDIWorkArea.Create(self); + with MDIWorkArea do + begin + Name := 'MDIWorkArea'; + SetPosition(3, 32, 548, 303); + Anchors := [anLeft,anRight,anTop,anBottom]; + end; + + Bevel1 := TfpgBevel.Create(self); + with Bevel1 do + begin + Name := 'Bevel1'; + SetPosition(0, 339, 555, 20); + Anchors := [anLeft,anRight,anBottom]; + Hint := ''; + Style := bsLowered; + end; + + pmChildren := TfpgPopupMenu.Create(self); + with pmChildren do + begin + Name := 'pmChildren'; + SetPosition(336, 88, 120, 20); + AddMenuItem('Add child', '', @NewFormClicked); + AddSeparator; + AddMenuItem('Cascade', '', @miCascadeChildWindows); + AddMenuItem('Tile', '', nil).Enabled := False; + AddSeparator; + AddMenuItem('Quit', '', @miQuitClicked); + end; + + {@VFD_BODY_END: MainForm} {%endregion} MainBar.AddMenuItem('Children', nil).SubMenu := pmChildren; end; diff --git a/src/3rdparty/README.txt b/src/3rdparty/README.txt new file mode 100644 index 00000000..406a8a6c --- /dev/null +++ b/src/3rdparty/README.txt @@ -0,0 +1,5 @@ +The code found here is optional extras. When using them, they will add +extra dependencies to your project, but that is a choice for you to +make. + +For further details please see the README file in each sub-directory.
\ No newline at end of file diff --git a/src/3rdparty/libvlc/README.txt b/src/3rdparty/libvlc/README.txt new file mode 100644 index 00000000..0b1f1147 --- /dev/null +++ b/src/3rdparty/libvlc/README.txt @@ -0,0 +1,11 @@ + +VLC Library 2.x + +This directory contains header translations of the VLC library v2.x, as well +as unit containing a non-gui Media Player class. There is also a fpGUI Media +Player descendant class added, which allows you to embed the video output +inside a fpGUI widget. + +This code was commissioned by Master Maths [http://www.mastermaths.co.za] +(my employer), and kindly donated to the Free Pascal and fpGUI Toolkit +projects. diff --git a/src/3rdparty/libvlc/fpg_vlc.pas b/src/3rdparty/libvlc/fpg_vlc.pas new file mode 100644 index 00000000..0eb8daba --- /dev/null +++ b/src/3rdparty/libvlc/fpg_vlc.pas @@ -0,0 +1,81 @@ +unit fpg_vlc; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, libvlc, vlc, fpg_main; + +Type + + { TFpgVLCPlayer } + + TFpgVLCPlayer = Class(TVLCMediaPlayer) + private + FParentWindow: TfpgWindow; + procedure SetParentWindowControl(AValue: TfpgWindow); + Protected + Procedure SetParentWindow; override; + Procedure SetParentWindowSize(AWidth,AHeight : Cardinal); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + Published + Property ParentWindow : TfpgWindow Read FParentWindow Write SetParentWindowControl; + end; + +implementation + +{ TFpgVLCPlayer } + +procedure TFpgVLCPlayer.SetParentWindowControl(AValue: TfpgWindow); +begin + if FParentWindow=AValue then Exit; + If Assigned(FParentWindow) then + FParentWindow.RemoveFreeNotification(Self); + FParentWindow:=AValue; + If Assigned(FParentWindow) then + FParentWindow.FreeNotification(Self); +end; + +procedure TFpgVLCPlayer.SetParentWindow; + +begin + if Assigned(ParentWindow) then + begin + {$IFDEF UNIX} + libvlc_media_player_set_xwindow(Instance, ParentWindow.WinHandle); + {$ENDIF} + {$IFDEF MSWINDOWS} + libvlc_media_player_set_hwnd(Instance, Pointer(ParentWindow.WinHandle)); + {$ENDIF} + end + else if HaveInstance then + begin + {$IFDEF UNIX} + libvlc_media_player_set_xwindow(Instance, 0); + {$ENDIF} + {$IFDEF MSWINDOWS} + libvlc_media_player_set_hwnd(Instance, Nil); + {$ENDIF} + end +end; + +procedure TFpgVLCPlayer.SetParentWindowSize(AWidth, AHeight: Cardinal); +begin + If Assigned(ParentWindow) then + begin + ParentWindow.Width:=AWidth; + ParentWindow.Height:=AHeight; + end; +end; + +procedure TFpgVLCPlayer.Notification(AComponent: TComponent; + Operation: TOperation); +begin + Inherited; + if (Operation=opRemove) and (AComponent=FParentWindow) then + FParentWindow:=Nil; +end; + +end. + diff --git a/src/3rdparty/libvlc/libvlc.pas b/src/3rdparty/libvlc/libvlc.pas new file mode 100644 index 00000000..cfdc1e52 --- /dev/null +++ b/src/3rdparty/libvlc/libvlc.pas @@ -0,0 +1,1156 @@ + +{$mode objfpc} +unit libvlc; +interface + +uses + ctypes; + +{$IFDEF FPC} +{$PACKRECORDS C} +{$ENDIF} + +Const + +{$ifdef unix} + libname = 'libvlc.so'; +{$else} +{$ifdef windows} + DefaultlibPath = 'C:\Program files\Videolan\VLC\'; + corelibname = 'libvlccore.dll'; + libname = 'libvlc.dll'; +{$endif} +{$endif} + + Type + _bool = cint; + Ppcchar = ^Pcchar; + + // Opaque types. + libvlc_event_manager_t = record end; + Libvlc_instance_t = record end; + Libvlc_log_iterator_t = record end; + Libvlc_log_t = record end; + Libvlc_media_discoverer_t = record end; + Libvlc_media_library_t = record end; + Libvlc_media_list_player_t = record end; + Libvlc_media_list_t = record end; + Libvlc_media_player_t = record end; + Libvlc_media_t = record end; + + Plibvlc_audio_output_t = ^libvlc_audio_output_t; + Plibvlc_event_manager_t = ^libvlc_event_manager_t; + Plibvlc_event_t = ^libvlc_event_t; + Plibvlc_instance_t = ^libvlc_instance_t; + Plibvlc_log_iterator_t = ^libvlc_log_iterator_t; + Plibvlc_log_message_t = ^libvlc_log_message_t; + Plibvlc_log_t = ^libvlc_log_t; + Plibvlc_media_discoverer_t = ^libvlc_media_discoverer_t; + Plibvlc_media_library_t = ^libvlc_media_library_t; + Plibvlc_media_list_player_t = ^libvlc_media_list_player_t; + Plibvlc_media_list_t = ^libvlc_media_list_t; + Plibvlc_media_player_t = ^libvlc_media_player_t; + Plibvlc_media_stats_t = ^libvlc_media_stats_t; + Plibvlc_media_t = ^libvlc_media_t; + Plibvlc_media_track_info_t = ^libvlc_media_track_info_t; + Plibvlc_module_description_t = ^libvlc_module_description_t; + Plibvlc_track_description_t = ^libvlc_track_description_t; + + int8_t = cschar; + int16_t = csint; + int32_t = cint; + int64_t = clong; + uint8_t = cuchar; + uint16_t = csint; + uint32_t = cuint; + uint64_t = culong; + int_least8_t = cschar; + int_least16_t = csint; + int_least32_t = cint; + int_least64_t = clong; + uint_least8_t = cuchar; + uint_least16_t = csint; + uint_least32_t = cuint; + uint_least64_t = culong; + int_fast8_t = cschar; + int_fast16_t = clong; + int_fast32_t = clong; + int_fast64_t = clong; + uint_fast8_t = cuchar; + uint_fast16_t = culong; + uint_fast32_t = culong; + uint_fast64_t = culong; + intptr_t = clong; + uintptr_t = culong; + intmax_t = clong; + uintmax_t = culong; + + libvlc_time_t = int64_t; + libvlc_log_message_t = record + i_severity : cint; + psz_type : ^cchar; + psz_name : ^cchar; + psz_header : ^cchar; + psz_message : ^cchar; + end; + + libvlc_event_type_t = cint; + libvlc_callback_t = procedure (_para1:Plibvlc_event_t; _para2:pointer);cdecl; + + libvlc_module_description_t = record + psz_name : ^cchar; + psz_shortname : ^cchar; + psz_longname : ^cchar; + psz_help : ^cchar; + p_next : ^libvlc_module_description_t; + end; + +{ +static inline int64_t libvlc_delay(int64_t pts) + + return pts - libvlc_clock(); + + } + + + libvlc_meta_t = (libvlc_meta_Title,libvlc_meta_Artist, + libvlc_meta_Genre,libvlc_meta_Copyright, + libvlc_meta_Album,libvlc_meta_TrackNumber, + libvlc_meta_Description,libvlc_meta_Rating, + libvlc_meta_Date,libvlc_meta_Setting, + libvlc_meta_URL,libvlc_meta_Language, + libvlc_meta_NowPlaying,libvlc_meta_Publisher, + libvlc_meta_EncodedBy,libvlc_meta_ArtworkURL, + libvlc_meta_TrackID); + + libvlc_state_t = (libvlc_NothingSpecial := 0,libvlc_Opening, + libvlc_Buffering,libvlc_Playing,libvlc_Paused, + libvlc_Stopped,libvlc_Ended,libvlc_Error + ); + + libvlc_media_option_t = (libvlc_media_option_trusted := $2,libvlc_media_option_unique := $100 + ); + + libvlc_track_type_t = (libvlc_track_unknown := -(1),libvlc_track_audio := 0, + libvlc_track_video := 1,libvlc_track_text := 2 + ); + + libvlc_media_stats_t = record + i_read_bytes : cint; + f_input_bitrate : cfloat; + i_demux_read_bytes : cint; + f_demux_bitrate : cfloat; + i_demux_corrupted : cint; + i_demux_discontinuity : cint; + i_decoded_video : cint; + i_decoded_audio : cint; + i_displayed_pictures : cint; + i_lost_pictures : cint; + i_played_abuffers : cint; + i_lost_abuffers : cint; + i_sent_packets : cint; + i_sent_bytes : cint; + f_send_bitrate : cfloat; + end; + + libvlc_media_track_info_t = record + i_codec : uint32_t; + i_id : cint; + i_type : libvlc_track_type_t; + i_profile : cint; + i_level : cint; + u : record + case longint of + 0 : ( audio : record + i_channels : cunsigned; + i_rate : cunsigned; + end ); + 1 : ( video : record + i_height : cunsigned; + i_width : cunsigned; + end ); + end; + end; + + + libvlc_track_description_t = record + i_id : cint; + psz_name : ^cchar; + p_next : ^libvlc_track_description_t; + end; + + libvlc_audio_output_t = record + psz_name : ^cchar; + psz_description : ^cchar; + p_next : ^libvlc_audio_output_t; + end; + + libvlc_rectangle_t = record + top : cint; + left : cint; + bottom : cint; + right : cint; + end; + + libvlc_video_marquee_option_t = (libvlc_marquee_Enable := 0,libvlc_marquee_Text, + libvlc_marquee_Color,libvlc_marquee_Opacity, + libvlc_marquee_Position,libvlc_marquee_Refresh, + libvlc_marquee_Size,libvlc_marquee_Timeout, + libvlc_marquee_X,libvlc_marquee_Y); + + libvlc_navigate_mode_t = (libvlc_navigate_activate := 0,libvlc_navigate_up, + libvlc_navigate_down,libvlc_navigate_left, + libvlc_navigate_right); + + + libvlc_video_lock_cb = function (opaque:pointer; planes:Ppointer):pointer;cdecl; + libvlc_video_unlock_cb = procedure (opaque:pointer; picture:pointer; planes:Ppointer);cdecl; + libvlc_video_display_cb = procedure (opaque:pointer; picture:pointer);cdecl; + libvlc_video_format_cb = function (opaque:Ppointer; chroma:pcchar; width:pcunsigned; height:pcunsigned; pitches:pcunsigned; + lines:pcunsigned):cunsigned;cdecl; + libvlc_video_cleanup_cb = procedure (opaque:pointer);cdecl; + libvlc_audio_play_cb = procedure (data:pointer; samples:pointer; count:cunsigned; pts:int64_t);cdecl; + libvlc_audio_pause_cb = procedure (data:pointer; pts:int64_t);cdecl; + libvlc_audio_resume_cb = procedure (data:pointer; pts:int64_t);cdecl; + libvlc_audio_flush_cb = procedure (data:pointer; pts:int64_t);cdecl; + libvlc_audio_drain_cb = procedure (data:pointer);cdecl; + libvlc_audio_set_volume_cb = procedure (data:pointer; volume:cfloat; mute:_Bool);cdecl; + libvlc_audio_setup_cb = function (data:Ppointer; format:pcchar; rate:pcunsigned; channels:pcunsigned):cint;cdecl; + libvlc_audio_cleanup_cb = procedure (data:pointer);cdecl; + libvlc_video_logo_option_t = (libvlc_logo_enable,libvlc_logo_file,libvlc_logo_x, + libvlc_logo_y,libvlc_logo_delay,libvlc_logo_repeat, + libvlc_logo_opacity,libvlc_logo_position + ); + libvlc_video_adjust_option_t = (libvlc_adjust_Enable := 0,libvlc_adjust_Contrast, + libvlc_adjust_Brightness,libvlc_adjust_Hue, + libvlc_adjust_Saturation,libvlc_adjust_Gamma + ); + libvlc_audio_output_device_types_t = (libvlc_AudioOutputDevice_Error := -(1), + libvlc_AudioOutputDevice_Mono := 1, + libvlc_AudioOutputDevice_Stereo := 2, + libvlc_AudioOutputDevice_2F2R := 4, + libvlc_AudioOutputDevice_3F2R := 5, + libvlc_AudioOutputDevice_5_1 := 6,libvlc_AudioOutputDevice_6_1 := 7, + libvlc_AudioOutputDevice_7_1 := 8,libvlc_AudioOutputDevice_SPDIF := 10 + ); + + libvlc_audio_output_channel_t = (libvlc_AudioChannel_Error := -(1),libvlc_AudioChannel_Stereo := 1, + libvlc_AudioChannel_RStereo := 2,libvlc_AudioChannel_Left := 3, + libvlc_AudioChannel_Right := 4,libvlc_AudioChannel_Dolbys := 5 + ); + libvlc_playback_mode_t = (libvlc_playback_mode_default,libvlc_playback_mode_loop, + libvlc_playback_mode_repeat); + + libvlc_event_e = (libvlc_MediaMetaChanged := 0, + libvlc_MediaSubItemAdded, + libvlc_MediaDurationChanged,libvlc_MediaParsedChanged, + libvlc_MediaFreed,libvlc_MediaStateChanged, + libvlc_MediaPlayerMediaChanged := $100, + libvlc_MediaPlayerNothingSpecial,libvlc_MediaPlayerOpening, + libvlc_MediaPlayerBuffering,libvlc_MediaPlayerPlaying, + libvlc_MediaPlayerPaused,libvlc_MediaPlayerStopped, + libvlc_MediaPlayerForward,libvlc_MediaPlayerBackward, + libvlc_MediaPlayerEndReached,libvlc_MediaPlayerEncounteredError, + libvlc_MediaPlayerTimeChanged,libvlc_MediaPlayerPositionChanged, + libvlc_MediaPlayerSeekableChanged,libvlc_MediaPlayerPausableChanged, + libvlc_MediaPlayerTitleChanged,libvlc_MediaPlayerSnapshotTaken, + libvlc_MediaPlayerLengthChanged,libvlc_MediaPlayerVout, + libvlc_MediaListItemAdded := $200,libvlc_MediaListWillAddItem, + libvlc_MediaListItemDeleted,libvlc_MediaListWillDeleteItem, + libvlc_MediaListViewItemAdded := $300, + libvlc_MediaListViewWillAddItem,libvlc_MediaListViewItemDeleted, + libvlc_MediaListViewWillDeleteItem,libvlc_MediaListPlayerPlayed := $400, + libvlc_MediaListPlayerNextItemSet,libvlc_MediaListPlayerStopped, + libvlc_MediaDiscovererStarted := $500, + libvlc_MediaDiscovererEnded,libvlc_VlmMediaAdded := $600, + libvlc_VlmMediaRemoved,libvlc_VlmMediaChanged, + libvlc_VlmMediaInstanceStarted,libvlc_VlmMediaInstanceStopped, + libvlc_VlmMediaInstanceStatusInit,libvlc_VlmMediaInstanceStatusOpening, + libvlc_VlmMediaInstanceStatusPlaying, + libvlc_VlmMediaInstanceStatusPause,libvlc_VlmMediaInstanceStatusEnd, + libvlc_VlmMediaInstanceStatusError); + + + libvlc_event_t = record + _type : cint; + p_obj : pointer; + case longint of + 0 : ( media_meta_changed : record + meta_type : libvlc_meta_t; + end ); + 1 : ( media_subitem_added : record + new_child : ^libvlc_media_t; + end ); + 2 : ( media_duration_changed : record + new_duration : int64_t; + end ); + 3 : ( media_parsed_changed : record + new_status : cint; + end ); + 4 : ( media_freed : record + md : ^libvlc_media_t; + end ); + 5 : ( media_state_changed : record + new_state : libvlc_state_t; + end ); + 6 : ( media_player_buffering : record + new_cache : cfloat; + end ); + 7 : ( media_player_position_changed : record + new_position : cfloat; + end ); + 8 : ( media_player_time_changed : record + new_time : libvlc_time_t; + end ); + 9 : ( media_player_title_changed : record + new_title : cint; + end ); + 10 : ( media_player_seekable_changed : record + new_seekable : cint; + end ); + 11 : ( media_player_pausable_changed : record + new_pausable : cint; + end ); + 12 : ( media_player_vout : record + new_count : cint; + end ); + 13 : ( media_list_item_added : record + item : ^libvlc_media_t; + index : cint; + end ); + 14 : ( media_list_will_add_item : record + item : ^libvlc_media_t; + index : cint; + end ); + 15 : ( media_list_item_deleted : record + item : ^libvlc_media_t; + index : cint; + end ); + 16 : ( media_list_will_delete_item : record + item : ^libvlc_media_t; + index : cint; + end ); + 17 : ( media_list_player_next_item_set : record + item : ^libvlc_media_t; + end ); + 18 : ( media_player_snapshot_taken : record + psz_filename : ^cchar; + end ); + 19 : ( media_player_length_changed : record + new_length : libvlc_time_t; + end ); + 20 : ( vlm_media_event : record + psz_media_name : ^cchar; + psz_instance_name : ^cchar; + end ); + 21 : ( media_player_media_changed : record + new_media : ^libvlc_media_t; + end ); + end; + + PPlibvlc_media_track_info_t = ^Plibvlc_media_track_info_t; + cbtype1 = procedure (_para1:pointer); cdecl; + +Var + libvlc_media_player_new : function(p_libvlc_instance:Plibvlc_instance_t):plibvlc_media_player_t; cdecl; + libvlc_media_player_new_from_media : function(p_md:Plibvlc_media_t):plibvlc_media_player_t; cdecl; + libvlc_media_player_release : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_retain : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_set_media : procedure(p_mi:Plibvlc_media_player_t; p_md:Plibvlc_media_t); cdecl; + libvlc_media_player_get_media : function(p_mi:Plibvlc_media_player_t):plibvlc_media_t; cdecl; + libvlc_media_player_event_manager : function(p_mi:Plibvlc_media_player_t):plibvlc_event_manager_t; cdecl; + libvlc_media_player_is_playing : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_play : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_set_pause : procedure(mp:Plibvlc_media_player_t; do_pause:cint); cdecl; + libvlc_media_player_pause : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_stop : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_new_location : function(p_instance:Plibvlc_instance_t; psz_mrl:pcchar):plibvlc_media_t; cdecl; + libvlc_media_new_path : function(p_instance:Plibvlc_instance_t; path:pcchar):plibvlc_media_t; cdecl; + libvlc_media_new_fd : function(p_instance:Plibvlc_instance_t; fd:cint):plibvlc_media_t; cdecl; + libvlc_media_new_as_node : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):plibvlc_media_t; cdecl; + libvlc_media_add_option : procedure(p_md:Plibvlc_media_t; ppsz_options:pcchar); cdecl; + libvlc_media_add_option_flag : procedure(p_md:Plibvlc_media_t; ppsz_options:pcchar; i_flags:cunsigned); cdecl; + libvlc_media_retain : procedure(p_md:Plibvlc_media_t); cdecl; + libvlc_media_release : procedure(p_md:Plibvlc_media_t); cdecl; + libvlc_media_get_mrl : function(p_md:Plibvlc_media_t):pcchar; cdecl; + libvlc_media_duplicate : function(p_md:Plibvlc_media_t):plibvlc_media_t; cdecl; + libvlc_media_get_meta : function(p_md:Plibvlc_media_t; e_meta:libvlc_meta_t):pcchar; cdecl; + libvlc_media_set_meta : procedure(p_md:Plibvlc_media_t; e_meta:libvlc_meta_t; psz_value:pcchar); cdecl; + libvlc_media_save_meta : function(p_md:Plibvlc_media_t):cint; cdecl; + libvlc_media_get_state : function(p_md:Plibvlc_media_t):libvlc_state_t; cdecl; + libvlc_media_get_stats : function(p_md:Plibvlc_media_t; p_stats:Plibvlc_media_stats_t):cint; cdecl; + libvlc_media_subitems : function(p_md:Plibvlc_media_t):plibvlc_media_list_t; cdecl; + libvlc_media_event_manager : function(p_md:Plibvlc_media_t):plibvlc_event_manager_t; cdecl; + libvlc_media_get_duration : function(p_md:Plibvlc_media_t):libvlc_time_t; cdecl; + libvlc_media_parse : procedure(p_md:Plibvlc_media_t); cdecl; + libvlc_media_parse_async : procedure(p_md:Plibvlc_media_t); cdecl; + libvlc_media_is_parsed : function(p_md:Plibvlc_media_t):cint; cdecl; + libvlc_media_set_user_data : procedure(p_md:Plibvlc_media_t; p_new_user_data:pointer); cdecl; + libvlc_media_get_user_data : function(p_md:Plibvlc_media_t):pointer; cdecl; + libvlc_media_get_tracks_info : function(p_md:Plibvlc_media_t; tracks:PPlibvlc_media_track_info_t):cint; cdecl; + libvlc_module_description_list_release : procedure(p_list:Plibvlc_module_description_t); cdecl; + libvlc_audio_filter_list_get : function(p_instance:Plibvlc_instance_t):plibvlc_module_description_t; cdecl; + libvlc_video_filter_list_get : function(p_instance:Plibvlc_instance_t):plibvlc_module_description_t; cdecl; + libvlc_clock : function:int64_t; cdecl; + + libvlc_errmsg : function:pcchar; cdecl; + libvlc_clearerr : procedure; cdecl; + libvlc_printerr : function(fmt:pcchar):pcchar;varargs; cdecl; + + libvlc_new : function(argc:cint; argv:Ppcchar):plibvlc_instance_t; cdecl; + libvlc_release : procedure(p_instance:Plibvlc_instance_t); cdecl; + libvlc_retain : procedure(p_instance:Plibvlc_instance_t); cdecl; + libvlc_add_intf : function(p_instance:Plibvlc_instance_t; name:pcchar):cint; cdecl; + libvlc_set_exit_handler : procedure(p_instance:Plibvlc_instance_t; cb:cbtype1; opaque:pointer); cdecl; + libvlc_wait : procedure(p_instance:Plibvlc_instance_t); cdecl; + libvlc_set_user_agent : procedure(p_instance:Plibvlc_instance_t; name:pcchar; http:pcchar); cdecl; + libvlc_get_version : function:pcchar; cdecl; + libvlc_get_compiler : function:pcchar; cdecl; + libvlc_get_changeset : function:pcchar; cdecl; + libvlc_free : procedure(ptr:pointer); cdecl; + libvlc_event_attach : function(p_event_manager:Plibvlc_event_manager_t; i_event_type:libvlc_event_type_t; f_callback:libvlc_callback_t; user_data:pointer):cint; cdecl; + libvlc_event_detach : procedure(p_event_manager:Plibvlc_event_manager_t; i_event_type:libvlc_event_type_t; f_callback:libvlc_callback_t; p_user_data:pointer); cdecl; + libvlc_event_type_name : function(event_type:libvlc_event_type_t):pcchar; cdecl; + libvlc_get_log_verbosity : function(p_instance:Plibvlc_instance_t):cunsigned; cdecl; + libvlc_set_log_verbosity : procedure(p_instance:Plibvlc_instance_t; level:cunsigned); cdecl; + libvlc_log_open : function(p_instance:Plibvlc_instance_t):plibvlc_log_t; cdecl; + libvlc_log_close : procedure(p_log:Plibvlc_log_t); cdecl; + libvlc_log_count : function(p_log:Plibvlc_log_t):cunsigned; cdecl; + libvlc_log_clear : procedure(p_log:Plibvlc_log_t); cdecl; + libvlc_log_get_iterator : function(p_log:Plibvlc_log_t):plibvlc_log_iterator_t; cdecl; + libvlc_log_iterator_free : procedure(p_iter:Plibvlc_log_iterator_t); cdecl; + libvlc_log_iterator_has_next : function(p_iter:Plibvlc_log_iterator_t):cint; cdecl; + libvlc_log_iterator_next : function(p_iter:Plibvlc_log_iterator_t; p_buffer:Plibvlc_log_message_t):plibvlc_log_message_t; cdecl; + libvlc_audio_output_list_get : function(p_instance:Plibvlc_instance_t):plibvlc_audio_output_t; cdecl; + libvlc_audio_output_list_release : procedure(p_list:Plibvlc_audio_output_t); cdecl; + libvlc_audio_output_set : function(p_mi:Plibvlc_media_player_t; psz_name:pcchar):cint; cdecl; + libvlc_audio_output_device_count : function(p_instance:Plibvlc_instance_t; psz_audio_output:pcchar):cint; cdecl; + libvlc_audio_output_device_longname : function(p_instance:Plibvlc_instance_t; psz_audio_output:pcchar; i_device:cint):pcchar; cdecl; + libvlc_audio_output_device_id : function(p_instance:Plibvlc_instance_t; psz_audio_output:pcchar; i_device:cint):pcchar; cdecl; + libvlc_audio_output_device_set : procedure(p_mi:Plibvlc_media_player_t; psz_audio_output:pcchar; psz_device_id:pcchar); cdecl; + libvlc_audio_output_get_device_type : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_output_set_device_type : procedure(p_mi:Plibvlc_media_player_t; device_type:cint); cdecl; + libvlc_audio_toggle_mute : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_audio_get_mute : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_set_mute : procedure(p_mi:Plibvlc_media_player_t; status:cint); cdecl; + libvlc_audio_get_volume : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_set_volume : function(p_mi:Plibvlc_media_player_t; i_volume:cint):cint; cdecl; + libvlc_audio_get_track_count : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_get_track_description : function(p_mi:Plibvlc_media_player_t):plibvlc_track_description_t; cdecl; + libvlc_audio_get_track : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_set_track : function(p_mi:Plibvlc_media_player_t; i_track:cint):cint; cdecl; + libvlc_audio_get_channel : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_audio_set_channel : function(p_mi:Plibvlc_media_player_t; channel:cint):cint; cdecl; + libvlc_audio_get_delay : function(p_mi:Plibvlc_media_player_t):int64_t; cdecl; + libvlc_audio_set_delay : function(p_mi:Plibvlc_media_player_t; i_delay:int64_t):cint; cdecl; + libvlc_media_list_new : function(p_instance:Plibvlc_instance_t):plibvlc_media_list_t; cdecl; + libvlc_media_list_release : procedure(p_ml:Plibvlc_media_list_t); cdecl; + libvlc_media_list_retain : procedure(p_ml:Plibvlc_media_list_t); cdecl; + + libvlc_media_list_add_file_content : function(p_ml:Plibvlc_media_list_t; psz_uri:pcchar):cint; cdecl; + libvlc_media_list_set_media : procedure(p_ml:Plibvlc_media_list_t; p_md:Plibvlc_media_t); cdecl; + libvlc_media_list_media : function(p_ml:Plibvlc_media_list_t):plibvlc_media_t; cdecl; + libvlc_media_list_add_media : function(p_ml:Plibvlc_media_list_t; p_md:Plibvlc_media_t):cint; cdecl; + libvlc_media_list_insert_media : function(p_ml:Plibvlc_media_list_t; p_md:Plibvlc_media_t; i_pos:cint):cint; cdecl; + libvlc_media_list_remove_index : function(p_ml:Plibvlc_media_list_t; i_pos:cint):cint; cdecl; + libvlc_media_list_count : function(p_ml:Plibvlc_media_list_t):cint; cdecl; + libvlc_media_list_item_at_index : function(p_ml:Plibvlc_media_list_t; i_pos:cint):plibvlc_media_t; cdecl; + libvlc_media_list_index_of_item : function(p_ml:Plibvlc_media_list_t; p_md:Plibvlc_media_t):cint; cdecl; + libvlc_media_list_is_readonly : function(p_ml:Plibvlc_media_list_t):cint; cdecl; + libvlc_media_list_lock : procedure(p_ml:Plibvlc_media_list_t); cdecl; + libvlc_media_list_unlock : procedure(p_ml:Plibvlc_media_list_t); cdecl; + libvlc_media_list_event_manager : function(p_ml:Plibvlc_media_list_t):plibvlc_event_manager_t; cdecl; + libvlc_media_list_player_new : function(p_instance:Plibvlc_instance_t):plibvlc_media_list_player_t; cdecl; + libvlc_media_list_player_release : procedure(p_mlp:Plibvlc_media_list_player_t); cdecl; + libvlc_media_list_player_retain : procedure(p_mlp:Plibvlc_media_list_player_t); cdecl; + libvlc_media_list_player_event_manager : function(p_mlp:Plibvlc_media_list_player_t):plibvlc_event_manager_t; cdecl; + libvlc_media_list_player_set_media_player : procedure(p_mlp:Plibvlc_media_list_player_t; p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_list_player_set_media_list : procedure(p_mlp:Plibvlc_media_list_player_t; p_mlist:Plibvlc_media_list_t); cdecl; + libvlc_media_list_player_play : procedure(p_mlp:Plibvlc_media_list_player_t); cdecl; + libvlc_media_list_player_pause : procedure(p_mlp:Plibvlc_media_list_player_t); cdecl; + libvlc_media_list_player_is_playing : function(p_mlp:Plibvlc_media_list_player_t):cint; cdecl; + libvlc_media_list_player_get_state : function(p_mlp:Plibvlc_media_list_player_t):libvlc_state_t; cdecl; + libvlc_media_list_player_play_item_at_index : function(p_mlp:Plibvlc_media_list_player_t; i_index:cint):cint; cdecl; + libvlc_media_list_player_play_item : function(p_mlp:Plibvlc_media_list_player_t; p_md:Plibvlc_media_t):cint; cdecl; + libvlc_media_list_player_stop : procedure(p_mlp:Plibvlc_media_list_player_t); cdecl; + libvlc_media_list_player_next : function(p_mlp:Plibvlc_media_list_player_t):cint; cdecl; + libvlc_media_list_player_previous : function(p_mlp:Plibvlc_media_list_player_t):cint; cdecl; + libvlc_media_list_player_set_playback_mode : procedure(p_mlp:Plibvlc_media_list_player_t; e_mode:libvlc_playback_mode_t); cdecl; + libvlc_media_library_new : function(p_instance:Plibvlc_instance_t):plibvlc_media_library_t; cdecl; + libvlc_media_library_release : procedure(p_mlib:Plibvlc_media_library_t); cdecl; + libvlc_media_library_retain : procedure(p_mlib:Plibvlc_media_library_t); cdecl; + libvlc_media_library_load : function(p_mlib:Plibvlc_media_library_t):cint; cdecl; + libvlc_media_library_media_list : function(p_mlib:Plibvlc_media_library_t):plibvlc_media_list_t; cdecl; + libvlc_video_get_adjust_int : function(p_mi:Plibvlc_media_player_t; option:cunsigned):cint; cdecl; + libvlc_video_set_adjust_int : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; value:cint); cdecl; + libvlc_video_get_adjust_float : function(p_mi:Plibvlc_media_player_t; option:cunsigned):cfloat; cdecl; + libvlc_video_set_adjust_float : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; value:cfloat); cdecl; + libvlc_video_get_logo_int : function(p_mi:Plibvlc_media_player_t; option:cunsigned):cint; cdecl; + libvlc_video_set_logo_int : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; value:cint); cdecl; + libvlc_video_set_logo_string : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; psz_value:pcchar); cdecl; + libvlc_audio_set_format_callbacks : procedure(mp:Plibvlc_media_player_t; setup:libvlc_audio_setup_cb; cleanup:libvlc_audio_cleanup_cb); cdecl; + libvlc_audio_set_format : procedure(mp:Plibvlc_media_player_t; format:pcchar; rate:cunsigned; channels:cunsigned); cdecl; + libvlc_media_player_get_length : function(p_mi:Plibvlc_media_player_t):libvlc_time_t; cdecl; + libvlc_media_player_get_time : function(p_mi:Plibvlc_media_player_t):libvlc_time_t; cdecl; + libvlc_media_player_set_time : procedure(p_mi:Plibvlc_media_player_t; i_time:libvlc_time_t); cdecl; + libvlc_media_player_get_position : function(p_mi:Plibvlc_media_player_t):cfloat; cdecl; + libvlc_media_player_set_position : procedure(p_mi:Plibvlc_media_player_t; f_pos:cfloat); cdecl; + libvlc_media_player_set_chapter : procedure(p_mi:Plibvlc_media_player_t; i_chapter:cint); cdecl; + libvlc_media_player_get_chapter : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_get_chapter_count : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_will_play : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_get_chapter_count_for_title : function(p_mi:Plibvlc_media_player_t; i_title:cint):cint; cdecl; + libvlc_media_player_set_title : procedure(p_mi:Plibvlc_media_player_t; i_title:cint); cdecl; + libvlc_media_player_get_title : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_get_title_count : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_previous_chapter : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_next_chapter : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_get_rate : function(p_mi:Plibvlc_media_player_t):cfloat; cdecl; + libvlc_media_player_set_rate : function(p_mi:Plibvlc_media_player_t; rate:cfloat):cint; cdecl; + libvlc_media_player_get_state : function(p_mi:Plibvlc_media_player_t):libvlc_state_t; cdecl; + libvlc_media_player_get_fps : function(p_mi:Plibvlc_media_player_t):cfloat; cdecl; + libvlc_media_player_has_vout : function(p_mi:Plibvlc_media_player_t):cunsigned; cdecl; + libvlc_media_player_is_seekable : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_can_pause : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_media_player_next_frame : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_media_player_navigate : procedure(p_mi:Plibvlc_media_player_t; navigate:cunsigned); cdecl; + libvlc_track_description_list_release : procedure(p_track_description:Plibvlc_track_description_t); cdecl; + libvlc_track_description_release : procedure(p_track_description:Plibvlc_track_description_t); cdecl; + libvlc_toggle_fullscreen : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_set_fullscreen : procedure(p_mi:Plibvlc_media_player_t; b_fullscreen:cint); cdecl; + libvlc_get_fullscreen : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_set_key_input : procedure(p_mi:Plibvlc_media_player_t; on:cunsigned); cdecl; + libvlc_video_set_mouse_input : procedure(p_mi:Plibvlc_media_player_t; on:cunsigned); cdecl; + libvlc_video_get_size : function(p_mi:Plibvlc_media_player_t; num:cunsigned; px:pcunsigned; py:pcunsigned):cint; cdecl; + libvlc_video_get_height : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_get_width : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_get_cursor : function(p_mi:Plibvlc_media_player_t; num:cunsigned; px:pcint; py:pcint):cint; cdecl; + libvlc_video_get_scale : function(p_mi:Plibvlc_media_player_t):cfloat; cdecl; + libvlc_video_set_scale : procedure(p_mi:Plibvlc_media_player_t; f_factor:cfloat); cdecl; + libvlc_video_get_aspect_ratio : function(p_mi:Plibvlc_media_player_t):pcchar; cdecl; + libvlc_video_set_aspect_ratio : procedure(p_mi:Plibvlc_media_player_t; psz_aspect:pcchar); cdecl; + libvlc_video_get_spu : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_get_spu_count : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_get_spu_description : function(p_mi:Plibvlc_media_player_t):plibvlc_track_description_t; cdecl; + libvlc_video_set_spu : function(p_mi:Plibvlc_media_player_t; i_spu:cunsigned):cint; cdecl; + libvlc_video_set_subtitle_file : function(p_mi:Plibvlc_media_player_t; psz_subtitle:pcchar):cint; cdecl; + libvlc_video_get_spu_delay : function(p_mi:Plibvlc_media_player_t):int64_t; cdecl; + libvlc_video_set_spu_delay : function(p_mi:Plibvlc_media_player_t; i_delay:int64_t):cint; cdecl; + libvlc_video_get_title_description : function(p_mi:Plibvlc_media_player_t):plibvlc_track_description_t; cdecl; + libvlc_video_get_chapter_description : function(p_mi:Plibvlc_media_player_t; i_title:cint):plibvlc_track_description_t; cdecl; + libvlc_video_get_crop_geometry : function(p_mi:Plibvlc_media_player_t):pcchar; cdecl; + libvlc_video_set_crop_geometry : procedure(p_mi:Plibvlc_media_player_t; psz_geometry:pcchar); cdecl; + libvlc_video_get_teletext : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_set_teletext : procedure(p_mi:Plibvlc_media_player_t; i_page:cint); cdecl; + libvlc_toggle_teletext : procedure(p_mi:Plibvlc_media_player_t); cdecl; + libvlc_video_get_track_count : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_get_track_description : function(p_mi:Plibvlc_media_player_t):plibvlc_track_description_t; cdecl; + libvlc_video_get_track : function(p_mi:Plibvlc_media_player_t):cint; cdecl; + libvlc_video_set_track : function(p_mi:Plibvlc_media_player_t; i_track:cint):cint; cdecl; + libvlc_video_take_snapshot : function(p_mi:Plibvlc_media_player_t; num:cunsigned; psz_filepath:pcchar; i_width:cuint; i_height:cuint):cint; cdecl; + libvlc_video_set_deinterlace : procedure(p_mi:Plibvlc_media_player_t; psz_mode:pcchar); cdecl; + libvlc_video_get_marquee_int : function(p_mi:Plibvlc_media_player_t; option:cunsigned):cint; cdecl; + libvlc_video_get_marquee_string : function(p_mi:Plibvlc_media_player_t; option:cunsigned):pcchar; cdecl; + libvlc_video_set_marquee_int : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; i_val:cint); cdecl; + libvlc_video_set_marquee_string : procedure(p_mi:Plibvlc_media_player_t; option:cunsigned; psz_text:pcchar); cdecl; + libvlc_audio_set_callbacks : procedure(mp:Plibvlc_media_player_t; play:libvlc_audio_play_cb; pause:libvlc_audio_pause_cb; resume:libvlc_audio_resume_cb; flush:libvlc_audio_flush_cb; + drain:libvlc_audio_drain_cb; opaque:pointer); cdecl; + libvlc_audio_set_volume_callback : procedure(mp:Plibvlc_media_player_t; set_volume:libvlc_audio_set_volume_cb); cdecl; + libvlc_video_set_callbacks : procedure(mp:Plibvlc_media_player_t; lock:libvlc_video_lock_cb; unlock:libvlc_video_unlock_cb; display:libvlc_video_display_cb; opaque:pointer); cdecl; + libvlc_video_set_format : procedure(mp:Plibvlc_media_player_t; chroma:pcchar; width:cunsigned; height:cunsigned; pitch:cunsigned); cdecl; + libvlc_video_set_format_callbacks : procedure(mp:Plibvlc_media_player_t; setup:libvlc_video_format_cb; cleanup:libvlc_video_cleanup_cb); cdecl; + libvlc_media_player_set_nsobject : procedure(p_mi:Plibvlc_media_player_t; drawable:pointer); cdecl; + libvlc_media_player_get_nsobject : function(p_mi:Plibvlc_media_player_t):pointer; cdecl; + libvlc_media_player_set_agl : procedure(p_mi:Plibvlc_media_player_t; drawable:uint32_t); cdecl; + libvlc_media_player_get_agl : function(p_mi:Plibvlc_media_player_t):uint32_t; cdecl; + libvlc_media_player_set_xwindow : procedure(p_mi:Plibvlc_media_player_t; drawable:uint32_t); cdecl; + libvlc_media_player_get_xwindow : function(p_mi:Plibvlc_media_player_t):uint32_t; cdecl; + libvlc_media_player_set_hwnd : procedure(p_mi:Plibvlc_media_player_t; drawable:pointer); cdecl; + libvlc_media_player_get_hwnd : function(p_mi:Plibvlc_media_player_t):pointer; cdecl; + libvlc_media_discoverer_new_from_name : function(p_inst:Plibvlc_instance_t; psz_name:pcchar):plibvlc_media_discoverer_t; cdecl; + libvlc_media_discoverer_release : procedure(p_mdis:Plibvlc_media_discoverer_t); cdecl; + libvlc_media_discoverer_localized_name : function(p_mdis:Plibvlc_media_discoverer_t):pcchar; cdecl; + libvlc_media_discoverer_media_list : function(p_mdis:Plibvlc_media_discoverer_t):plibvlc_media_list_t; cdecl; + libvlc_media_discoverer_event_manager : function(p_mdis:Plibvlc_media_discoverer_t):plibvlc_event_manager_t; cdecl; + libvlc_media_discoverer_is_running : function(p_mdis:Plibvlc_media_discoverer_t):cint; cdecl; + libvlc_vlm_release : procedure(p_instance:Plibvlc_instance_t); cdecl; + libvlc_vlm_add_broadcast : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_input:pcchar; psz_output:pcchar; i_options:cint; + ppsz_options:Ppcchar; b_enabled:cint; b_loop:cint):cint; cdecl; + libvlc_vlm_add_vod : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_input:pcchar; i_options:cint; ppsz_options:Ppcchar; + b_enabled:cint; psz_mux:pcchar):cint; cdecl; + libvlc_vlm_del_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):cint; cdecl; + libvlc_vlm_set_enabled : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; b_enabled:cint):cint; cdecl; + libvlc_vlm_set_output : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_output:pcchar):cint; cdecl; + libvlc_vlm_set_input : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_input:pcchar):cint; cdecl; + libvlc_vlm_add_input : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_input:pcchar):cint; cdecl; + libvlc_vlm_set_loop : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; b_loop:cint):cint; cdecl; + libvlc_vlm_set_mux : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_mux:pcchar):cint; cdecl; + libvlc_vlm_change_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; psz_input:pcchar; psz_output:pcchar; i_options:cint; + ppsz_options:Ppcchar; b_enabled:cint; b_loop:cint):cint; cdecl; + libvlc_vlm_play_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):cint; cdecl; + libvlc_vlm_stop_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):cint; cdecl; + libvlc_vlm_pause_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):cint; cdecl; + libvlc_vlm_seek_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; f_percentage:cfloat):cint; cdecl; + libvlc_vlm_show_media : function(p_instance:Plibvlc_instance_t; psz_name:pcchar):pcchar; cdecl; + libvlc_vlm_get_media_instance_position : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; i_instance:cint):cfloat; cdecl; + libvlc_vlm_get_media_instance_time : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; i_instance:cint):cint; cdecl; + libvlc_vlm_get_media_instance_length : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; i_instance:cint):cint; cdecl; + libvlc_vlm_get_media_instance_rate : function(p_instance:Plibvlc_instance_t; psz_name:pcchar; i_instance:cint):cint; cdecl; + libvlc_vlm_get_event_manager : function(p_instance:Plibvlc_instance_t):plibvlc_event_manager_t; cdecl; + libvlc_playlist_play : procedure(p_instance:Plibvlc_instance_t; i_id:cint; i_options:cint; ppsz_options:Ppcchar); cdecl; + +Procedure Freelibvlc; +Procedure Loadlibvlc(lib : AnsiString; CheckProcNames : Boolean = False); + +implementation + +uses + SysUtils, dynlibs; + +var + hlib : tlibhandle; + LibRefCount : Integer; + +procedure Freelibvlc; + +begin + if (LibRefCount>0) then + Dec(LibRefCount); + if LibRefCount>0 then + exit; + FreeLibrary(hlib); + libvlc_errmsg:=nil; + libvlc_clearerr:=nil; + libvlc_printerr:=nil; + libvlc_new:=nil; + libvlc_release:=nil; + libvlc_retain:=nil; + libvlc_add_intf:=nil; + libvlc_set_exit_handler:=nil; + libvlc_wait:=nil; + libvlc_set_user_agent:=nil; + libvlc_get_version:=nil; + libvlc_get_compiler:=nil; + libvlc_get_changeset:=nil; + libvlc_free:=nil; + libvlc_event_attach:=nil; + libvlc_event_detach:=nil; + libvlc_event_type_name:=nil; + libvlc_get_log_verbosity:=nil; + libvlc_set_log_verbosity:=nil; + libvlc_log_open:=nil; + libvlc_log_close:=nil; + libvlc_log_count:=nil; + libvlc_log_clear:=nil; + libvlc_log_get_iterator:=nil; + libvlc_log_iterator_free:=nil; + libvlc_log_iterator_has_next:=nil; + libvlc_log_iterator_next:=nil; + libvlc_module_description_list_release:=nil; + libvlc_audio_filter_list_get:=nil; + libvlc_video_filter_list_get:=nil; + libvlc_clock:=nil; + libvlc_media_new_location:=nil; + libvlc_media_new_path:=nil; + libvlc_media_new_fd:=nil; + libvlc_media_new_as_node:=nil; + libvlc_media_add_option:=nil; + libvlc_media_add_option_flag:=nil; + libvlc_media_retain:=nil; + libvlc_media_release:=nil; + libvlc_media_get_mrl:=nil; + libvlc_media_duplicate:=nil; + libvlc_media_get_meta:=nil; + libvlc_media_set_meta:=nil; + libvlc_media_save_meta:=nil; + libvlc_media_get_state:=nil; + libvlc_media_get_stats:=nil; + libvlc_media_subitems:=nil; + libvlc_media_event_manager:=nil; + libvlc_media_get_duration:=nil; + libvlc_media_parse:=nil; + libvlc_media_parse_async:=nil; + libvlc_media_is_parsed:=nil; + libvlc_media_set_user_data:=nil; + libvlc_media_get_user_data:=nil; + libvlc_media_get_tracks_info:=nil; + libvlc_media_player_new:=nil; + libvlc_media_player_new_from_media:=nil; + libvlc_media_player_release:=nil; + libvlc_media_player_retain:=nil; + libvlc_media_player_set_media:=nil; + libvlc_media_player_get_media:=nil; + libvlc_media_player_event_manager:=nil; + libvlc_media_player_is_playing:=nil; + libvlc_media_player_play:=nil; + libvlc_media_player_set_pause:=nil; + libvlc_media_player_pause:=nil; + libvlc_media_player_stop:=nil; + libvlc_video_set_callbacks:=nil; + libvlc_video_set_format:=nil; + libvlc_video_set_format_callbacks:=nil; + libvlc_media_player_set_nsobject:=nil; + libvlc_media_player_get_nsobject:=nil; + libvlc_media_player_set_agl:=nil; + libvlc_media_player_get_agl:=nil; + libvlc_media_player_set_xwindow:=nil; + libvlc_media_player_get_xwindow:=nil; + libvlc_media_player_set_hwnd:=nil; + libvlc_media_player_get_hwnd:=nil; + libvlc_audio_set_callbacks:=nil; + libvlc_audio_set_volume_callback:=nil; + libvlc_audio_set_format_callbacks:=nil; + libvlc_audio_set_format:=nil; + libvlc_media_player_get_length:=nil; + libvlc_media_player_get_time:=nil; + libvlc_media_player_set_time:=nil; + libvlc_media_player_get_position:=nil; + libvlc_media_player_set_position:=nil; + libvlc_media_player_set_chapter:=nil; + libvlc_media_player_get_chapter:=nil; + libvlc_media_player_get_chapter_count:=nil; + libvlc_media_player_will_play:=nil; + libvlc_media_player_get_chapter_count_for_title:=nil; + libvlc_media_player_set_title:=nil; + libvlc_media_player_get_title:=nil; + libvlc_media_player_get_title_count:=nil; + libvlc_media_player_previous_chapter:=nil; + libvlc_media_player_next_chapter:=nil; + libvlc_media_player_get_rate:=nil; + libvlc_media_player_set_rate:=nil; + libvlc_media_player_get_state:=nil; + libvlc_media_player_get_fps:=nil; + libvlc_media_player_has_vout:=nil; + libvlc_media_player_is_seekable:=nil; + libvlc_media_player_can_pause:=nil; + libvlc_media_player_next_frame:=nil; + libvlc_media_player_navigate:=nil; + libvlc_track_description_list_release:=nil; + libvlc_track_description_release:=nil; + libvlc_toggle_fullscreen:=nil; + libvlc_set_fullscreen:=nil; + libvlc_get_fullscreen:=nil; + libvlc_video_set_key_input:=nil; + libvlc_video_set_mouse_input:=nil; + libvlc_video_get_size:=nil; + libvlc_video_get_height:=nil; + libvlc_video_get_width:=nil; + libvlc_video_get_cursor:=nil; + libvlc_video_get_scale:=nil; + libvlc_video_set_scale:=nil; + libvlc_video_get_aspect_ratio:=nil; + libvlc_video_set_aspect_ratio:=nil; + libvlc_video_get_spu:=nil; + libvlc_video_get_spu_count:=nil; + libvlc_video_get_spu_description:=nil; + libvlc_video_set_spu:=nil; + libvlc_video_set_subtitle_file:=nil; + libvlc_video_get_spu_delay:=nil; + libvlc_video_set_spu_delay:=nil; + libvlc_video_get_title_description:=nil; + libvlc_video_get_chapter_description:=nil; + libvlc_video_get_crop_geometry:=nil; + libvlc_video_set_crop_geometry:=nil; + libvlc_video_get_teletext:=nil; + libvlc_video_set_teletext:=nil; + libvlc_toggle_teletext:=nil; + libvlc_video_get_track_count:=nil; + libvlc_video_get_track_description:=nil; + libvlc_video_get_track:=nil; + libvlc_video_set_track:=nil; + libvlc_video_take_snapshot:=nil; + libvlc_video_set_deinterlace:=nil; + libvlc_video_get_marquee_int:=nil; + libvlc_video_get_marquee_string:=nil; + libvlc_video_set_marquee_int:=nil; + libvlc_video_set_marquee_string:=nil; + libvlc_video_get_logo_int:=nil; + libvlc_video_set_logo_int:=nil; + libvlc_video_set_logo_string:=nil; + libvlc_video_get_adjust_int:=nil; + libvlc_video_set_adjust_int:=nil; + libvlc_video_get_adjust_float:=nil; + libvlc_video_set_adjust_float:=nil; + libvlc_audio_output_list_get:=nil; + libvlc_audio_output_list_release:=nil; + libvlc_audio_output_set:=nil; + libvlc_audio_output_device_count:=nil; + libvlc_audio_output_device_longname:=nil; + libvlc_audio_output_device_id:=nil; + libvlc_audio_output_device_set:=nil; + libvlc_audio_output_get_device_type:=nil; + libvlc_audio_output_set_device_type:=nil; + libvlc_audio_toggle_mute:=nil; + libvlc_audio_get_mute:=nil; + libvlc_audio_set_mute:=nil; + libvlc_audio_get_volume:=nil; + libvlc_audio_set_volume:=nil; + libvlc_audio_get_track_count:=nil; + libvlc_audio_get_track_description:=nil; + libvlc_audio_get_track:=nil; + libvlc_audio_set_track:=nil; + libvlc_audio_get_channel:=nil; + libvlc_audio_set_channel:=nil; + libvlc_audio_get_delay:=nil; + libvlc_audio_set_delay:=nil; + libvlc_media_list_new:=nil; + libvlc_media_list_release:=nil; + libvlc_media_list_retain:=nil; + libvlc_media_list_add_file_content:=nil; + libvlc_media_list_set_media:=nil; + libvlc_media_list_media:=nil; + libvlc_media_list_add_media:=nil; + libvlc_media_list_insert_media:=nil; + libvlc_media_list_remove_index:=nil; + libvlc_media_list_count:=nil; + libvlc_media_list_item_at_index:=nil; + libvlc_media_list_index_of_item:=nil; + libvlc_media_list_is_readonly:=nil; + libvlc_media_list_lock:=nil; + libvlc_media_list_unlock:=nil; + libvlc_media_list_event_manager:=nil; + libvlc_media_list_player_new:=nil; + libvlc_media_list_player_release:=nil; + libvlc_media_list_player_retain:=nil; + libvlc_media_list_player_event_manager:=nil; + libvlc_media_list_player_set_media_player:=nil; + libvlc_media_list_player_set_media_list:=nil; + libvlc_media_list_player_play:=nil; + libvlc_media_list_player_pause:=nil; + libvlc_media_list_player_is_playing:=nil; + libvlc_media_list_player_get_state:=nil; + libvlc_media_list_player_play_item_at_index:=nil; + libvlc_media_list_player_play_item:=nil; + libvlc_media_list_player_stop:=nil; + libvlc_media_list_player_next:=nil; + libvlc_media_list_player_previous:=nil; + libvlc_media_list_player_set_playback_mode:=nil; + libvlc_media_library_new:=nil; + libvlc_media_library_release:=nil; + libvlc_media_library_retain:=nil; + libvlc_media_library_load:=nil; + libvlc_media_library_media_list:=nil; + libvlc_media_discoverer_new_from_name:=nil; + libvlc_media_discoverer_release:=nil; + libvlc_media_discoverer_localized_name:=nil; + libvlc_media_discoverer_media_list:=nil; + libvlc_media_discoverer_event_manager:=nil; + libvlc_media_discoverer_is_running:=nil; + libvlc_vlm_release:=nil; + libvlc_vlm_add_broadcast:=nil; + libvlc_vlm_add_vod:=nil; + libvlc_vlm_del_media:=nil; + libvlc_vlm_set_enabled:=nil; + libvlc_vlm_set_output:=nil; + libvlc_vlm_set_input:=nil; + libvlc_vlm_add_input:=nil; + libvlc_vlm_set_loop:=nil; + libvlc_vlm_set_mux:=nil; + libvlc_vlm_change_media:=nil; + libvlc_vlm_play_media:=nil; + libvlc_vlm_stop_media:=nil; + libvlc_vlm_pause_media:=nil; + libvlc_vlm_seek_media:=nil; + libvlc_vlm_show_media:=nil; + libvlc_vlm_get_media_instance_position:=nil; + libvlc_vlm_get_media_instance_time:=nil; + libvlc_vlm_get_media_instance_length:=nil; + libvlc_vlm_get_media_instance_rate:=nil; + libvlc_vlm_get_event_manager:=nil; + libvlc_playlist_play:=nil; +end; + + +Procedure Loadlibvlc(lib : AnsiString; CheckProcNames : Boolean = False); + + Function GetProcAddress(h : TLibHandle; Name : AnsiString) : Pointer; + + begin + Result:=dynlibs.GetProcAddress(h,Name); + If (Result=Nil) and CheckProcNames then + raise Exception.CreateFmt('Could not find procedure address: %s ',[Name]); + end; + + Procedure EM(FN : String); + + begin + {$ifndef VER2_6} + Raise Exception.CreateFmt('Could not load library "%s": %s',[FN,GetLoadErrorStr]); + {$else} + raise Exception.CreateFmt('Could not load library "%s"',[FN]); + {$endif} + end; + + + +Var + D : String; + +begin + if (hLib<>NilHandle) then + begin + Inc(LibRefCount); + Exit; + end; + D:=ExtractFilePath(lib); + {$ifdef windows} + if (LoadLibrary(d+corelibname)=NilHandle) then + if (d='') and (LoadLibrary(DefaultlibPath+corelibname)=NilHandle) then + EM(DefaultlibPath+corelibname); + {$endif} + hlib:=LoadLibrary(lib); + if (hlib=NilHandle) then +{$ifndef windows} + EM(Lib); +{$else} + if (d='') then + begin + hlib:=LoadLibrary(DefaultlibPath+ExtractFileName(Lib)); + if (hlib=NilHandle) then + EM(Lib); + end; +{$endif} + Inc(LibRefCount); + pointer(libvlc_errmsg):=GetProcAddress(hlib,'libvlc_errmsg'); + pointer(libvlc_clearerr):=GetProcAddress(hlib,'libvlc_clearerr'); + pointer(libvlc_printerr):=GetProcAddress(hlib,'libvlc_printerr'); + pointer(libvlc_new):=GetProcAddress(hlib,'libvlc_new'); + pointer(libvlc_release):=GetProcAddress(hlib,'libvlc_release'); + pointer(libvlc_retain):=GetProcAddress(hlib,'libvlc_retain'); + pointer(libvlc_add_intf):=GetProcAddress(hlib,'libvlc_add_intf'); + pointer(libvlc_set_exit_handler):=GetProcAddress(hlib,'libvlc_set_exit_handler'); + pointer(libvlc_wait):=GetProcAddress(hlib,'libvlc_wait'); + pointer(libvlc_set_user_agent):=GetProcAddress(hlib,'libvlc_set_user_agent'); + pointer(libvlc_get_version):=GetProcAddress(hlib,'libvlc_get_version'); + pointer(libvlc_get_compiler):=GetProcAddress(hlib,'libvlc_get_compiler'); + pointer(libvlc_get_changeset):=GetProcAddress(hlib,'libvlc_get_changeset'); + pointer(libvlc_free):=GetProcAddress(hlib,'libvlc_free'); + pointer(libvlc_event_attach):=GetProcAddress(hlib,'libvlc_event_attach'); + pointer(libvlc_event_detach):=GetProcAddress(hlib,'libvlc_event_detach'); + pointer(libvlc_event_type_name):=GetProcAddress(hlib,'libvlc_event_type_name'); + pointer(libvlc_get_log_verbosity):=GetProcAddress(hlib,'libvlc_get_log_verbosity'); + pointer(libvlc_set_log_verbosity):=GetProcAddress(hlib,'libvlc_set_log_verbosity'); + pointer(libvlc_log_open):=GetProcAddress(hlib,'libvlc_log_open'); + pointer(libvlc_log_close):=GetProcAddress(hlib,'libvlc_log_close'); + pointer(libvlc_log_count):=GetProcAddress(hlib,'libvlc_log_count'); + pointer(libvlc_log_clear):=GetProcAddress(hlib,'libvlc_log_clear'); + pointer(libvlc_log_get_iterator):=GetProcAddress(hlib,'libvlc_log_get_iterator'); + pointer(libvlc_log_iterator_free):=GetProcAddress(hlib,'libvlc_log_iterator_free'); + pointer(libvlc_log_iterator_has_next):=GetProcAddress(hlib,'libvlc_log_iterator_has_next'); + pointer(libvlc_log_iterator_next):=GetProcAddress(hlib,'libvlc_log_iterator_next'); + pointer(libvlc_module_description_list_release):=GetProcAddress(hlib,'libvlc_module_description_list_release'); + pointer(libvlc_audio_filter_list_get):=GetProcAddress(hlib,'libvlc_audio_filter_list_get'); + pointer(libvlc_video_filter_list_get):=GetProcAddress(hlib,'libvlc_video_filter_list_get'); + pointer(libvlc_clock):=GetProcAddress(hlib,'libvlc_clock'); + pointer(libvlc_media_new_location):=GetProcAddress(hlib,'libvlc_media_new_location'); + pointer(libvlc_media_new_path):=GetProcAddress(hlib,'libvlc_media_new_path'); + pointer(libvlc_media_new_fd):=GetProcAddress(hlib,'libvlc_media_new_fd'); + pointer(libvlc_media_new_as_node):=GetProcAddress(hlib,'libvlc_media_new_as_node'); + pointer(libvlc_media_add_option):=GetProcAddress(hlib,'libvlc_media_add_option'); + pointer(libvlc_media_add_option_flag):=GetProcAddress(hlib,'libvlc_media_add_option_flag'); + pointer(libvlc_media_retain):=GetProcAddress(hlib,'libvlc_media_retain'); + pointer(libvlc_media_release):=GetProcAddress(hlib,'libvlc_media_release'); + pointer(libvlc_media_get_mrl):=GetProcAddress(hlib,'libvlc_media_get_mrl'); + pointer(libvlc_media_duplicate):=GetProcAddress(hlib,'libvlc_media_duplicate'); + pointer(libvlc_media_get_meta):=GetProcAddress(hlib,'libvlc_media_get_meta'); + pointer(libvlc_media_set_meta):=GetProcAddress(hlib,'libvlc_media_set_meta'); + pointer(libvlc_media_save_meta):=GetProcAddress(hlib,'libvlc_media_save_meta'); + pointer(libvlc_media_get_state):=GetProcAddress(hlib,'libvlc_media_get_state'); + pointer(libvlc_media_get_stats):=GetProcAddress(hlib,'libvlc_media_get_stats'); + pointer(libvlc_media_subitems):=GetProcAddress(hlib,'libvlc_media_subitems'); + pointer(libvlc_media_event_manager):=GetProcAddress(hlib,'libvlc_media_event_manager'); + pointer(libvlc_media_get_duration):=GetProcAddress(hlib,'libvlc_media_get_duration'); + pointer(libvlc_media_parse):=GetProcAddress(hlib,'libvlc_media_parse'); + pointer(libvlc_media_parse_async):=GetProcAddress(hlib,'libvlc_media_parse_async'); + pointer(libvlc_media_is_parsed):=GetProcAddress(hlib,'libvlc_media_is_parsed'); + pointer(libvlc_media_set_user_data):=GetProcAddress(hlib,'libvlc_media_set_user_data'); + pointer(libvlc_media_get_user_data):=GetProcAddress(hlib,'libvlc_media_get_user_data'); + pointer(libvlc_media_get_tracks_info):=GetProcAddress(hlib,'libvlc_media_get_tracks_info'); + pointer(libvlc_media_player_new):=GetProcAddress(hlib,'libvlc_media_player_new'); + pointer(libvlc_media_player_new_from_media):=GetProcAddress(hlib,'libvlc_media_player_new_from_media'); + pointer(libvlc_media_player_release):=GetProcAddress(hlib,'libvlc_media_player_release'); + pointer(libvlc_media_player_retain):=GetProcAddress(hlib,'libvlc_media_player_retain'); + pointer(libvlc_media_player_set_media):=GetProcAddress(hlib,'libvlc_media_player_set_media'); + pointer(libvlc_media_player_get_media):=GetProcAddress(hlib,'libvlc_media_player_get_media'); + pointer(libvlc_media_player_event_manager):=GetProcAddress(hlib,'libvlc_media_player_event_manager'); + pointer(libvlc_media_player_is_playing):=GetProcAddress(hlib,'libvlc_media_player_is_playing'); + pointer(libvlc_media_player_play):=GetProcAddress(hlib,'libvlc_media_player_play'); + pointer(libvlc_media_player_set_pause):=GetProcAddress(hlib,'libvlc_media_player_set_pause'); + pointer(libvlc_media_player_pause):=GetProcAddress(hlib,'libvlc_media_player_pause'); + pointer(libvlc_media_player_stop):=GetProcAddress(hlib,'libvlc_media_player_stop'); + pointer(libvlc_video_set_callbacks):=GetProcAddress(hlib,'libvlc_video_set_callbacks'); + pointer(libvlc_video_set_format):=GetProcAddress(hlib,'libvlc_video_set_format'); + pointer(libvlc_video_set_format_callbacks):=GetProcAddress(hlib,'libvlc_video_set_format_callbacks'); + pointer(libvlc_media_player_set_nsobject):=GetProcAddress(hlib,'libvlc_media_player_set_nsobject'); + pointer(libvlc_media_player_get_nsobject):=GetProcAddress(hlib,'libvlc_media_player_get_nsobject'); + pointer(libvlc_media_player_set_agl):=GetProcAddress(hlib,'libvlc_media_player_set_agl'); + pointer(libvlc_media_player_get_agl):=GetProcAddress(hlib,'libvlc_media_player_get_agl'); + pointer(libvlc_media_player_set_xwindow):=GetProcAddress(hlib,'libvlc_media_player_set_xwindow'); + pointer(libvlc_media_player_get_xwindow):=GetProcAddress(hlib,'libvlc_media_player_get_xwindow'); + pointer(libvlc_media_player_set_hwnd):=GetProcAddress(hlib,'libvlc_media_player_set_hwnd'); + pointer(libvlc_media_player_get_hwnd):=GetProcAddress(hlib,'libvlc_media_player_get_hwnd'); + pointer(libvlc_audio_set_callbacks):=GetProcAddress(hlib,'libvlc_audio_set_callbacks'); + pointer(libvlc_audio_set_volume_callback):=GetProcAddress(hlib,'libvlc_audio_set_volume_callback'); + pointer(libvlc_audio_set_format_callbacks):=GetProcAddress(hlib,'libvlc_audio_set_format_callbacks'); + pointer(libvlc_audio_set_format):=GetProcAddress(hlib,'libvlc_audio_set_format'); + pointer(libvlc_media_player_get_length):=GetProcAddress(hlib,'libvlc_media_player_get_length'); + pointer(libvlc_media_player_get_time):=GetProcAddress(hlib,'libvlc_media_player_get_time'); + pointer(libvlc_media_player_set_time):=GetProcAddress(hlib,'libvlc_media_player_set_time'); + pointer(libvlc_media_player_get_position):=GetProcAddress(hlib,'libvlc_media_player_get_position'); + pointer(libvlc_media_player_set_position):=GetProcAddress(hlib,'libvlc_media_player_set_position'); + pointer(libvlc_media_player_set_chapter):=GetProcAddress(hlib,'libvlc_media_player_set_chapter'); + pointer(libvlc_media_player_get_chapter):=GetProcAddress(hlib,'libvlc_media_player_get_chapter'); + pointer(libvlc_media_player_get_chapter_count):=GetProcAddress(hlib,'libvlc_media_player_get_chapter_count'); + pointer(libvlc_media_player_will_play):=GetProcAddress(hlib,'libvlc_media_player_will_play'); + pointer(libvlc_media_player_get_chapter_count_for_title):=GetProcAddress(hlib,'libvlc_media_player_get_chapter_count_for_title'); + pointer(libvlc_media_player_set_title):=GetProcAddress(hlib,'libvlc_media_player_set_title'); + pointer(libvlc_media_player_get_title):=GetProcAddress(hlib,'libvlc_media_player_get_title'); + pointer(libvlc_media_player_get_title_count):=GetProcAddress(hlib,'libvlc_media_player_get_title_count'); + pointer(libvlc_media_player_previous_chapter):=GetProcAddress(hlib,'libvlc_media_player_previous_chapter'); + pointer(libvlc_media_player_next_chapter):=GetProcAddress(hlib,'libvlc_media_player_next_chapter'); + pointer(libvlc_media_player_get_rate):=GetProcAddress(hlib,'libvlc_media_player_get_rate'); + pointer(libvlc_media_player_set_rate):=GetProcAddress(hlib,'libvlc_media_player_set_rate'); + pointer(libvlc_media_player_get_state):=GetProcAddress(hlib,'libvlc_media_player_get_state'); + pointer(libvlc_media_player_get_fps):=GetProcAddress(hlib,'libvlc_media_player_get_fps'); + pointer(libvlc_media_player_has_vout):=GetProcAddress(hlib,'libvlc_media_player_has_vout'); + pointer(libvlc_media_player_is_seekable):=GetProcAddress(hlib,'libvlc_media_player_is_seekable'); + pointer(libvlc_media_player_can_pause):=GetProcAddress(hlib,'libvlc_media_player_can_pause'); + pointer(libvlc_media_player_next_frame):=GetProcAddress(hlib,'libvlc_media_player_next_frame'); + pointer(libvlc_media_player_navigate):=GetProcAddress(hlib,'libvlc_media_player_navigate'); + pointer(libvlc_track_description_list_release):=GetProcAddress(hlib,'libvlc_track_description_list_release'); + pointer(libvlc_track_description_release):=GetProcAddress(hlib,'libvlc_track_description_release'); + pointer(libvlc_toggle_fullscreen):=GetProcAddress(hlib,'libvlc_toggle_fullscreen'); + pointer(libvlc_set_fullscreen):=GetProcAddress(hlib,'libvlc_set_fullscreen'); + pointer(libvlc_get_fullscreen):=GetProcAddress(hlib,'libvlc_get_fullscreen'); + pointer(libvlc_video_set_key_input):=GetProcAddress(hlib,'libvlc_video_set_key_input'); + pointer(libvlc_video_set_mouse_input):=GetProcAddress(hlib,'libvlc_video_set_mouse_input'); + pointer(libvlc_video_get_size):=GetProcAddress(hlib,'libvlc_video_get_size'); + pointer(libvlc_video_get_height):=GetProcAddress(hlib,'libvlc_video_get_height'); + pointer(libvlc_video_get_width):=GetProcAddress(hlib,'libvlc_video_get_width'); + pointer(libvlc_video_get_cursor):=GetProcAddress(hlib,'libvlc_video_get_cursor'); + pointer(libvlc_video_get_scale):=GetProcAddress(hlib,'libvlc_video_get_scale'); + pointer(libvlc_video_set_scale):=GetProcAddress(hlib,'libvlc_video_set_scale'); + pointer(libvlc_video_get_aspect_ratio):=GetProcAddress(hlib,'libvlc_video_get_aspect_ratio'); + pointer(libvlc_video_set_aspect_ratio):=GetProcAddress(hlib,'libvlc_video_set_aspect_ratio'); + pointer(libvlc_video_get_spu):=GetProcAddress(hlib,'libvlc_video_get_spu'); + pointer(libvlc_video_get_spu_count):=GetProcAddress(hlib,'libvlc_video_get_spu_count'); + pointer(libvlc_video_get_spu_description):=GetProcAddress(hlib,'libvlc_video_get_spu_description'); + pointer(libvlc_video_set_spu):=GetProcAddress(hlib,'libvlc_video_set_spu'); + pointer(libvlc_video_set_subtitle_file):=GetProcAddress(hlib,'libvlc_video_set_subtitle_file'); + pointer(libvlc_video_get_spu_delay):=GetProcAddress(hlib,'libvlc_video_get_spu_delay'); + pointer(libvlc_video_set_spu_delay):=GetProcAddress(hlib,'libvlc_video_set_spu_delay'); + pointer(libvlc_video_get_title_description):=GetProcAddress(hlib,'libvlc_video_get_title_description'); + pointer(libvlc_video_get_chapter_description):=GetProcAddress(hlib,'libvlc_video_get_chapter_description'); + pointer(libvlc_video_get_crop_geometry):=GetProcAddress(hlib,'libvlc_video_get_crop_geometry'); + pointer(libvlc_video_set_crop_geometry):=GetProcAddress(hlib,'libvlc_video_set_crop_geometry'); + pointer(libvlc_video_get_teletext):=GetProcAddress(hlib,'libvlc_video_get_teletext'); + pointer(libvlc_video_set_teletext):=GetProcAddress(hlib,'libvlc_video_set_teletext'); + pointer(libvlc_toggle_teletext):=GetProcAddress(hlib,'libvlc_toggle_teletext'); + pointer(libvlc_video_get_track_count):=GetProcAddress(hlib,'libvlc_video_get_track_count'); + pointer(libvlc_video_get_track_description):=GetProcAddress(hlib,'libvlc_video_get_track_description'); + pointer(libvlc_video_get_track):=GetProcAddress(hlib,'libvlc_video_get_track'); + pointer(libvlc_video_set_track):=GetProcAddress(hlib,'libvlc_video_set_track'); + pointer(libvlc_video_take_snapshot):=GetProcAddress(hlib,'libvlc_video_take_snapshot'); + pointer(libvlc_video_set_deinterlace):=GetProcAddress(hlib,'libvlc_video_set_deinterlace'); + pointer(libvlc_video_get_marquee_int):=GetProcAddress(hlib,'libvlc_video_get_marquee_int'); + pointer(libvlc_video_get_marquee_string):=GetProcAddress(hlib,'libvlc_video_get_marquee_string'); + pointer(libvlc_video_set_marquee_int):=GetProcAddress(hlib,'libvlc_video_set_marquee_int'); + pointer(libvlc_video_set_marquee_string):=GetProcAddress(hlib,'libvlc_video_set_marquee_string'); + pointer(libvlc_video_get_logo_int):=GetProcAddress(hlib,'libvlc_video_get_logo_int'); + pointer(libvlc_video_set_logo_int):=GetProcAddress(hlib,'libvlc_video_set_logo_int'); + pointer(libvlc_video_set_logo_string):=GetProcAddress(hlib,'libvlc_video_set_logo_string'); + pointer(libvlc_video_get_adjust_int):=GetProcAddress(hlib,'libvlc_video_get_adjust_int'); + pointer(libvlc_video_set_adjust_int):=GetProcAddress(hlib,'libvlc_video_set_adjust_int'); + pointer(libvlc_video_get_adjust_float):=GetProcAddress(hlib,'libvlc_video_get_adjust_float'); + pointer(libvlc_video_set_adjust_float):=GetProcAddress(hlib,'libvlc_video_set_adjust_float'); + pointer(libvlc_audio_output_list_get):=GetProcAddress(hlib,'libvlc_audio_output_list_get'); + pointer(libvlc_audio_output_list_release):=GetProcAddress(hlib,'libvlc_audio_output_list_release'); + pointer(libvlc_audio_output_set):=GetProcAddress(hlib,'libvlc_audio_output_set'); + pointer(libvlc_audio_output_device_count):=GetProcAddress(hlib,'libvlc_audio_output_device_count'); + pointer(libvlc_audio_output_device_longname):=GetProcAddress(hlib,'libvlc_audio_output_device_longname'); + pointer(libvlc_audio_output_device_id):=GetProcAddress(hlib,'libvlc_audio_output_device_id'); + pointer(libvlc_audio_output_device_set):=GetProcAddress(hlib,'libvlc_audio_output_device_set'); + pointer(libvlc_audio_output_get_device_type):=GetProcAddress(hlib,'libvlc_audio_output_get_device_type'); + pointer(libvlc_audio_output_set_device_type):=GetProcAddress(hlib,'libvlc_audio_output_set_device_type'); + pointer(libvlc_audio_toggle_mute):=GetProcAddress(hlib,'libvlc_audio_toggle_mute'); + pointer(libvlc_audio_get_mute):=GetProcAddress(hlib,'libvlc_audio_get_mute'); + pointer(libvlc_audio_set_mute):=GetProcAddress(hlib,'libvlc_audio_set_mute'); + pointer(libvlc_audio_get_volume):=GetProcAddress(hlib,'libvlc_audio_get_volume'); + pointer(libvlc_audio_set_volume):=GetProcAddress(hlib,'libvlc_audio_set_volume'); + pointer(libvlc_audio_get_track_count):=GetProcAddress(hlib,'libvlc_audio_get_track_count'); + pointer(libvlc_audio_get_track_description):=GetProcAddress(hlib,'libvlc_audio_get_track_description'); + pointer(libvlc_audio_get_track):=GetProcAddress(hlib,'libvlc_audio_get_track'); + pointer(libvlc_audio_set_track):=GetProcAddress(hlib,'libvlc_audio_set_track'); + pointer(libvlc_audio_get_channel):=GetProcAddress(hlib,'libvlc_audio_get_channel'); + pointer(libvlc_audio_set_channel):=GetProcAddress(hlib,'libvlc_audio_set_channel'); + pointer(libvlc_audio_get_delay):=GetProcAddress(hlib,'libvlc_audio_get_delay'); + pointer(libvlc_audio_set_delay):=GetProcAddress(hlib,'libvlc_audio_set_delay'); + pointer(libvlc_media_list_new):=GetProcAddress(hlib,'libvlc_media_list_new'); + pointer(libvlc_media_list_release):=GetProcAddress(hlib,'libvlc_media_list_release'); + pointer(libvlc_media_list_retain):=GetProcAddress(hlib,'libvlc_media_list_retain'); + pointer(libvlc_media_list_add_file_content):=GetProcAddress(hlib,'libvlc_media_list_add_file_content'); + pointer(libvlc_media_list_set_media):=GetProcAddress(hlib,'libvlc_media_list_set_media'); + pointer(libvlc_media_list_media):=GetProcAddress(hlib,'libvlc_media_list_media'); + pointer(libvlc_media_list_add_media):=GetProcAddress(hlib,'libvlc_media_list_add_media'); + pointer(libvlc_media_list_insert_media):=GetProcAddress(hlib,'libvlc_media_list_insert_media'); + pointer(libvlc_media_list_remove_index):=GetProcAddress(hlib,'libvlc_media_list_remove_index'); + pointer(libvlc_media_list_count):=GetProcAddress(hlib,'libvlc_media_list_count'); + pointer(libvlc_media_list_item_at_index):=GetProcAddress(hlib,'libvlc_media_list_item_at_index'); + pointer(libvlc_media_list_index_of_item):=GetProcAddress(hlib,'libvlc_media_list_index_of_item'); + pointer(libvlc_media_list_is_readonly):=GetProcAddress(hlib,'libvlc_media_list_is_readonly'); + pointer(libvlc_media_list_lock):=GetProcAddress(hlib,'libvlc_media_list_lock'); + pointer(libvlc_media_list_unlock):=GetProcAddress(hlib,'libvlc_media_list_unlock'); + pointer(libvlc_media_list_event_manager):=GetProcAddress(hlib,'libvlc_media_list_event_manager'); + pointer(libvlc_media_list_player_new):=GetProcAddress(hlib,'libvlc_media_list_player_new'); + pointer(libvlc_media_list_player_release):=GetProcAddress(hlib,'libvlc_media_list_player_release'); + pointer(libvlc_media_list_player_retain):=GetProcAddress(hlib,'libvlc_media_list_player_retain'); + pointer(libvlc_media_list_player_event_manager):=GetProcAddress(hlib,'libvlc_media_list_player_event_manager'); + pointer(libvlc_media_list_player_set_media_player):=GetProcAddress(hlib,'libvlc_media_list_player_set_media_player'); + pointer(libvlc_media_list_player_set_media_list):=GetProcAddress(hlib,'libvlc_media_list_player_set_media_list'); + pointer(libvlc_media_list_player_play):=GetProcAddress(hlib,'libvlc_media_list_player_play'); + pointer(libvlc_media_list_player_pause):=GetProcAddress(hlib,'libvlc_media_list_player_pause'); + pointer(libvlc_media_list_player_is_playing):=GetProcAddress(hlib,'libvlc_media_list_player_is_playing'); + pointer(libvlc_media_list_player_get_state):=GetProcAddress(hlib,'libvlc_media_list_player_get_state'); + pointer(libvlc_media_list_player_play_item_at_index):=GetProcAddress(hlib,'libvlc_media_list_player_play_item_at_index'); + pointer(libvlc_media_list_player_play_item):=GetProcAddress(hlib,'libvlc_media_list_player_play_item'); + pointer(libvlc_media_list_player_stop):=GetProcAddress(hlib,'libvlc_media_list_player_stop'); + pointer(libvlc_media_list_player_next):=GetProcAddress(hlib,'libvlc_media_list_player_next'); + pointer(libvlc_media_list_player_previous):=GetProcAddress(hlib,'libvlc_media_list_player_previous'); + pointer(libvlc_media_list_player_set_playback_mode):=GetProcAddress(hlib,'libvlc_media_list_player_set_playback_mode'); + pointer(libvlc_media_library_new):=GetProcAddress(hlib,'libvlc_media_library_new'); + pointer(libvlc_media_library_release):=GetProcAddress(hlib,'libvlc_media_library_release'); + pointer(libvlc_media_library_retain):=GetProcAddress(hlib,'libvlc_media_library_retain'); + pointer(libvlc_media_library_load):=GetProcAddress(hlib,'libvlc_media_library_load'); + pointer(libvlc_media_library_media_list):=GetProcAddress(hlib,'libvlc_media_library_media_list'); + pointer(libvlc_media_discoverer_new_from_name):=GetProcAddress(hlib,'libvlc_media_discoverer_new_from_name'); + pointer(libvlc_media_discoverer_release):=GetProcAddress(hlib,'libvlc_media_discoverer_release'); + pointer(libvlc_media_discoverer_localized_name):=GetProcAddress(hlib,'libvlc_media_discoverer_localized_name'); + pointer(libvlc_media_discoverer_media_list):=GetProcAddress(hlib,'libvlc_media_discoverer_media_list'); + pointer(libvlc_media_discoverer_event_manager):=GetProcAddress(hlib,'libvlc_media_discoverer_event_manager'); + pointer(libvlc_media_discoverer_is_running):=GetProcAddress(hlib,'libvlc_media_discoverer_is_running'); + pointer(libvlc_vlm_release):=GetProcAddress(hlib,'libvlc_vlm_release'); + pointer(libvlc_vlm_add_broadcast):=GetProcAddress(hlib,'libvlc_vlm_add_broadcast'); + pointer(libvlc_vlm_add_vod):=GetProcAddress(hlib,'libvlc_vlm_add_vod'); + pointer(libvlc_vlm_del_media):=GetProcAddress(hlib,'libvlc_vlm_del_media'); + pointer(libvlc_vlm_set_enabled):=GetProcAddress(hlib,'libvlc_vlm_set_enabled'); + pointer(libvlc_vlm_set_output):=GetProcAddress(hlib,'libvlc_vlm_set_output'); + pointer(libvlc_vlm_set_input):=GetProcAddress(hlib,'libvlc_vlm_set_input'); + pointer(libvlc_vlm_add_input):=GetProcAddress(hlib,'libvlc_vlm_add_input'); + pointer(libvlc_vlm_set_loop):=GetProcAddress(hlib,'libvlc_vlm_set_loop'); + pointer(libvlc_vlm_set_mux):=GetProcAddress(hlib,'libvlc_vlm_set_mux'); + pointer(libvlc_vlm_change_media):=GetProcAddress(hlib,'libvlc_vlm_change_media'); + pointer(libvlc_vlm_play_media):=GetProcAddress(hlib,'libvlc_vlm_play_media'); + pointer(libvlc_vlm_stop_media):=GetProcAddress(hlib,'libvlc_vlm_stop_media'); + pointer(libvlc_vlm_pause_media):=GetProcAddress(hlib,'libvlc_vlm_pause_media'); + pointer(libvlc_vlm_seek_media):=GetProcAddress(hlib,'libvlc_vlm_seek_media'); + pointer(libvlc_vlm_show_media):=GetProcAddress(hlib,'libvlc_vlm_show_media'); + pointer(libvlc_vlm_get_media_instance_position):=GetProcAddress(hlib,'libvlc_vlm_get_media_instance_position'); + pointer(libvlc_vlm_get_media_instance_time):=GetProcAddress(hlib,'libvlc_vlm_get_media_instance_time'); + pointer(libvlc_vlm_get_media_instance_length):=GetProcAddress(hlib,'libvlc_vlm_get_media_instance_length'); + pointer(libvlc_vlm_get_media_instance_rate):=GetProcAddress(hlib,'libvlc_vlm_get_media_instance_rate'); + pointer(libvlc_vlm_get_event_manager):=GetProcAddress(hlib,'libvlc_vlm_get_event_manager'); + pointer(libvlc_playlist_play):=GetProcAddress(hlib,'libvlc_playlist_play'); +end; + + +end. diff --git a/src/3rdparty/libvlc/vlc.pas b/src/3rdparty/libvlc/vlc.pas new file mode 100644 index 00000000..0f82b9c0 --- /dev/null +++ b/src/3rdparty/libvlc/vlc.pas @@ -0,0 +1,1746 @@ +unit vlc; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, ctypes, libvlc, syncobjs; + +Type + + { TVLCLibrary } + + TVLCLibrary = class(TComponent) + private + FInstance : plibvlc_instance_t; + FLibraryArgs: TStrings; + FLibraryPath : String; + function GetI: Boolean; + function GetLastError: String; + Function GetVersion : String; + Function GetCompiler : String; + Function GetChangeSet : String; + Procedure SetLibraryPath(Const AValue : String); + Protected + Function GetInstance : plibvlc_instance_t; virtual; + property Instance : plibvlc_instance_t read GetInstance; + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + Procedure Initialize; + Procedure Release; + property LastError : String read GetLastError; + property Version : String read GetVersion; + property Compiler : String read GetCompiler; + property ChangeSer : String read GetChangeSet; + property LibraryPath : String read FLibraryPath write SetLibraryPath; + Property LibraryArgs : TStrings read FLibraryArgs Write FLibraryArgs; + Property Initialized : Boolean Read GetI; + end; + + TVLCLibraryClass = Class of TVLCLibrary; + + TCustomVLCMediaPlayer = Class; + TVLCMediaItems = Class; + + { TVLCMediaItem } + TSnapShotFormat = (ssfPNG,ssfJPG); + TDeinterlaceMode = (dmBlend, dmDiscard, dmBob, dmLinear, dmMean, dmX, dmYadif, dmYadif2x); + + TVLCMediaItem = Class(TCollectionItem) + private + FDIM: TDeinterlaceMode; + FInstance : plibvlc_media_t; + FOpts : Array [0..3] of Boolean; // Keep in sync with property indexes + FPath: String; + FSS: TSNapshotFormat; + FFD: Integer; + function GetInstance: plibvlc_media_t; + function GetM(AIndex: Integer): Boolean; + function GetMD(AMeta : libvlc_meta_t): String; + function GetMRL: String; + function GetParsed: Boolean; + function GetUD: Pointer; + procedure SetDIM(AValue: TDeinterlaceMode); + procedure SetFSS(AValue: TSNapshotFormat); + procedure SetM(AIndex: Integer; AValue: Boolean); + Function GetBoolOpt(AIndex : Integer; AValue : Boolean) : String; + procedure SetMD(AMeta : libvlc_meta_t; AValue: String); + procedure SetUD(AValue: Pointer); + function GetState : libvlc_state_t; + function GetDuration : TDateTime; + Protected + Procedure RegisterInstance; + Procedure UnRegisterInstance; + procedure SetMRL(AValue: String); virtual; + procedure SetPath(AValue: String); virtual; + procedure SetFD(AValue: Integer); virtual; + Function GetVLC : TVLCLibrary; virtual; + function GetEventManager : plibvlc_event_manager_t; + Procedure SetInstance( Avalue : plibvlc_media_t); + Property Instance : plibvlc_media_t Read GetInstance; + Public + Destructor Destroy; override; + Procedure AddOption(Const AValue : String); + procedure Parse; + procedure ParseAsync; + Procedure SaveMetaData; + Function GetStats(Var AStats : libvlc_media_stats_t) : Boolean; + Function Duplicate : TVLCMediaItem; + Property Parsed : Boolean Read GetParsed; + Property ShowTitle : Boolean Index 0 Read GetM Write SetM; + Property VideoOnTop : Boolean Index 1 Read GetM Write SetM; + Property UseOverlay : Boolean Index 2 Read GetM Write SetM; + Property FullScreen : Boolean Index 3 Read GetM Write SetM; + Property DeinterlaceFilter : Boolean Index 4 Read GetM Write SetM; + Property DeInterlaceMode : TDeinterlaceMode Read FDIM Write SetDIM; + Property SnapShotFormat : TSNapshotFormat Read FSS Write SetFSS; + Property UserData : Pointer Read GetUD Write SetUD; + Property State : libvlc_state_t Read GetState; + Property Duration : TDateTime Read GetDuration; + Property MetaData[AMeta : libvlc_meta_t] : String Read GetMD Write SetMD; + // These must be set prior to using any of the above. + Property MRL : String Read GetMRL Write SetMRL; + Property Path : String Read FPath Write SetPath; + property FileDescriptor : Integer Read FFD Write SetFD; + end; + + TVLCMediaItemClass = Class of TVLCMediaItem; + + { TVLCMediaItems } + TVLCPlayMode = (pmNormal,pmLoop,pmRepeat); + + TVLCMediaItems = Class(TCollection) + Private + FPlayer: TCustomVLCMediaPlayer; + FPlayMode: TVLCPlayMode; + FVLC : TVLCLibrary; + FInstance : Plibvlc_media_list_t; + function GetI(AIndex : Integer): TVLCMediaItem; + function GetInstance: Plibvlc_media_list_t; + function GetIsReadOnly: Boolean; + procedure SetI(AIndex : Integer; AValue: TVLCMediaItem); + Protected + Function GetVLC : TVLCLibrary; virtual; + Public + Constructor Create(ALibrary : TVLCLibrary;AItemClass: TVLCMediaItemClass = Nil); overload; + Constructor Create(AInstance : Plibvlc_media_list_t;AItemClass: TVLCMediaItemClass = Nil); overload; + Procedure Lock; + Procedure Unlock; + Property Instance : Plibvlc_media_list_t read GetInstance; + Property VLC : TVLCLibrary Read GetVLC Write FVLC; + Property MediaItems[AIndex : Integer] : TVLCMediaItem Read GetI Write SetI; default; + Property ReadOnly : Boolean Read GetIsReadOnly; + end; + + { TCustomVLCMediaPlayer } + TBooleanEvent = procedure(Sender : TObject; Const AValue : Boolean) of object; + TTitleEvent = procedure(Sender : TObject; Const ATitle : Integer) of object; + TSnapshotEvent = procedure(Sender : TObject; Const AfileName : string) of object; + TErrorEvent = procedure(Sender : TObject; Const AError : string) of object; + TTimeEvent = procedure(Sender : TObject; Const time : TDateTime) of object; + TPositionEvent = procedure(Sender : TObject; Const APos : Double) of object; + + TCustomVLCMediaPlayer = Class(TComponent) + private + FFitWindow: Boolean; + FOnBackward: TNotifyEvent; + FOnBuffering: TNotifyEvent; + FOnEOF: TNotifyEvent; + FOnError: TErrorEvent; + FOnForward: TNotifyEvent; + FOnLengthChanged: TTimeEvent; + FOnMediaChanged: TNotifyEvent; + FOnNothingSpecial: TNotifyEvent; + FOnOpening: TNotifyEvent; + FOnPausableChanged: TBooleanEvent; + FOnPause: TNotifyEvent; + FOnPlaying: TNotifyEvent; + FOnPositionChanged: TPositionEvent; + FOnSeekableChanged: TBooleanEvent; + FOnSnapShot: TSnapShotEvent; + FOnStop: TNotifyEvent; + FOnTimeChanged: TTimeEvent; + FOnTitleChanged: TTitleEvent; + FUseEvents: Boolean; + Finstance : Plibvlc_media_player_t; + FVLC: TVLCLibrary; + FECS : TCriticalSection; + function GetAspectRatio: String; + function GetAudioMuted: Boolean; + function GetAudioTrack: Integer; + function GetHaveInstance: Boolean; + function GetState: libvlc_state_t; + function GetVideoDuration: TDateTime; + function GetVideoFPS: Double; + function GetVideoFractional: Double; + function GetVideoHeight: Cardinal; + function GetVideoLength: Int64; + function GetVideoPos: Int64; + function GetVideoScale: Double; + function GetVideoWidth: Cardinal; + function GetVLC: TVLCLibrary; + procedure SetAspectRatio(AValue: String); + procedure SetAudioMuted(AValue: Boolean); + procedure SetFitWindow(AValue: Boolean); + procedure SetUseEVents(AValue: Boolean); + function GetAudioTrackCount : Integer; + procedure SetAudioTrack(AValue: Integer); + function GetAudioTrackDescriptions(AIndex : Integer) : String; + function GetChannel: Integer; + procedure SetChannel(AValue : Integer); + function GetAudioDelay : Int64; + procedure SetAudioDelay (AValue: Int64); + function GetPlaying : Boolean; + function GetChapter : Integer; + procedure SetChapter(AValue : Integer); + function GetChapterCount: Integer; + Function GetPlayable : Boolean; + Function GetPausable : Boolean; + Function GetSeekable : Boolean; + function GetAudioVolume : Integer; + function GetPlayRate: Integer; + procedure SetAudioVolume(AValue : Integer); + procedure SetPlayRate(AValue: Integer); + procedure SetFullScreenMode(AValue: Boolean); + function GetFullScreenMode: Boolean; + procedure SetVideoFractional(AValue: Double); + procedure SetVideoPos(AValue: Int64); + procedure SetVideoScale(AValue: Double); + Protected + function GetInstance: Plibvlc_media_player_t; virtual; + // Called to set parent window. Descendents must override this. + Procedure SetParentWindow; virtual; + // Called when FitWindow is true. + Procedure SetParentWindowSize(AWidth,AHeight : Cardinal); Virtual; + procedure DoMediaChanged; virtual; + procedure DoNothingSpecial; virtual; + procedure DoOnBackward; virtual; + procedure DoOnBuffering;virtual; + procedure DoOnEOF;virtual; + procedure DoOnError;virtual; + procedure DoOnForward;virtual; + procedure DoOnOpening;virtual; + procedure DoOnPause;virtual; + procedure DoOnPlaying;virtual; + procedure DoOnStop;virtual; + procedure DoOnLengthChanged(const ATime: libvlc_time_t); virtual; + procedure DoOnPausableChanged(const APausable: Boolean); virtual; + procedure DoOnPositionChanged(const Aposition: Double); virtual; + procedure DoOnSeekableChanged(const ASeekable: Boolean); virtual; + procedure DoOnTimeChanged(const ATime: libvlc_time_t); virtual; + procedure DoOnTitleChanged(const ATitle: cint); virtual; + procedure DoOnSnapshot(const AFileName: PCChar); virtual; + procedure HookupEvents; virtual; + procedure UnHookEvents; virtual; + procedure HandleVLCEvent(e: Plibvlc_event_t); virtual; + Property VLC : TVLCLibrary Read GetVLC Write FVLC; + Property Instance : Plibvlc_media_player_t Read GetInstance; + Property HaveInstance : Boolean Read GetHaveInstance; + Public + Destructor Destroy; override; + procedure Play; + procedure SetMedia(M: TVLCMediaItem); + Procedure Play(M : TVLCMediaItem); + Procedure PlayFile(Const AFileName : String); + Procedure Stop; + procedure Pause; + procedure Resume; + procedure NextFrame; + function Snapshot(Const AFileName: String): Boolean; + function Snapshot(Const AFileName: String; AWidth, AHeight: Cardinal): Boolean; + function GetVideoSize(Var AWidth, AHeight: Cardinal): Boolean; + // These can be made public/published in descendents + Protected + Property Playable : Boolean Read GetPlayable; + Property Pausable : Boolean Read GetPausable; + Property Seekable : Boolean Read GetSeekable; + Property Playing : Boolean Read GetPlaying; + Property State : libvlc_state_t Read GetState; + Property AudioTrackDescriptions [AIndex : Integer] : String Read GetAudioTrackDescriptions; + Property ChapterCount : Integer Read GetChapterCount; + Property AudioTrackCount : Integer Read GetAudioTrackCount; + Property AudioTrack : Integer Read GetAudioTrack Write SetAudioTrack; + Property AudioDelay : Int64 Read GetAudioDelay Write SetAudioDelay; + Property AudioVolume : Integer Read GetAudioVolume Write SetAudioVolume; + Property AudioMuted : Boolean Read GetAudioMuted Write SetAudioMuted; + Property FitWindow : Boolean Read FFitWindow Write SetFitWindow; + Property VideoWidth : Cardinal Read GetVideoWidth; + Property VideoHeight : Cardinal Read GetVideoHeight; + // In MS. + Property VideoLength : Int64 Read GetVideoLength; + Property VideoDuration : TDateTime Read GetVideoDuration; + // In MS + Property VideoPosition : Int64 Read GetVideoPos Write SetVideoPos; + Property VideoFractionalPosition : Double Read GetVideoFractional Write SetVideoFractional; + Property VideoFramesPerSecond : Double Read GetVideoFPS; + Property VideoScale : Double Read GetVideoScale Write SetVideoScale; + Property AspectRatio : String Read GetAspectRatio Write SetAspectRatio; + Property Channel : Integer Read GetChannel Write SetChannel; + Property Chapter : Integer Read GetChapter Write SetChapter; + Property FullScreenMode : Boolean Read GetFullScreenMode Write SetFullScreenMode; + Property UseEvents : Boolean Read FUseEvents Write SetUseEVents; + // Events from VLC player + Property OnMediaChanged : TNotifyEvent Read FOnMediaChanged Write FOnMediaChanged; + Property OnNothingSpecial : TNotifyEvent Read FOnNothingSpecial Write FOnNothingSpecial; + Property OnBackward : TNotifyEvent Read FOnBackward Write FOnBackward; + Property OnBuffering : TNotifyEvent Read FOnBuffering Write FOnBuffering; + Property OnEOF : TNotifyEvent Read FOnEOF Write FOnEOF; + Property OnError : TErrorEvent Read FOnError Write FOnError; + Property OnForward : TNotifyEvent Read FOnForward Write FOnForward; + Property OnOpening : TNotifyEvent Read FOnOpening Write FOnOpening; + Property OnPause : TNotifyEvent Read FOnPause Write FOnPause; + Property OnPlaying : TNotifyEvent Read FOnPlaying Write FOnPlaying; + Property OnStop : TNotifyEvent Read FOnStop Write FOnStop; + Property OnLengthChanged : TTimeEvent Read FOnLengthChanged Write FOnLengthChanged; + Property OnTimeChanged : TTimeEvent Read FOnTimeChanged Write FOnTimeChanged; + Property OnPausableChanged : TBooleanEvent Read FOnPausableChanged Write FOnPausableChanged; + Property OnPositionChanged : TPositionEvent Read FOnPositionChanged Write FOnPositionChanged; + Property OnSeekableChanged : TBooleanEvent Read FOnSeekableChanged Write FOnSeekableChanged; + Property OnTitleChanged : TTitleEvent Read FOnTitleChanged Write FOnTitleChanged; + Property OnSnapshot : TSnapShotEvent Read FOnSnapShot Write FOnSnapShot; + end; + + EVLC = Class(Exception); + + TVLCMediaPlayer = Class(TCustomVLCMediaPlayer) + Public + Property Playable ; + Property Pausable ; + Property Seekable ; + Property PLaying ; + Property State ; + Property AudioTrackDescriptions; + Property ChapterCount ; + Property AudioTrackCount ; + Property AudioTrack ; + Property VideoWidth ; + Property VideoHeight; + Property VideoLength; + Property VideoDuration ; + Property VideoPosition ; + Property VideoFractionalPosition ; + Property VideoFramesPerSecond; + Property VideoScale : Double; + Property AspectRatio : String; + Published + Property AudioDelay ; + Property AudioVolume ; + Property AudioMuted ; + Property Channel ; + Property Chapter ; + Property FitWindow; + Property FullScreenMode ; + Property UseEvents ; + Property OnMediaChanged ; + Property OnNothingSpecial ; + Property OnBackward ; + Property OnBuffering ; + Property OnEOF ; + Property OnError ; + Property OnForward ; + Property OnOpening ; + Property OnPause ; + Property OnPlaying ; + Property OnStop ; + Property OnLengthChanged ; + Property OnTimeChanged ; + Property OnPausableChanged ; + Property OnPositionChanged ; + Property OnSeekableChanged ; + Property OnTitleChanged ; + Property OnSnapshot ; + end; + + { TCustomVLCMediaListPlayer } + + TCustomVLCMediaListPlayer = Class(TComponent) + Private + FMediaItems: TVLCMediaItems; + FPlayer: TCustomVLCMediaPlayer; + FPlayMode: TVLCPlayMode; + FInstance : plibvlc_media_list_player_t; + FVLC: TVLCLibrary; + function GetInstance: plibvlc_media_list_player_t; + function GetPlaying : Boolean; + function GetState: libvlc_state_t; + function GetVLC: TVLCLibrary; + procedure SetMediaItems(AValue: TVLCMediaItems); + procedure SetPlayer(AValue: TCustomVLCMediaPlayer); virtual; + procedure SetPlayMode(AValue: TVLCPlayMode); + Protected + Function CreateMediaItems : TVLCMediaItems; virtual; + Property Instance : plibvlc_media_list_player_t Read GetInstance; + Property Player : TCustomVLCMediaPlayer Read FPlayer write SetPlayer; + Property PlayMode : TVLCPlayMode read FPlayMode write SetPlayMode; + Property Playing : Boolean Read GetPLaying; + Property State : libvlc_state_t Read GetState; + Property MediaItems : TVLCMediaItems Read FMediaItems Write SetMediaItems; + Property VLC : TVLCLibrary Read GetVLC Write FVLC; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + procedure Play(Item : TVLCMediaItem); + procedure Play; + procedure Pause; + procedure Stop; + procedure Next; + procedure Prev; + end; + + TVLCMediaListPlayer = Class(TCustomVLCMediaListPlayer) + Public + Property VLC : TVLCLibrary; + Published + Property Player; + Property PlayMode; + Property Playing; + Property State; + Property MediaItems; + end; + +Function VLCLibrary : TVLCLibrary; + +Var + VLCLibraryClass : TVLCLibraryClass = TVLCLibrary; + +Function VLCTimeToDateTime (T : libvlc_time_t) : TDateTime; + +implementation + +{ TVLCLibrary } +Var + LVLC : TVLCLibrary; + +Function VLCLibrary : TVLCLibrary; + +begin + If LVLC=Nil then + LVLC:=VLCLibraryClass.Create(Nil); + Result:=LVLC; +end; + +Procedure DoneVLC; + +begin + If Assigned(LVLC) then + FreeAndNil(LVLC); +end; + +Function VLCTimeToDateTime (T : libvlc_time_t) : TDateTime; + + Function MD(Var MS : libvlc_time_t; D : Integer) : Word; inline; + + begin + Result:=MS Mod D; + MS:=MS div D; + end; + +var + d,h,m,s,ms: word; + +begin + ms:=MD(T,1000); + s:=MD(T,60); + m:=MD(T,60); + h:=MD(T,24); + d:=T; + Result:=D+EncodeTime(h,m,s,ms); +end; + +procedure PlayerEventHelper(event: Plibvlc_event_t; data: Pointer); cdecl; + +begin + if Not Assigned(data) then + exit; + TCustomVLCMediaPlayer(data).HandleVLCEvent(event); +end; + +{ TCustomVLCMediaListPlayer } + +function TCustomVLCMediaListPlayer.GetPlaying: Boolean; +begin + Result:=libvlc_media_list_player_is_playing(Instance)<>0; +end; + +function TCustomVLCMediaListPlayer.GetInstance: plibvlc_media_list_player_t; +begin + if (FInstance=Nil) then + begin + Finstance:=libvlc_media_list_player_new(VLC.Instance); + if Assigned(MediaItems) then + begin + libvlc_media_list_player_set_media_list(FInstance,MediaItems.Instance); + end; + If Assigned(FPlayer) then + begin + libvlc_media_list_player_set_media_player(FInstance, FPlayer.Instance); + end; + end; + Result:=FInstance; +end; + +function TCustomVLCMediaListPlayer.GetState: libvlc_state_t; +begin + Result:=libvlc_media_list_player_get_state(Instance) +end; + +function TCustomVLCMediaListPlayer.GetVLC: TVLCLibrary; +begin + Result:=FVLC; + If Result=Nil then + Result:=VLCLibrary; +end; + +procedure TCustomVLCMediaListPlayer.Play(Item: TVLCMediaItem); +begin + libvlc_media_list_player_play_item(Instance, item.Instance); +end; + +procedure TCustomVLCMediaListPlayer.SetMediaItems(AValue: TVLCMediaItems); +begin + if FMediaItems=AValue then Exit; + FMediaItems.Assign(AValue); +end; + +procedure TCustomVLCMediaListPlayer.SetPlayer(AValue: TCustomVLCMediaPlayer); +begin + if FPlayer=AValue then Exit; + FPlayer:=AValue; + If Assigned(FInstance) then + begin + libvlc_media_list_player_set_media_player(FInstance, FPlayer.Instance); + end; +end; + +procedure TCustomVLCMediaListPlayer.SetPlayMode(AValue: TVLCPlayMode); +Const + M : Array [TVLCPlayMode] of libvlc_playback_mode_t + = (libvlc_playback_mode_default, + libvlc_playback_mode_loop, + libvlc_playback_mode_repeat); + +begin + if FPlayMode=AValue then Exit; + FPlayMode:=AValue; + libvlc_media_list_player_set_playback_mode(FInstance, M[AValue]); +end; + +function TCustomVLCMediaListPlayer.CreateMediaItems: TVLCMediaItems; +begin + Result:=TVLCMediaItems.Create(TVLCMediaItem); +end; + +constructor TCustomVLCMediaListPlayer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FMediaItems:=CreateMediaItems; +end; + +destructor TCustomVLCMediaListPlayer.Destroy; +begin + If Assigned(Finstance) then + libvlc_media_list_player_release(FInstance); + FreeAndNil(FMediaItems); + inherited Destroy; +end; + +procedure TCustomVLCMediaListPlayer.Play; +begin + libvlc_media_list_player_play(Instance); +end; + +procedure TCustomVLCMediaListPlayer.Pause; +begin + libvlc_media_list_player_pause(Instance); +end; + +procedure TCustomVLCMediaListPlayer.Stop; +begin + libvlc_media_list_player_stop(Instance); +end; + +procedure TCustomVLCMediaListPlayer.Next; +begin + libvlc_media_list_player_next(Instance); +end; + +procedure TCustomVLCMediaListPlayer.Prev; +begin + libvlc_media_list_player_previous(Instance); +end; + + +{ TCustomVLCMediaPlayer } + +function TCustomVLCMediaPlayer.GetVLC: TVLCLibrary; +begin + Result:=FVLC; + if Result=Nil then + Result:=VLCLibrary; +end; + +procedure TCustomVLCMediaPlayer.SetAspectRatio(AValue: String); + +begin + libvlc_video_set_aspect_ratio(Instance,Pcchar(PChar(AValue))); +end; + +function TCustomVLCMediaPlayer.GetAudioMuted: Boolean; +begin + if Assigned(Finstance) then + Result:=libvlc_audio_get_mute(instance)<>0 + else + Result:=False; +end; + +function TCustomVLCMediaPlayer.GetAspectRatio: String; + +Var + P : Pcchar; + +begin + P:=libvlc_video_get_aspect_ratio(Instance); + if (P<>Nil) then + Result:=StrPas(PChar(P)) + else + Result:=''; +end; + +function TCustomVLCMediaPlayer.GetAudioTrack: Integer; +begin + if Assigned(FInstance) then + Result := libvlc_audio_get_track(FINstance) + else + Result:=-1; +end; + +function TCustomVLCMediaPlayer.GetHaveInstance: Boolean; +begin + Result:=(FInstance<>Nil); +end; + +function TCustomVLCMediaPlayer.GetState: libvlc_state_t; +begin + If Assigned(FInstance) then + Result:=libvlc_media_player_get_state(FInstance) + else + Result:=libvlc_NothingSpecial; +end; + +function TCustomVLCMediaPlayer.GetVideoDuration: TDateTime; +begin + Result:=VLCTimeToDateTime(GetVideoLength); +end; + +function TCustomVLCMediaPlayer.GetVideoFPS: Double; +begin + Result:=libvlc_media_player_get_fps(FInstance); +end; + +function TCustomVLCMediaPlayer.GetVideoFractional: Double; +begin + Result:=libvlc_media_player_get_Position(FInstance); +end; + +function TCustomVLCMediaPlayer.GetVideoHeight: Cardinal; +begin + Result:=libvlc_video_get_height(FInstance); +end; + +function TCustomVLCMediaPlayer.GetVideoLength: Int64; +begin + Result:=libvlc_media_player_get_length(Finstance); +end; + +function TCustomVLCMediaPlayer.GetVideoPos: Int64; +begin + Result:=libvlc_media_player_get_time(FInstance); +end; + +function TCustomVLCMediaPlayer.GetVideoScale: Double; +begin + Result:=libvlc_video_get_scale(Finstance); +end; + +function TCustomVLCMediaPlayer.GetVideoWidth: Cardinal; +begin + Result:=libvlc_video_get_width(FInstance); +end; + + +procedure TCustomVLCMediaPlayer.SetAudioMuted(AValue: Boolean); +begin + libvlc_audio_set_mute(instance, ord(AValue)); +end; + +procedure TCustomVLCMediaPlayer.SetFitWindow(AValue: Boolean); + +Var + W,H : Cardinal; + +begin + if FFitWindow=AValue then Exit; + FFitWindow:=AValue; + If FFitWindow and Playing then + begin + if GetVideoSize(W,H) then + SetParentWindowSize(W,H); + end; +end; + +procedure TCustomVLCMediaPlayer.SetUseEVents(AValue: Boolean); +begin + if FUseEvents=AValue then Exit; + FUseEvents:=AValue; + If Assigned(Finstance) then + If AValue then + HookupEvents + else + UnhookEvents; +end; + +function TCustomVLCMediaPlayer.GetAudioTrackCount: Integer; +begin + if Assigned(FInstance) then + Result := libvlc_audio_get_track_count(FINstance) + else + Result:=-1; +end; + + +procedure TCustomVLCMediaPlayer.SetAudioTrack(AValue: Integer); +begin + if Assigned(FInstance) then + begin + if (AValue<0) then + AValue:=0; + libvlc_audio_set_track(FInstance,AValue); + end; +end; + +function TCustomVLCMediaPlayer.GetAudioTrackDescriptions(AIndex: Integer): String; + +var + t : plibvlc_track_description_t; + +begin + Result := ''; + If (AIndex>=0) And Assigned(FInstance) then + begin + T:=libvlc_audio_get_track_description(Finstance); + while (AIndex>0) and Assigned(t) do + begin + Dec(Aindex); + t:=t^.p_next; + end; + If Assigned(t) and Assigned(t^.psz_name) then + Result:=StrPas(PChar(t^.psz_name)); + end; +end; + +function TCustomVLCMediaPlayer.GetChannel: Integer; +begin + If Assigned(Finstance) then + Result:=libvlc_audio_get_channel(FInstance) + else + Result:=-1; +end; + +procedure TCustomVLCMediaPlayer.SetChannel(AValue: Integer); +begin + If Assigned(Finstance) then + libvlc_audio_set_channel(Finstance,AValue) +end; + +function TCustomVLCMediaPlayer.GetAudioDelay: Int64; +begin + if Assigned(FInstance) then + Result:=libvlc_audio_get_delay(FInstance) + else + Result:=-1; +end; + +procedure TCustomVLCMediaPlayer.SetAudioDelay(AValue: Int64); +begin + if Assigned(FInstance) then + libvlc_audio_set_delay(FInstance,AValue) +end; + +function TCustomVLCMediaPlayer.GetPlaying: Boolean; +begin + Result:=(State=libvlc_Playing); +end; + +function TCustomVLCMediaPlayer.GetChapter: Integer; +begin + if Assigned(FInstance) then + Result:=libvlc_media_player_get_chapter(FInstance) + else + Result:=-1; +end; + +procedure TCustomVLCMediaPlayer.SetChapter(AValue: Integer); +begin + if Assigned(FInstance) then + libvlc_media_player_set_chapter(FInstance,AValue); +end; + +function TCustomVLCMediaPlayer.GetChapterCount: Integer; +begin + if Assigned(FInstance) then + Result:=libvlc_media_player_get_chapter_count(FInstance) + else + Result:=-1; +end; + +function TCustomVLCMediaPlayer.GetPlayable: Boolean; +begin + if Assigned(FInstance) then + Result:=(libvlc_media_player_will_play(FInstance)<>0) + else + Result:=False +end; + +function TCustomVLCMediaPlayer.GetPausable: Boolean; +begin + if Assigned(FInstance) then + Result:=(libvlc_media_player_can_pause(FInstance)<>0) + else + Result:=False +end; + +function TCustomVLCMediaPlayer.GetSeekable: Boolean; +begin + if Assigned(FInstance) then + Result:=(libvlc_media_player_is_seekable(FInstance)<>0) + else + Result:=False +end; + +function TCustomVLCMediaPlayer.GetAudioVolume: Integer; +begin + if Assigned(FInstance) then + Result:=libvlc_audio_get_volume(FInstance) + else + Result:=-1 +end; + +procedure TCustomVLCMediaPlayer.SetAudioVolume(AValue: Integer); +begin + if Assigned(FInstance) then + begin + if (AValue<0) then + AValue:=0 + else if (AValue>200) then + AValue:=200; + libvlc_audio_set_volume(Finstance,AValue); + end; +end; + +procedure TCustomVLCMediaPlayer.SetPlayRate(Avalue : Integer); +begin + if Assigned(FInstance) then + begin + if (Avalue< 1) then + AValue:=1 + else if (AValue>1000) then + AValue:=1000; + libvlc_media_player_set_rate(FInstance,AValue/100); + end; +end; + +function TCustomVLCMediaPlayer.GetPlayRate: Integer; +begin + if Assigned(FInstance) then + Result:=Round(libvlc_media_player_get_rate(FInstance)*100) + else + Result:=-1; +end; + +procedure TCustomVLCMediaPlayer.SetFullScreenMode(AValue: Boolean); +begin + if Assigned(FInstance) then + libvlc_set_fullscreen(Finstance,Ord(AValue)); +end; + +function TCustomVLCMediaPlayer.GetFullScreenMode: Boolean; +begin + If Assigned(FInstance) then + Result:=libvlc_get_fullscreen(Finstance)<>0 + else + Result:=False; +end; + +procedure TCustomVLCMediaPlayer.SetVideoFractional(AValue: Double); +begin + libvlc_media_player_set_position(FInstance,AValue); +end; + +procedure TCustomVLCMediaPlayer.SetVideoPos(AValue: Int64); +begin + libvlc_media_player_set_time(FInstance,AVAlue); +end; + +procedure TCustomVLCMediaPlayer.SetVideoScale(AValue: Double); +begin + libvlc_video_set_scale(Finstance,AVAlue); +end; + +function TCustomVLCMediaPlayer.GetInstance: Plibvlc_media_player_t; +begin + Result:=FInstance; + if (FInstance=Nil) then + begin + FInstance:=libvlc_media_player_new(VLC.Instance); + libvlc_video_set_mouse_input(FInstance,1); + libvlc_video_set_key_input(FInstance,1); + if FUseEvents then + HookupEvents; + end; + Result:=FInstance; +end; + +procedure TCustomVLCMediaPlayer.SetParentWindow; +begin + // Do nothing +end; + +procedure TCustomVLCMediaPlayer.SetParentWindowSize(AWidth, AHeight: Cardinal); +begin + // Do nothing +end; + +Procedure TCustomVLCMediaPlayer.UnHookEvents; + + + Procedure ClearEvent(M : plibvlc_event_manager_t;t : libvlc_event_e); + + begin + libvlc_event_detach(M,ord(t),@PlayerEventHelper,Self); + end; + +Var + M : plibvlc_event_manager_t; + +begin + M:=libvlc_media_player_event_manager(Instance); + if (M<>Nil) then + begin + ClearEvent(M,libvlc_MediaPlayerMediaChanged); + ClearEvent(M,libvlc_MediaPlayerNothingSpecial); + ClearEvent(M,libvlc_MediaPlayerOpening); + ClearEvent(M,libvlc_MediaPlayerBuffering); + ClearEvent(M,libvlc_MediaPlayerPlaying); + ClearEvent(M,libvlc_MediaPlayerPaused); + ClearEvent(M,libvlc_MediaPlayerStopped); + ClearEvent(M,libvlc_MediaPlayerForward); + ClearEvent(M,libvlc_MediaPlayerBackward); + ClearEvent(M,libvlc_MediaPlayerEndReached); + ClearEvent(M,libvlc_MediaPlayerEncounteredError); + ClearEvent(M,libvlc_MediaPlayerTimeChanged); + ClearEvent(M,libvlc_MediaPlayerPositionChanged); + ClearEvent(M,libvlc_MediaPlayerSeekableChanged); + ClearEvent(M,libvlc_MediaPlayerPausableChanged); + ClearEvent(M,libvlc_MediaPlayerTitleChanged); + ClearEvent(M,libvlc_MediaPlayerSnapshotTaken); + ClearEvent(M,libvlc_MediaPlayerLengthChanged); + FreeAndNil(FECS); + end; +end; + +Procedure TCustomVLCMediaPlayer.HookupEvents; + + Procedure AttachEvent( M : plibvlc_event_manager_t;t : libvlc_event_e); + + begin + libvlc_event_attach(M,ord(t),@PlayerEventHelper,Self); + end; + +Var + M : plibvlc_event_manager_t; + +begin + M:=libvlc_media_player_event_manager(Instance); + if (M<>Nil) then + begin + FECS:=TCriticalSection.Create; + AttachEvent(M,libvlc_MediaPlayerMediaChanged); + AttachEvent(M,libvlc_MediaPlayerNothingSpecial); + AttachEvent(M,libvlc_MediaPlayerOpening); + AttachEvent(M,libvlc_MediaPlayerBuffering); + AttachEvent(M,libvlc_MediaPlayerPlaying); + AttachEvent(M,libvlc_MediaPlayerPaused); + AttachEvent(M,libvlc_MediaPlayerStopped); + AttachEvent(M,libvlc_MediaPlayerForward); + AttachEvent(M,libvlc_MediaPlayerBackward); + AttachEvent(M,libvlc_MediaPlayerEndReached); + AttachEvent(M,libvlc_MediaPlayerEncounteredError); + AttachEvent(M,libvlc_MediaPlayerTimeChanged); + AttachEvent(M,libvlc_MediaPlayerPositionChanged); + AttachEvent(M,libvlc_MediaPlayerSeekableChanged); + AttachEvent(M,libvlc_MediaPlayerPausableChanged); + AttachEvent(M,libvlc_MediaPlayerTitleChanged); + AttachEvent(M,libvlc_MediaPlayerSnapshotTaken); + AttachEvent(M,libvlc_MediaPlayerLengthChanged); + end; +end; + +procedure TCustomVLCMediaPlayer.DoMediaChanged; + +begin + If Assigned(FOnMediaChanged) then + FOnMediaChanged(Self); +end; + +procedure TCustomVLCMediaPlayer.DoNothingSpecial; + +begin + If Assigned(FOnNothingSpecial) then + FOnNothingSpecial(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnOpening; + +begin + If Assigned(FOnOpening) then + FOnOpening(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnPlaying; + +begin + If Assigned(FOnPlaying) then + FOnPlaying(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnPause; + +begin + If Assigned(FOnPause) then + FOnPause(Self); +end; + + +procedure TCustomVLCMediaPlayer.DoOnStop; + +begin + If Assigned(FOnStop) then + FOnStop(Self); +end; + + +procedure TCustomVLCMediaPlayer.DoOnForward; + +begin + If Assigned(FOnForward) then + FOnForward(Self); +end; + + +procedure TCustomVLCMediaPlayer.DoOnBackward; + +begin + If Assigned(FOnBackward) then + FOnBackward(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnEOF; + +begin + If Assigned(FOnEOF) then + FOnEOF(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnBuffering; + +begin + If Assigned(FOnBuffering) then + FOnBuffering(Self); +end; + +procedure TCustomVLCMediaPlayer.DoOnError; + +Var + P : pcchar; + E : String; +begin + p:=libvlc_errmsg(); + if p<>Nil then + E:=StrPas(PChar(P)) + else + E:=''; + If Assigned(FOnError) then + FOnError(Self,E); +end; + +procedure TCustomVLCMediaPlayer.DoOnTimeChanged(Const ATime: libvlc_time_t); + +begin + If Assigned(FOnTimeChanged) then + FOnTimeChanged(Self,VLCTimeToDateTime(ATime)); +end; + +procedure TCustomVLCMediaPlayer.DoOnPositionChanged(Const Aposition: Double); + +begin + If Assigned(FOnPositionChanged) then + FOnPositionChanged(Self,APosition); +end; + + +procedure TCustomVLCMediaPlayer.DoOnSeekableChanged(Const ASeekable : Boolean); + +begin + If Assigned(FOnSeekableChanged) then + FOnSeekableChanged(Self,ASeekable); +end; + +procedure TCustomVLCMediaPlayer.DoOnPausableChanged(Const APausable : Boolean); + +begin + If Assigned(FOnPausableChanged) then + FOnPausableChanged(Self,APausable); +end; + +procedure TCustomVLCMediaPlayer.DoOnTitleChanged(Const ATitle: cint); + +begin + If Assigned(FOnTitleChanged) then + FOnTitleChanged(Self,ATitle); +end; + +procedure TCustomVLCMediaPlayer.DoOnSnapshot(Const AFileName : PCChar); + +Var + S :String; + +begin + If Assigned(FOnSnapshot) then + begin + if Assigned(AFileName) then + S:=StrPas(PChar(AFileName)) + else + S:=''; + FOnSnapShot(Self,S); + end; +end; + +procedure TCustomVLCMediaPlayer.DoOnLengthChanged(Const ATime: libvlc_time_t); + +begin + If Assigned(FOnLengtHChanged) then + FOnLengtHChanged(Self,VLCTimeToDateTime(ATime)); +end; + + + +procedure TCustomVLCMediaPlayer.HandleVLCEvent(e: Plibvlc_event_t); + +begin + FECS.Enter; + try + case libvlc_event_e(e^._type) of + libvlc_MediaPlayerMediaChanged : DoMediaChanged; + libvlc_MediaPlayerNothingSpecial : DoNothingSpecial; + libvlc_MediaPlayerOpening : DoOnOpening; + libvlc_MediaPlayerBuffering : DoOnBuffering; + libvlc_MediaPlayerPlaying : DoOnPlaying; + libvlc_MediaPlayerPaused : DoOnPause; + libvlc_MediaPlayerStopped : DoOnStop; + libvlc_MediaPlayerForward : DoOnForward; + libvlc_MediaPlayerBackward : DoOnBackward; + libvlc_MediaPlayerEndReached : DoOnEOF; + libvlc_MediaPlayerEncounteredError : DoOnError; + libvlc_MediaPlayerTimeChanged : begin + DoOnTimeChanged(e^.media_player_time_changed.new_time); + end; + libvlc_MediaPlayerPositionChanged : begin + DoOnPositionChanged(e^.media_player_position_changed.new_position); + end; + libvlc_MediaPlayerSeekableChanged : begin + DoOnSeekableChanged(e^.media_player_seekable_changed.new_seekable<>0); + end; + libvlc_MediaPlayerPausableChanged : begin + DoOnPausableChanged(e^.media_player_pausable_changed.new_pausable<>0) ; + end; + libvlc_MediaPlayerTitleChanged : begin + DoOnTitleChanged(e^.media_player_title_changed.new_title); + end; + libvlc_MediaPlayerSnapshotTaken : begin + DoOnSnapShot(e^.media_player_snapshot_taken.psz_filename); + end; + libvlc_MediaPlayerLengthChanged : begin + DoOnLengthChanged(e^.media_player_length_changed.new_length); + end; + else + // Writeln('Unknown event type ',e^._type); + end; + finally + FECS.Leave; + end; +end; + +destructor TCustomVLCMediaPlayer.Destroy; +begin + If Assigned(FInstance) then + begin + libvlc_media_player_release(FInstance); + FInstance:=Nil; + end; + FreeAndNil(FECS); + inherited Destroy; +end; + +procedure TCustomVLCMediaPlayer.SetMedia(M: TVLCMediaItem); + +begin + libvlc_media_player_set_media(Instance,M.Instance); +end; + +procedure TCustomVLCMediaPlayer.Play; + +Var + W,H : Cardinal; + +begin + SetParentWindow; + libvlc_media_player_play(Instance); + If FitWindow then + begin + VideoScale:=1.0; + if GetVideoSize(W,H) then + SetParentWindowSize(W,H); + end; +end; + +procedure TCustomVLCMediaPlayer.Play(M: TVLCMediaItem); + +begin + if Playing then + begin + Stop; + While Playing do + Sleep(100); + end; + SetMedia(M); + Play; +end; + +procedure TCustomVLCMediaPlayer.PlayFile(const AFileName: String); + +Var + M : TVLCMediaItem; +begin + M:=TVLCMediaItem.Create(Nil); + try + M.Path:=AFileName; + Play(M); + finally + M.Free; + end; +end; + +procedure TCustomVLCMediaPlayer.Stop; +begin + if Assigned(FInstance) then + libvlc_media_player_stop(FInstance); +end; + +procedure TCustomVLCMediaPlayer.Pause; +begin + if Assigned(FInstance) then + libvlc_media_player_pause(FInstance); +end; + +procedure TCustomVLCMediaPlayer.Resume; +begin + if (GetState()=libvlc_Paused) then + if Assigned(FInstance) then + libvlc_media_player_play(FInstance); +end; + +procedure TCustomVLCMediaPlayer.NextFrame; +begin + if Assigned(FInstance) then + libvlc_media_player_next_frame(Finstance); +end; + +function TCustomVLCMediaPlayer.Snapshot(const AFileName: String): Boolean; + +var + w,h : Cardinal; +begin + Result:=Assigned(FInstance); + if Result then + begin + w:=0; + h:=0; + Result:=libvlc_video_get_size(FInstance,0,@W,@H)=0; + if Result then + Result:=SnapShot(AFileName,W,H); + end; +end; + +function TCustomVLCMediaPlayer.Snapshot(const AFileName: String; AWidth, + AHeight: Cardinal): Boolean; +begin + Result:=Assigned(FInstance); + If Result then + Result:=libvlc_video_take_snapshot(FInstance,0,PCChar(PChar(AFileName)),AWidth,AHeight)=0; +end; + +function TCustomVLCMediaPlayer.GetVideoSize(var AWidth, AHeight: Cardinal + ): Boolean; +begin + Result:=libvlc_video_get_size(FInstance,0,@AWidth,@AHeight)=0; +end; + +{ TVLCMediaItems } + +constructor TVLCMediaItems.Create(ALibrary: TVLCLibrary;AItemClass: TVLCMediaItemClass = Nil); +begin + Inherited Create(AItemClass); + FVLC:=ALibrary; +end; + +constructor TVLCMediaItems.Create(AInstance: Plibvlc_media_list_t; + AItemClass: TVLCMediaItemClass); + + +Var + I : Integer; + P : plibvlc_media_t; + +begin + Inherited Create(AItemClass); + FInstance:=AInstance; + For I:=0 to libvlc_media_list_count(FInstance)-1 do + begin + P:=libvlc_media_list_item_at_index(FInstance,I); + (Add as TVLCMediaItem).SetInstance(P); + end; +end; + +procedure TVLCMediaItems.Lock; +begin + libvlc_media_list_lock(FInstance); +end; + +procedure TVLCMediaItems.Unlock; +begin + libvlc_media_list_lock(FInstance); +end; + +function TVLCMediaItems.GetInstance: Plibvlc_media_list_t; +Var + I :integer; +begin + if FInstance=Nil then + begin + FInstance:=libvlc_media_list_new(VLC.Instance); + For I:=0 to Count-1 do + GetI(I).RegisterInstance; + end; + Result:=Finstance; +end; + +function TVLCMediaItems.GetIsReadOnly: Boolean; +begin + Result:=libvlc_media_list_is_readonly(FInstance)<>0; +end; + +function TVLCMediaItems.GetI(AIndex : Integer): TVLCMediaItem; +begin + Result:=Items[AIndex] as TVLCMediaItem; +end; + +procedure TVLCMediaItems.SetI(AIndex : Integer; AValue: TVLCMediaItem); +begin + Items[AIndex]:=AValue; +end; + + +function TVLCMediaItems.GetVLC: TVLCLibrary; +begin + Result:=VLCLibrary; +end; + +{ TVLCMediaItem } + +function TVLCMediaItem.GetInstance: plibvlc_media_t; +begin + Result:=Finstance; + If (Result=Nil) then + Raise EVLC.Create('No instance available at this time. Set MRL, Path or FileDescriptor first'); +end; + +function TVLCMediaItem.GetM(AIndex: Integer): Boolean; +begin + Result:=FOpts[AIndex]; +end; + +function TVLCMediaItem.GetMD(AMeta : libvlc_meta_t): String; + +Var + P : PCChar; + +begin + P:=libvlc_media_get_meta(Instance,AMeta); + if (P<>Nil) then + Result:=StrPas(PChar(p)) + else + Result:=''; +end; + +function TVLCMediaItem.GetMRL: String; +Var + P : PCChar; + +begin + P:=libvlc_media_get_mrl(Instance); + if (P<>Nil) then + Result:=StrPas(PChar(p)) + else + Result:=''; +end; + +function TVLCMediaItem.GetParsed: Boolean; +begin + Result:=libvlc_media_is_parsed(Instance)<>0; +end; + +function TVLCMediaItem.GetUD: Pointer; +begin + Result:=libvlc_media_get_user_data(Instance); +end; + +procedure TVLCMediaItem.SetDIM(AValue: TDeinterlaceMode); + +Const + DMS : Array[TDeinterlaceMode] of string + = ('blend', 'discard', 'bob', 'linear', 'mean', 'x', 'yadif', 'yadif2x'); +begin + if (FDIM=AValue) then Exit; + FDIM:=AValue; + libvlc_media_add_option(Instance, PCChar(PChar('deinterlace-mode='+DMS[AValue]))); +end; + +procedure TVLCMediaItem.SetFD(AValue: Integer); +begin + FFD:=AValue; + Finstance:=libvlc_media_new_fd(GetVLC.Instance,AValue); + If (FInstance=Nil) then + Raise EVLC.CreateFmt('Failed to create media item from file descriptor "%d"',[AValue]); + RegisterInstance; +end; + +procedure TVLCMediaItem.SetFSS(AValue: TSNapshotFormat); + +Const + ssfs : Array[TSnapShotFormat] of string = ('png','jpg'); + +begin + if FSS=AValue then Exit; + FSS:=AValue; + libvlc_media_add_option(Instance, PCChar(PChar('no-snapshot-preview'))); + libvlc_media_add_option(instance, PCChar(PChar('snapshot-format=' + SSFS[aValue]))); +end; + +procedure TVLCMediaItem.SetM(AIndex: Integer; AValue: Boolean); + +begin + FOpts[AIndex]:=AValue; + libvlc_media_add_option(FInstance,PcChar(PChar(GetBoolOpt(AIndex,AValue)))); +end; + +function TVLCMediaItem.GetBoolOpt(AIndex: Integer; AValue: Boolean): String; +begin + Case AINdex of + 0 : Result:='video-title-show'; + 1 : Result:='video-on-top'; + 2 : Result:='overlay'; + 3 : Result:='fullscreen'; + 4 : Result:='deinterlace='+IntToStr(Ord(AValue)); + end; + if (AIndex < 4) and Not AValue then + Result:='no-'+Result; +end; + +procedure TVLCMediaItem.SetMD(AMeta : libvlc_meta_t; AValue: String); +begin + libvlc_media_set_meta(Instance,AMeta,Pcchar(PChar(AValue))); +end; + +procedure TVLCMediaItem.SetMRL(AValue: String); +begin + Finstance:=libvlc_media_new_location(GetVLC.Instance,PCChar(AValue)); + If (FInstance=Nil) then + Raise EVLC.CreateFmt('Failed to create media item from MRL : "%s"',[AValue]); + RegisterInstance; +end; + +procedure TVLCMediaItem.SetPath(AValue: String); +begin + if FPath=AValue then Exit; + FPath:=AValue; + FInstance:=libvlc_media_new_path(GetVLC.Instance,PCChar(AValue)); + if (FInstance=Nil) then + Raise EVLC.CreateFmt('Failed to create media item from path : "%s"',[AValue]); + RegisterInstance; +end; + +procedure TVLCMediaItem.SetUD(AValue: Pointer); +begin + libvlc_media_set_user_data(Instance,AValue); +end; + +function TVLCMediaItem.GetState: libvlc_state_t; +begin + Result:=libvlc_media_get_state(instance); +end; + +function TVLCMediaItem.GetDuration: TDateTime; + +Var + d : libvlc_time_t; + +begin + d:=libvlc_media_get_duration(Instance); + Result:=D +end; + +procedure TVLCMediaItem.RegisterInstance; + +Var + L : Plibvlc_media_list_t; + +begin + If Assigned(Collection) and (Collection is TVLCMediaItems) then + begin + L:=TVLCMediaItems(Collection).FInstance; + if (L<>Nil) then + begin + libvlc_media_list_lock(L); + libvlc_media_list_add_media(L, FInstance); + libvlc_media_list_unlock(L); + end; + end; +end; + +procedure TVLCMediaItem.UnRegisterInstance; +Var + L : Plibvlc_media_list_t; + i : integer; + +begin + If Assigned(Collection) and (Collection is TVLCMediaItems) then + begin + L:=TVLCMediaItems(Collection).FInstance; + if L<>Nil then + begin + libvlc_media_list_lock(L); + I:=libvlc_media_list_index_of_item(L,Finstance); + if (i>=0) then + libvlc_media_list_remove_index(L,i); + libvlc_media_list_unlock(L); + end; + end; +end; + +function TVLCMediaItem.GetVLC: TVLCLibrary; +begin + If Assigned(Collection) and (Collection is TVLCMediaItems) then + Result:=TVLCMediaItems(Collection).GetVLC + else + Result:=VLCLibrary; + if not Result.Initialized then + Result.Initialize; +end; + +function TVLCMediaItem.GetEventManager: plibvlc_event_manager_t; +begin + Result:=libvlc_media_event_manager(Instance); +end; + +procedure TVLCMediaItem.SetInstance(Avalue: plibvlc_media_t); +begin + FInstance:=AValue; +end; + +destructor TVLCMediaItem.Destroy; +begin + inherited Destroy; + if Assigned(FInstance) then + begin + UnregisterInstance; + libvlc_media_release(FInstance); + FInstance:=Nil; + end; +end; + +procedure TVLCMediaItem.AddOption(const AValue: String); +begin + libvlc_media_add_option(Instance,PCChar(PChar(AValue))); +end; + +procedure TVLCMediaItem.Parse; +begin + libvlc_media_parse(Instance); +end; + +procedure TVLCMediaItem.ParseAsync; +begin + libvlc_media_parse_async(Instance); +end; + +procedure TVLCMediaItem.SaveMetaData; +begin + libvlc_media_save_meta(Instance); +end; + +function TVLCMediaItem.GetStats(var AStats: libvlc_media_stats_t): Boolean; +begin + Result:=libvlc_media_get_stats(Instance,@AStats)<>0; +end; + +function TVLCMediaItem.Duplicate: TVLCMediaItem; +begin + If Assigned(Collection) and (Collection is TVLCMediaItems) then + Result:=TVLCMediaItems(Collection).Add as TVLCMediaItem + else + Result:=TVLCMediaItem.Create(Nil); + Result.SetInstance(libvlc_media_duplicate(Instance)); +end; + + +function TVLCLibrary.GetLastError: String; + +Var + P : PCChar; + +begin + P:=libvlc_errmsg(); + if Assigned(P) then + Result := StrPas(PChar(P)) + else + Result:=''; +end; + +function TVLCLibrary.GetI: Boolean; +begin + Result:=FInstance<>Nil; +end; + +function TVLCLibrary.GetVersion: String; +Var + P : PCChar; + +begin + P:=libvlc_get_version(); + if Assigned(P) then + Result := StrPas(PChar(P)) + else + Result:=''; +end; + +function TVLCLibrary.GetCompiler: String; +Var + P : PCChar; + +begin + P:=libvlc_get_compiler(); + if Assigned(P) then + Result := StrPas(PChar(P)) + else + Result:=''; +end; + +function TVLCLibrary.GetChangeSet: String; + +Var + P : PCChar; + +begin + P:=libvlc_get_changeset(); + if Assigned(P) then + Result := StrPas(PChar(P)) + else + Result:=''; +end; + +procedure TVLCLibrary.SetLibraryPath(const AValue: String); +begin + If AValue=FLibraryPath then exit; + If Assigned(FInstance) then + Raise EVLC.Create('VLC already initialized, cannot set librarypath'); + FLibraryPath:=AVAlue; +end; + +function TVLCLibrary.GetInstance: plibvlc_instance_t; + +var + args: Array of AnsiString; + cargs : array of PAnsiChar; + argc, + I : integer; + +begin + If (FInstance=Nil) then + begin + LibraryArgs.add('--no-video-title-show'); + SetLength(cArgs,LibraryArgs.Count+2); + SetLength(Args,LibraryArgs.Count+1); + cargs[0] := PChar(FLibraryPath); + For I:=0 to LibraryArgs.Count-1 do + begin + Args[i]:=LibraryArgs[i]; + CArgs[i+1]:=PChar(Args[i]); + end; + argc:=Length(CArgs); + cargs[argc-1] := NIL; + FInstance := libvlc_new(argc-1, PPcchar(cargs)); + if (FInstance=Nil) then + Raise EVLC.Create('Could not create instance of libvlc'); + end; + Result:=FInstance; +end; + +constructor TVLCLibrary.Create(AOwner: TComponent); +begin + Inherited; + FInstance:=Nil; + FLibraryPath:=LibName; + FLibraryArgs:=TStringList.Create; +end; + +destructor TVLCLibrary.Destroy; +begin + FreeAndNil(FLibraryArgs); + Release; + inherited Destroy; +end; + +procedure TVLCLibrary.Initialize; +begin + LoadLibVLC(LibraryPath,False); + GetInstance; +end; + +procedure TVLCLibrary.Release; +begin + If (FInstance<>Nil) then + begin + libvlc_release(FInstance); + FreeLibVLC; + end; + FInstance:=Nil; +end; + +Initialization + +Finalization + DoneVLC; +end. + diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc index 212d4aea..b0593919 100644 --- a/src/VERSION_FILE.inc +++ b/src/VERSION_FILE.inc @@ -1 +1 @@ -FPGUI_VERSION = '1.0'; +FPGUI_VERSION = '1.2'; diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index f3e8f6db..96332d5d 100644 --- a/src/corelib/fpg_base.pas +++ b/src/corelib/fpg_base.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -90,6 +90,8 @@ type // For providing user feedback. No need to display backtrace information EfpGUIUserFeedbackException = class(EfpGUIException); + TfpgTextEncoding = (encUTF8, encCP437, encCP850, encCP866, encCP1250, encIBMGraph); + const @@ -119,6 +121,7 @@ const FPGM_FREEME = 19; FPGM_DROPENTER = 20; FPGM_DROPEXIT = 21; + FPGM_HSCROLL = 22; FPGM_USER = 50000; FPGM_KILLME = MaxInt; @@ -213,6 +216,13 @@ type PfpgMessageRec = ^TfpgMessageRec; + TfpgMoveEventRec = record + Sender: TObject; + x: TfpgCoord; + y: TfpgCoord; + end; + + TfpgLineStyle = (lsSolid, lsDash, lsDot, lsDashDot, lsDashDotDot); @@ -380,7 +390,7 @@ type procedure DrawPolygon(Points: PPoint; NumPts: Integer; Winding: boolean = False); virtual; procedure DrawPolygon(const Points: array of TPoint); procedure StretchDraw (x, y, w, h: TfpgCoord; ASource: TfpgImageBase); - procedure CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; var ASrcRect: TfpgRect); + procedure CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; var ASrcRect: TfpgRect); virtual; // x,y is the top/left corner of where the text output will start. procedure DrawString(x, y: TfpgCoord; const txt: string); procedure FillRectangle(x, y, w, h: TfpgCoord); overload; @@ -602,6 +612,7 @@ type TFileEntryType = (etFile, etDir); TFileListSortOrder = (soNone, soFileName, soCSFileName, soFileExt, soSize, soTime); TFileModeString = string[9]; + TfpgSearchMode = (smAny, smFiles, smDirs); // A simple data object @@ -641,6 +652,7 @@ type FEntries: TList; FDirectoryName: TfpgString; FFileMask: TfpgString; + FSearchMode: TfpgSearchMode; FShowHidden: boolean; FCurrentSpecialDir: integer; procedure AddEntry(sr: TSearchRec); @@ -663,6 +675,7 @@ type property Entry[i: integer]: TFileEntry read GetEntry; property FileMask: TfpgString read FFileMask write FFileMask; property HasFileMode: boolean read FHasFileMode; + property SearchMode: TfpgSearchMode read FSearchMode write FSearchMode; property ShowHidden: boolean read FShowHidden write FShowHidden; property SpecialDirs: TStringList read FSpecialDirs; end; @@ -765,7 +778,6 @@ function fpgLighter(const AColor: TfpgColor; APercent: Byte = 50): TfpgColor; { Points } -function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; procedure SortRect(var ARect: TRect); procedure SortRect(var ARect: TfpgRect); procedure SortRect(var left, top, right, bottom: integer); @@ -782,7 +794,7 @@ uses typinfo, process, {$IFDEF GDEBUG} - dbugintf, + fpg_dbugintf, {$ENDIF} dateutils; @@ -1090,14 +1102,6 @@ begin Result := RGBTripleTofpgColor(lColor); end; -function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; -begin - Result := (APoint.x >= ARect.Left) and - (APoint.y >= ARect.Top) and - (APoint.x <= ARect.Right) and - (APoint.y <= ARect.Bottom); -end; - procedure SortRect(var ARect: TRect); begin with ARect do @@ -1737,9 +1741,9 @@ begin RGBStop := fpgColorToRGBTriple(AStop); if ADirection = gdVertical then - count := ARect.Bottom - ARect.Top + count := ARect.Height else - count := ARect.Right - ARect.Left; + count := ARect.Width; RDiff := RGBStop.Red - RGBStart.Red; GDiff := RGBStop.Green - RGBStart.Green; @@ -2101,7 +2105,7 @@ end; procedure TfpgBaseInterpolation.Execute(x, y, w, h: integer); begin - tempimage := TfpgImageBase.Create; + tempimage := TfpgImage.Create; tempimage.AllocateImage(image.ColorDepth, w, image.Height); xfactor := image.Width / w; @@ -2242,7 +2246,7 @@ begin FMasked := False; FWidth := 0; FHeight := 0; -// DoFreeImage; + DoFreeImage; end; procedure TfpgImageBase.AllocateImage(acolordepth, awidth, aheight: integer); @@ -2549,7 +2553,11 @@ var p: TProcess; begin Result := False; - if not fpgFileExists(GetHelpViewer) then + if fpgExtractFilePath(GetHelpViewer) = '' then + begin + // do nothing - we are hoping docview is in the system PATH + end + else if not fpgFileExists(GetHelpViewer) then raise EfpGUIUserFeedbackException.Create(rsfailedtofindhelpviewer); p := TProcess.Create(nil); try @@ -2577,7 +2585,11 @@ var p: TProcess; begin Result := False; - if not fpgFileExists(GetHelpViewer) then + if fpgExtractFilePath(GetHelpViewer) = '' then + begin + // do nothing - we are hoping docview is in the system PATH + end + else if not fpgFileExists(GetHelpViewer) then raise EfpGUIUserFeedbackException.Create(rsfailedtofindhelpviewer); p := TProcess.Create(nil); try @@ -2720,7 +2732,7 @@ var e: TFileEntry; begin e := TFileEntry.Create; - e.Name := fpgFromOSEncoding(sr.Name); + e.Name := sr.Name; e.Extension := fpgExtractFileExt(e.Name); e.Size := sr.Size; // e.Attributes := sr.Attr; // this is incorrect and needs to improve! @@ -2790,6 +2802,7 @@ begin FFileMask := '*'; FDirectoryName := ''; FSpecialDirs := TStringList.Create; + FSearchMode := smAny; end; destructor TfpgFileListBase.Destroy; @@ -2836,11 +2849,13 @@ begin // Reported to FPC as bug 9440 in Mantis. if fpgFindFirst(FDirectoryName + AllFilesMask, faAnyFile or $00000080, SearchRec) = 0 then begin - AddEntry(SearchRec); - while fpgFindNext(SearchRec) = 0 do - begin - AddEntry(SearchRec); - end; + repeat + if (FSearchMode=smAny) or + ((FSearchMode=smFiles) and (not HasAttrib(SearchRec.Attr, faDirectory))) or + ((FSearchMode=smDirs) and HasAttrib(SearchRec.Attr, faDirectory)) + then + AddEntry(SearchRec); + until fpgFindNext(SearchRec) <> 0; end; Result:=True; finally @@ -3087,7 +3102,6 @@ end; function TfpgMimeDataBase.Formats: TStrings; var i: integer; - r: TfpgMimeDataItem; s: string; begin if Count = 0 then diff --git a/src/corelib/fpg_constants.pas b/src/corelib/fpg_constants.pas index 37b3f135..60bd18e7 100644 --- a/src/corelib/fpg_constants.pas +++ b/src/corelib/fpg_constants.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 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/corelib/fpg_dbugintf.pas b/src/corelib/fpg_dbugintf.pas new file mode 100644 index 00000000..8e9d9874 --- /dev/null +++ b/src/corelib/fpg_dbugintf.pas @@ -0,0 +1,337 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + Copyright (C) 2013 by Graeme Geldenhuys + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Originally from the Free Pascal FCL. Since then the code has + diverged and was customised for fpGUI usage. + + This is the Client Interface for the debug server, which is + based on SimpleIPC. +} +unit fpg_dbugintf; + +{$mode objfpc}{$h+} + +interface + +uses + Classes, + fpg_base; + +Type + TDebugLevel = (dlStop, dlInformation, dlWarning, dlError, dlIdentify, dlLive); + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +procedure SendInteger(const Identifier: string; const Value: Integer; HexNotation: Boolean = False); +procedure SendPoint(const Identifier: string; const Value: TPoint; const ADbgLevel: TDebugLevel = dlLive); +procedure SendPointer(const Identifier: string; const Value: Pointer); +procedure SendRect(const Identifier: string; const Value: TRect; const ADbgLevel: TDebugLevel = dlInformation); +procedure SendRect(const Identifier: string; const Value: TfpgRect; const ADbgLevel: TDebugLevel = dlInformation); +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); +procedure SendDebug(const Msg: string); +procedure SendMethodEnter(const MethodName: string); +procedure SendMethodExit(const MethodName: string); +procedure SendSeparator; +procedure SendDebugFmt(const Msg: string; const Args: array of const); +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel; const ATitle: string = ''); + +procedure SetDebuggingEnabled(const AValue : boolean); +function GetDebuggingEnabled : Boolean; + +{ low-level routines } + +Function StartDebugServer : integer; +Function InitDebugClient : Boolean; +Function DebugMessageName(msgType: TDebugLevel) : String; + +Const + SendError : String = ''; + +ResourceString + SProcessID = 'Process %s'; + SEntering = '> Entering '; + SExiting = '< Exiting '; + SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<'; + SServerStartFailed = 'Failed to start debugserver. (%s)'; + +implementation + +Uses + SysUtils, + process, + simpleipc, + fpg_dbugmsg; + +const + IndentChars = 2; + +var + DebugClient : TSimpleIPCClient = nil; + MsgBuffer : TMemoryStream = Nil; + ServerID : Integer; + DebugDisabled : Boolean = False; + Indent : Integer = 0; + +function RectToStr(const ARect: TRect): String; +begin + with ARect do + Result := Format('(Left: %d; Top: %d; Right: %d; Bottom: %d)', [Left, Top, Right, Bottom]); +end; + +function fpgRectToStr(const ARect: TfpgRect): String; +begin + with ARect do + Result := Format('(Left: %d; Top: %d; Width: %d; Height: %d)', [Left, Top, Width, Height]); +end; + +function PointToStr(const APoint: TPoint): String; +begin + with APoint do + Result := Format('(X: %d; Y: %d)', [X, Y]); +end; + +procedure WriteMessage(Const Msg : TDebugMessage); +begin + MsgBuffer.Seek(0, soFromBeginning); + WriteDebugMessageToStream(MsgBuffer, Msg); + DebugClient.SendMessage(mtUnknown, MsgBuffer); +end; + +procedure SendDebugMessage(Var Msg : TDebugMessage); +begin + if DebugDisabled then exit; + try + If (DebugClient=Nil) then + if InitDebugClient = false then exit; + if (Indent > 0) then + Msg.Msg := StringOfChar(' ', Indent) + Msg.Msg; + WriteMessage(Msg); + except + On E: Exception do + SendError := E.Message; + end; +end; + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +const + Booleans : Array[Boolean] of string = ('False','True'); +begin + SendDebugFmt('%s = %s',[Identifier,Booleans[value]]); +end; + +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +begin + SendDebugFmt('%s = %s',[Identifier,DateTimeToStr(Value)]); +end; + +procedure SendInteger(const Identifier: string; const Value: Integer; HexNotation: Boolean = False); +const + Msgs : Array[Boolean] of string = ('%s = %d','%s = %x'); +begin + SendDebugFmt(Msgs[HexNotation],[Identifier,Value]); +end; + +procedure SendPoint(const Identifier: string; const Value: TPoint; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s = %s',[Identifier, PointToStr(Value)], ADbgLevel); +end; + +procedure SendPointer(const Identifier: string; const Value: Pointer); +begin + SendDebugFmt('%s = %p',[Identifier,Value]); +end; + +procedure SendRect(const Identifier: string; const Value: TRect; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s',[RectToStr(Value)], ADbgLevel, Identifier); +end; + +procedure SendRect(const Identifier: string; const Value: TfpgRect; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s',[fpgRectToStr(Value)], ADbgLevel, Identifier); +end; + +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=Ord(MTYpe); + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendDebug(const Msg: string); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=Ord(dlInformation); + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendMethodEnter(const MethodName: string); +begin + SendDebug(SEntering+MethodName); + inc(Indent,IndentChars); +end; + +procedure SendMethodExit(const MethodName: string); +begin + Dec(Indent,IndentChars); + If (Indent<0) then + Indent:=0; + SendDebug(SExiting+MethodName); +end; + +procedure SendSeparator; +begin + SendDebug(SSeparator); +end; + +procedure SendDebugFmt(const Msg: string; const Args: array of const); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:= Ord(dlInformation); + Mesg.Msg:=Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel; const ATitle: string); +var + Mesg: TDebugMessage; +begin + Mesg.MsgTimeStamp := Now; + Mesg.MsgType := Ord(mType); + if MType = dlLive then + Mesg.MsgTitle := ATitle + else + Mesg.MsgTitle := ' '; + Mesg.Msg := Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +procedure SetDebuggingEnabled(const AValue: boolean); +begin + DebugDisabled := not AValue; +end; + +function GetDebuggingEnabled: Boolean; +begin + Result := not DebugDisabled; +end; + +function StartDebugServer : Integer; +begin + With TProcess.Create(Nil) do + begin + Try + CommandLine:='dbugsrv'; + Execute; + Result:=ProcessID; + Except On E: Exception do + begin + SendError := Format(SServerStartFailed,[E.Message]); + Result := 0; + end; + end; + Free; + end; +end; + +procedure FreeDebugClient; +var + msg : TDebugMessage; +begin + try + If (DebugClient<>Nil) and + (DebugClient.ServerRunning) then + begin + Msg.MsgType := Ord(dlStop); + Msg.MsgTimeStamp := Now; + Msg.Msg := Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); + end; + if assigned(MsgBuffer) then + FreeAndNil(MsgBuffer); + if assigned(DebugClient) then + FreeAndNil(DebugClient); + except + end; +end; + +function InitDebugClient : Boolean; +var + msg : TDebugMessage; + I : Integer; +begin + Result := False; + DebugClient:=TSimpleIPCClient.Create(Nil); + DebugClient.ServerID:=DebugServerID; + If not DebugClient.ServerRunning then + begin + ServerID:=StartDebugServer; + if ServerID = 0 then + begin + DebugDisabled := True; + FreeAndNil(DebugClient); + Exit; + end + else + DebugDisabled := False; + I:=0; + While (I<10) and not DebugClient.ServerRunning do + begin + Inc(I); + Sleep(100); + end; + end; + try + DebugClient.Connect; + except + FreeAndNil(DebugClient); + DebugDisabled:=True; + Raise; + end; + MsgBuffer := TMemoryStream.Create; + Msg.MsgType := Ord(dlIdentify); + Msg.MsgTimeStamp := Now; + Msg.Msg := Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); + Result := True; +end; + +Function DebugMessageName(msgType : TDebugLevel) : String; +begin + Case MsgType of + dlStop : Result := 'Stop'; + dlInformation : Result := 'Information'; + dlWarning : Result := 'Warning'; + dlError : Result := 'Error'; + dlIdentify : Result := 'Identify'; + dlLive : Result := 'LiveView'; + else + Result := 'Unknown'; + end; +end; + + +finalization + FreeDebugClient; + +end. diff --git a/src/corelib/fpg_dbugmsg.pas b/src/corelib/fpg_dbugmsg.pas new file mode 100644 index 00000000..502b697e --- /dev/null +++ b/src/corelib/fpg_dbugmsg.pas @@ -0,0 +1,95 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + Copyright (C) 2013 by Graeme Geldenhuys + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Originally from the Free Pascal FCL. Since then the code has + diverged and was customised for fpGUI usage. +} +unit fpg_dbugmsg; + +{$mode objfpc}{$h+} + +interface + +uses Classes; + +Const + DebugServerID : String = 'fpgDebugServer'; + +Type + TDebugMessage = record + MsgType : Integer; + MsgTimeStamp : TDateTime; + MsgTitle : string; + Msg : string; + end; + +Procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); +Procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); + + +implementation + + +procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); +var + MsgSize: Integer; +begin + MsgSize := 0; + with AStream do + begin + ReadBuffer(Msg.MsgType, SizeOf(Integer)); + ReadBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime)); + + ReadBuffer(MsgSize, SizeOf(Integer)); + SetLength(Msg.MsgTitle, MsgSize); + if (MsgSize<>0) then + ReadBuffer(Msg.MsgTitle[1], MsgSize); + + ReadBuffer(MsgSize, SizeOf(Integer)); + SetLength(Msg.Msg, MsgSize); + if (MsgSize<>0) then + ReadBuffer(Msg.Msg[1], MsgSize); + end; +end; + +procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); +var + MsgSize : Integer; + lTitle: string; +begin + with AStream do + begin + WriteBuffer(Msg.MsgType, SizeOf(Integer)); + WriteBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime)); + + MsgSize := Length(Msg.MsgTitle); + if MsgSize = 0 then // fake a title + begin + MsgSize := 1; + lTitle := ' '; + end + else + lTitle := Msg.MsgTitle; + WriteBuffer(MsgSize, SizeOf(Integer)); + WriteBuffer(lTitle[1], MsgSize); + + MsgSize := Length(Msg.Msg); + WriteBuffer(MsgSize, SizeOf(Integer)); + WriteBuffer(Msg.Msg[1], MsgSize); + end; +end; + + +end. diff --git a/src/corelib/fpg_imgfmt_bmp.pas b/src/corelib/fpg_imgfmt_bmp.pas index 00637f3b..fe827405 100644 --- a/src/corelib/fpg_imgfmt_bmp.pas +++ b/src/corelib/fpg_imgfmt_bmp.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 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -64,7 +64,7 @@ begin if not fpgFileExists(AFileName) then Exit; //==> - AssignFile(AFile, AFileName); + AssignFile(AFile, fpgToOSEncoding(AFileName)); FileMode := fmOpenRead; // read-only Reset(AFile); AImageDataSize := FileSize(AFile); diff --git a/src/corelib/fpg_imgfmt_jpg.pas b/src/corelib/fpg_imgfmt_jpg.pas index 33704643..4fe67692 100644 --- a/src/corelib/fpg_imgfmt_jpg.pas +++ b/src/corelib/fpg_imgfmt_jpg.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -34,10 +34,11 @@ type EJPEG = class(Exception); procedure ReadImage_JPG(img: TfpgImage; bmp: TStream; const AScale: integer = 1); -function LoadImage_JPG(const AFileName: String; const AScale: integer = 1): TfpgImage; +function LoadImage_JPG(const AFileName: TfpgString; const AScale: integer = 1): TfpgImage; implementation uses + fpg_utils, {PASJPG10 library} jmorecfg, jpeglib, @@ -360,21 +361,21 @@ begin img.UpdateImage; end; -function LoadImage_JPG(const AFileName: String; const AScale: integer): TfpgImage; +function LoadImage_JPG(const AFileName: TfpgString; const AScale: integer): TfpgImage; var inFile: TStream; begin Result := nil; - if not FileExists(AFileName) then + if not fpgFileExists(AFileName) then Exit; //==> - inFile:=TFileStream.Create(AFileName,fmOpenRead); - try - Result:=TfpgImage.Create; - ReadImage_JPG(Result, inFile, AScale); - finally - inFile.Free; - end; + inFile := TFileStream.Create(fpgToOSEncoding(AFileName), fmOpenRead); + try + Result := TfpgImage.Create; + ReadImage_JPG(Result, inFile, AScale); + finally + inFile.Free; + end; end; diff --git a/src/corelib/fpg_imgfmt_png.pas b/src/corelib/fpg_imgfmt_png.pas index c95150e4..3148a5b4 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 - 2013 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -68,6 +68,7 @@ end; function LoadImage_PNG(const AFileName: TfpgString): TfpgImage; var imga: TFPCustomImage; + PNGReader: TFPReaderPNG; begin Result := nil; if not fpgFileExists(AFileName) then @@ -75,7 +76,12 @@ begin imga := TFPMemoryImage.Create(0, 0); try - imga.LoadFromFile(AFileName, TFPReaderPNG.Create); // auto size image + PNGReader := TFPReaderPNG.Create; + try + imga.LoadFromFile(fpgToOSEncoding(AFileName), PNGReader); // auto size image + finally + PNGReader.Free; + end; except imga := nil; end; @@ -159,7 +165,7 @@ begin // Calculated to fit the image within required size: xlocal, ylocal imga := TFPMemoryImage.Create(0, 0); try - imga.LoadFromFile(AFileName, TFPReaderPNG.Create); // auto size image + imga.LoadFromFile(fpgToOSEncoding(AFileName), TFPReaderPNG.Create); // auto size image except imga := nil; imgb := nil; diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas index 44ab6a82..c7275b14 100644 --- a/src/corelib/fpg_main.pas +++ b/src/corelib/fpg_main.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 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -47,7 +47,7 @@ type TAnchors = set of TAnchor; TfpgButtonFlags = set of (btfIsEmbedded, btfIsDefault, btfIsPressed, - btfIsSelected, btfHasFocus, btfHasParentColor, btfFlat, btfHover); + btfIsSelected, btfHasFocus, btfHasParentColor, btfFlat, btfHover, btfDisabled); TfpgMenuItemFlags = set of (mifSelected, mifHasFocus, mifSeparator, mifEnabled, mifChecked, mifSubMenu); @@ -78,8 +78,7 @@ type Public event properties: Event Types *******************************************} { Keyboard } - TKeyEvent = procedure(Sender: TObject; AKey: Word; AShift: TShiftState) of object; - TKeyCharEvent = procedure(Sender: TObject; AKeyChar: Char) of object; + TfpgKeyCharEvent = procedure(Sender: TObject; AChar: TfpgChar; var Consumed: boolean) of object; TKeyPressEvent = procedure(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean) of object; { Mouse } TMouseButtonEvent = procedure(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint) of object; @@ -176,8 +175,6 @@ type // As soon as TfpgStyle has moved out of CoreLib, these must go! procedure DrawButtonFace(x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); overload; procedure DrawButtonFace(r: TfpgRect; AFlags: TfpgButtonFlags); overload; - procedure DrawControlFrame(x, y, w, h: TfpgCoord); overload; - procedure DrawControlFrame(r: TfpgRect); overload; procedure DrawBevel(x, y, w, h: TfpgCoord; ARaised: Boolean = True); overload; procedure DrawBevel(r: TfpgRect; ARaised: Boolean = True); overload; procedure DrawDirectionArrow(x, y, w, h: TfpgCoord; direction: TArrowDirection); overload; @@ -224,6 +221,12 @@ type function GetSeparatorSize: integer; virtual; { Editbox } procedure DrawEditBox(ACanvas: TfpgCanvas; const r: TfpgRect; const IsEnabled: Boolean; const IsReadOnly: Boolean; const ABackgroundColor: TfpgColor); virtual; + { Combobox } + procedure DrawStaticComboBox(ACanvas: TfpgCanvas; r: TfpgRect; const IsEnabled: Boolean; const IsFocused: Boolean; const IsReadOnly: Boolean; const ABackgroundColor: TfpgColor; const AInternalBtnRect: TfpgRect; const ABtnPressed: Boolean); virtual; + procedure DrawInternalComboBoxButton(ACanvas: TfpgCanvas; r: TfpgRect; const IsEnabled: Boolean; const IsPressed: Boolean); virtual; + { Checkbox } + function GetCheckBoxSize: integer; virtual; + procedure DrawCheckbox(ACanvas: TfpgCanvas; x, y: TfpgCoord; ix, iy: TfpgCoord); virtual; end; @@ -395,10 +398,15 @@ function fpgGetTickCount: DWord; procedure fpgPause(MilliSeconds: Cardinal); // Rectangle, Point & Size routines +function CopyRect(out Dest: TfpgRect; const Src: TfpgRect): Boolean; function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean; function InflateRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean; +function IntersectRect(out ARect: TfpgRect; const r1, r2: TfpgRect): Boolean; +function IsRectEmpty(const ARect: TfpgRect): Boolean; function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean; function OffsetRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean; +function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; +function UniongRect(out ARect: TfpgRect; const R1, R2: TfpgRect): Boolean; function CenterPoint(const Rect: TRect): TPoint; function CenterPoint(const Rect: TfpgRect): TPoint; function fpgRect(ALeft, ATop, AWidth, AHeight: integer): TfpgRect; @@ -422,11 +430,12 @@ procedure DebugLn(const s1, s2: TfpgString); procedure DebugLn(const s1, s2, s3: TfpgString); procedure DebugLn(const s1, s2, s3, s4: TfpgString); procedure DebugLn(const s1, s2, s3, s4, s5: TfpgString); -function DebugMethodEnter(const s1: TfpgString): IInterface; +function DebugMethodEnter(const s1: TfpgString): IInterface; procedure DebugSeparator; // operator overloading of some useful structures -operator = (a: TRect; b: TRect): boolean; +operator = (const a, b: TRect): boolean; +operator = (const a, b: TfpgRect): boolean; operator = (const ASize1, ASize2: TfpgSize) b: Boolean; operator = (const APoint1, APoint2: TPoint) b: Boolean; operator + (const APoint1, APoint2: TPoint) p: TPoint; @@ -446,7 +455,8 @@ operator - (const APoint: TfpgPoint; i: Integer) p: TfpgPoint; operator - (const ASize: TfpgSize; const APoint: TPoint) s: TfpgSize; operator - (const ASize: TfpgSize; const APoint: TfpgPoint) s: TfpgSize; operator - (const ASize: TfpgSize; i: Integer) s: TfpgSize; -operator = (const AColor1, AColor2: TFPColor) b: Boolean; +operator = (const AColor1, AColor2: TFPColor) b: Boolean; deprecated; +operator = (const AColor1, AColor2: TRGBTriple) b: Boolean; implementation @@ -458,7 +468,7 @@ uses Agg2D, {$endif} {$IFDEF DEBUG} - dbugintf, + fpg_dbugintf, {$ENDIF} fpg_imgfmt_bmp, fpg_stdimages, @@ -472,7 +482,9 @@ uses fpg_imgutils, fpg_stylemanager, fpg_style_win2k, // TODO: This needs to be removed! - fpg_style_motif; // TODO: This needs to be removed! + fpg_style_motif, // TODO: This needs to be removed! + fpg_style_carbon, + fpg_style_plastic; var fpgTimers: TList; @@ -621,6 +633,17 @@ begin until ((Now*MSecsPerDay)-lStart) > MilliSeconds; end; +function CopyRect(out Dest: TfpgRect; const Src: TfpgRect): Boolean; +begin + Dest := Src; + if IsRectEmpty(Dest) then + begin + FillChar(Dest, SizeOf(Dest), 0); + Result := false; + end + else + Result := true; +end; function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean; begin @@ -653,6 +676,35 @@ begin Result := False; end; +function IntersectRect(out ARect: TfpgRect; const r1, r2: TfpgRect): Boolean; +begin + ARect := r1; + with r2 do + begin + if Left > r1.Left then + ARect.Left := Left; + if Top > r1.Top then + ARect.Top := Top; + if Right < r1.Right then + ARect.Width := ARect.Left + Right; + if Bottom < r1.Bottom then + ARect.Height := ARect.Top + Bottom; + end; + + if IsRectEmpty(ARect) then + begin + FillChar(ARect, SizeOf(ARect), 0); + Result := false; + end + else + Result := true; +end; + +function IsRectEmpty(const ARect: TfpgRect): Boolean; +begin + Result := (ARect.Width <= 0) or (ARect.Height <= 0); +end; + function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean; begin if Assigned(@Rect) then @@ -664,10 +716,10 @@ begin inc(Right, dx); inc(Bottom, dy); end; - OffsetRect := True; + Result := True; end else - OffsetRect := False; + Result := False; end; function OffsetRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean; @@ -679,10 +731,42 @@ begin inc(Left, dx); inc(Top, dy); end; - OffsetRect := True; + Result := True; + end + else + Result := False; +end; + +function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; +begin + Result := (APoint.x >= ARect.Left) and + (APoint.y >= ARect.Top) and + (APoint.x <= ARect.Right) and + (APoint.y <= ARect.Bottom); +end; + +function UniongRect(out ARect: TfpgRect; const R1, R2: TfpgRect): Boolean; +begin + ARect := R1; + with R2 do + begin + if Left < R1.Left then + ARect.Left := Left; + if Top < R1.Top then + ARect.Top := Top; + if Right > R1.Right then + ARect.Width := ARect.Left + Right; + if Bottom > R1.Bottom then + ARect.Height := ARect.Top + Bottom; + end; + + if IsRectEmpty(ARect) then + begin + FillChar(ARect, SizeOf(ARect), 0); + Result := false; end else - OffsetRect := False; + Result := true; end; function CenterPoint(const Rect: TRect): TPoint; @@ -957,15 +1041,20 @@ begin DebugLn('>--------------------------<'); end; -operator = (a: TRect; b: TRect): boolean; +operator = (const a, b: TRect): boolean; begin - if (a.Top = b.Top) - and (a.Left = b.Left) - and (a.Bottom = b.Bottom) - and (a.Right = b.Right) then - Result := True - else - Result := False; + Result := (a.Top = b.Top) and + (a.Left = b.Left) and + (a.Bottom = b.Bottom) and + (a.Right = b.Right); +end; + +operator = (const a, b: TfpgRect): boolean; +begin + Result := (a.Left = b.Left) and + (a.Top = b.Top) and + (a.Width = b.Width) and + (a.Height = b.Height); end; operator = (const ASize1, ASize2: TfpgSize) b: Boolean; @@ -1088,6 +1177,14 @@ begin and (AColor1.Alpha = AColor2.Alpha); end; +operator = (const AColor1, AColor2: TRGBTriple) b: Boolean; +begin + b := (AColor1.Red = AColor2.Red) + and (AColor1.Green = AColor2.Green) + and (AColor1.Blue = AColor2.Blue) + and (AColor1.Alpha = AColor2.Alpha); +end; + { TfpgTimer } constructor TfpgTimer.Create(AInterval: integer); @@ -1791,16 +1888,6 @@ begin DrawButtonFace(r.Left, r.Top, r.Width, r.Height, AFlags); end; -procedure TfpgCanvas.DrawControlFrame(x, y, w, h: TfpgCoord); -begin - fpgStyle.DrawControlFrame(self, x, y, w, h); -end; - -procedure TfpgCanvas.DrawControlFrame(r: TfpgRect); -begin - DrawControlFrame(r.Left, r.Top, r.Width, r.Height); -end; - procedure TfpgCanvas.DrawBevel(x, y, w, h: TfpgCoord; ARaised: Boolean); begin fpgStyle.DrawBevel(self, x, y, w, h, ARaised); @@ -2008,6 +2095,7 @@ begin fpgSetNamedColor(clGridInactiveSel, $FF99A6BF); // same as clInactiveSel fpgSetNamedColor(clGridInactiveSelText, $FF000000); // same as clInactiveSelText fpgSetNamedColor(clSplitterGrabBar, $FF839EFE); // pale blue + fpgSetNamedColor(clHyperLink, clBlue); // Global Font Objects @@ -2057,17 +2145,17 @@ begin if (btfIsPressed in AFlags) then begin if (btfIsEmbedded in AFlags) then - ACanvas.SetColor(clHilite2) + ACanvas.SetColor(clShadow1) else begin if (btfFlat in AFlags) or (btfHover in AFlags) then ACanvas.SetColor(clShadow1) { light shadow } else - ACanvas.SetColor(clShadow2); { dark shadow } + ACanvas.SetColor(clShadow1); { light shadow } end; end else - ACanvas.SetColor(clHilite2); + ACanvas.SetColor(clHilite2); { white } ACanvas.DrawLine(r.Left, r.Bottom, r.Left, r.Top); // left ACanvas.DrawLine(r.Left, r.Top, r.Right, r.Top); // top @@ -2076,13 +2164,13 @@ begin if (btfIsPressed in AFlags) then begin if (btfIsEmbedded in AFlags) then - ACanvas.SetColor(clHilite1) + ACanvas.SetColor(clShadow1) else begin if (btfFlat in AFlags) or (btfHover in AFlags) then - ACanvas.SetColor(clHilite2) { light shadow } + ACanvas.SetColor(clHilite2) { white } else - ACanvas.SetColor(clShadow2); { dark shadow } + ACanvas.SetColor(clHilite2); { white } end; end else @@ -2099,13 +2187,24 @@ begin if (btfFlat in AFlags) or (btfHover in AFlags) then exit; { "toolbar" style buttons need a nice thin/flat border } + // Left and Top (inner) + if btfIsPressed in AFlags then + begin + if not (btfIsEmbedded in AFlags) then + begin + ACanvas.SetColor(clShadow2); { dark shadow } + ACanvas.DrawLine(r.Left+1, r.Bottom-1, r.Left+1, r.Top+1); // left + ACanvas.DrawLine(r.Left+1, r.Top+1, r.Right-1, r.Top+1); // top + end; + end; + // Right and Bottom (inner) if btfIsPressed in AFlags then begin if (btfIsEmbedded in AFlags) then ACanvas.SetColor(clButtonFace) else - ACanvas.SetColor(clHilite1); + ACanvas.SetColor(clButtonFace); end else ACanvas.SetColor(clShadow1); @@ -2368,6 +2467,83 @@ begin ACanvas.FillRectangle(r); end; +procedure TfpgStyle.DrawStaticComboBox(ACanvas: TfpgCanvas; r: TfpgRect; + const IsEnabled: Boolean; const IsFocused: Boolean; const IsReadOnly: Boolean; + const ABackgroundColor: TfpgColor; const AInternalBtnRect: TfpgRect; + const ABtnPressed: Boolean); +var + lr: TfpgRect; +begin + lr := r; + if IsEnabled then + begin + if IsReadOnly then + ACanvas.SetColor(clWindowBackground) + else + ACanvas.SetColor(ABackgroundColor); + end + else + ACanvas.SetColor(clWindowBackground); + + ACanvas.FillRectangle(r); + + if IsFocused then + begin + ACanvas.SetColor(clSelection); + InflateRect(lr, -1, -1); + ACanvas.FillRectangle(lr); + end; + + // paint the fake dropdown button + DrawInternalComboBoxButton(ACanvas, AInternalBtnRect, IsEnabled, ABtnPressed); +end; + +procedure TfpgStyle.DrawInternalComboBoxButton(ACanvas: TfpgCanvas; + r: TfpgRect; const IsEnabled: Boolean; const IsPressed: Boolean); +var + ar: TfpgRect; + btnflags: TfpgButtonFlags; +begin + btnflags := []; + ar := r; + + { The bounding rectangle for the arrow } + ar.Width := 8; + ar.Height := 6; + ar.Left := r.Left + ((r.Width-ar.Width) div 2); + ar.Top := r.Top + ((r.Height-ar.Height) div 2); + + if IsPressed then + begin + Include(btnflags, btfIsPressed); + OffsetRect(ar, 1, 1); + end; + // paint button face + DrawButtonFace(ACanvas, r.Left, r.Top, r.Width, r.Height, btnflags); + if IsEnabled then + ACanvas.SetColor(clText1) + else + ACanvas.SetColor(clShadow1); + + // paint arrow + DrawDirectionArrow(ACanvas, ar.Left, ar.Top, ar.Width, ar.Height, adDown); +end; + +function TfpgStyle.GetCheckBoxSize: integer; +begin + Result := 13; // 13x13 - it is always a rectangle +end; + +procedure TfpgStyle.DrawCheckbox(ACanvas: TfpgCanvas; x, y: TfpgCoord; ix, iy: TfpgCoord); +var + img: TfpgImage; + size: integer; +begin + img := fpgImages.GetImage('sys.checkboxes'); // Do NOT localize - return value is a reference only + size := GetCheckBoxSize; + ACanvas.DrawImagePart(x, y, img, ix, iy, size, size); +end; + { TfpgCaret } diff --git a/src/corelib/fpg_stringutils.pas b/src/corelib/fpg_stringutils.pas index 1acd518e..7930870b 100644 --- a/src/corelib/fpg_stringutils.pas +++ b/src/corelib/fpg_stringutils.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -58,10 +58,13 @@ function fpgTrimR(const AString, ATrim: TfpgString; ACaseSensitive: boolean = f // Encoding conversions function CP437ToUTF8(const s: string): TfpgString; // DOS central europe function CP850ToUTF8(const s: string): TfpgString; // DOS western europe +function CP866ToUTF8(const s: string): TfpgString; // DOS and Windows console's cyrillic +function CP1250ToUTF8(const s: string): TfpgString; // central europe function IBMGraphToUTF8(const s: string): TfpgString; // IBM PC / DOS http://www.unicode.org/Public/MAPPINGS/VENDORS/MISC/IBMGRAPH.TXT function IPFToUTF8(const s: string): TfpgString; // minor replacements to improve DocView output function SingleByteToUTF8(const s: string; const Table: TCharToUTF8Table): TfpgString; +function ConvertTextToUTF8(const AEncoding: TfpgTextEncoding; const AText: AnsiString): TfpgString; implementation @@ -935,6 +938,525 @@ const ); + ArrayCP866ToUTF8 : TCharToUTF8Table = ( + #0, //#0 + #1, //#1 + #2, //#2 + #3, //#3 + #4, //#4 + #5, //#5 + #6, //#6 + #7, //#7 + #8, //#8 + #9, //#9 + #10, //#10 + #11, //#11 + #12, //#12 + #13, //#13 + #14, //#14 + #15, //#15 + #16, //#16 + #17, //#17 + #18, //#18 + #19, //#19 + #20, //#20 + #21, //#21 + #22, //#22 + #23, //#23 + #24, //#24 + #25, //#25 + #26, //#26 + #27, //#27 + #28, //#28 + #29, //#29 + #30, //#30 + #31, //#31 + #32, //#32 + #33, //#33 + #34, //#34 + #35, //#35 + #36, //#36 + #37, //#37 + #38, //#38 + #39, //#39 + #40, //#40 + #41, //#41 + #42, //#42 + #43, //#43 + #44, //#44 + #45, //#45 + #46, //#46 + #47, //#47 + #48, //#48 + #49, //#49 + #50, //#50 + #51, //#51 + #52, //#52 + #53, //#53 + #54, //#54 + #55, //#55 + #56, //#56 + #57, //#57 + #58, //#58 + #59, //#59 + #60, //#60 + #61, //#61 + #62, //#62 + #63, //#63 + #64, //#64 + #65, //#65 + #66, //#66 + #67, //#67 + #68, //#68 + #69, //#69 + #70, //#70 + #71, //#71 + #72, //#72 + #73, //#73 + #74, //#74 + #75, //#75 + #76, //#76 + #77, //#77 + #78, //#78 + #79, //#79 + #80, //#80 + #81, //#81 + #82, //#82 + #83, //#83 + #84, //#84 + #85, //#85 + #86, //#86 + #87, //#87 + #88, //#88 + #89, //#89 + #90, //#90 + #91, //#91 + #92, //#92 + #93, //#93 + #94, //#94 + #95, //#95 + #96, //#96 + #97, //#97 + #98, //#98 + #99, //#99 + #100, //#100 + #101, //#101 + #102, //#102 + #103, //#103 + #104, //#104 + #105, //#105 + #106, //#106 + #107, //#107 + #108, //#108 + #109, //#109 + #110, //#110 + #111, //#111 + #112, //#112 + #113, //#113 + #114, //#114 + #115, //#115 + #116, //#116 + #117, //#117 + #118, //#118 + #119, //#119 + #120, //#120 + #121, //#121 + #122, //#122 + #123, //#123 + #124, //#124 + #125, //#125 + #126, //#126 + #127, //#127 + #208#144, //#128 + #208#145, //#129 + #208#146, //#130 + #208#147, //#131 + #208#148, //#132 + #208#149, //#133 + #208#150, //#134 + #208#151, //#135 + #208#152, //#136 + #208#153, //#137 + #208#154, //#138 + #208#155, //#139 + #208#156, //#140 + #208#157, //#141 + #208#158, //#142 + #208#159, //#143 + #208#160, //#144 + #208#161, //#145 + #208#162, //#146 + #208#163, //#147 + #208#164, //#148 + #208#165, //#149 + #208#166, //#150 + #208#167, //#151 + #208#168, //#152 + #208#169, //#153 + #208#170, //#154 + #208#171, //#155 + #208#172, //#156 + #208#173, //#157 + #208#174, //#158 + #208#175, //#159 + #208#176, //#160 + #208#177, //#161 + #208#178, //#162 + #208#179, //#163 + #208#180, //#164 + #208#181, //#165 + #208#182, //#166 + #208#183, //#167 + #208#184, //#168 + #208#185, //#169 + #208#186, //#170 + #208#187, //#171 + #208#188, //#172 + #208#189, //#173 + #208#190, //#174 + #208#191, //#175 + #226#150#145, //#176 + #226#150#146, //#177 + #226#150#147, //#178 + #226#148#130, //#179 + #226#148#164, //#180 + #226#149#161, //#181 + #226#149#162, //#182 + #226#149#150, //#183 + #226#149#149, //#184 + #226#149#163, //#185 + #226#149#145, //#186 + #226#149#151, //#187 + #226#149#157, //#188 + #226#149#156, //#189 + #226#149#155, //#190 + #226#148#144, //#191 + #226#148#148, //#192 + #226#148#180, //#193 + #226#148#172, //#194 + #226#148#156, //#195 + #226#148#128, //#196 + #226#148#188, //#197 + #226#149#158, //#198 + #226#149#159, //#199 + #226#149#154, //#200 + #226#149#148, //#201 + #226#149#169, //#202 + #226#149#166, //#203 + #226#149#160, //#204 + #226#149#144, //#205 + #226#149#172, //#206 + #226#149#167, //#207 + #226#149#168, //#208 + #226#149#164, //#209 + #226#149#165, //#210 + #226#149#153, //#211 + #226#149#152, //#212 + #226#149#146, //#213 + #226#149#147, //#214 + #226#149#171, //#215 + #226#149#170, //#216 + #226#148#152, //#217 + #226#148#140, //#218 + #226#150#136, //#219 + #226#150#132, //#220 + #226#150#140, //#221 + #226#150#144, //#222 + #226#150#128, //#223 + #209#128, //#224 + #209#129, //#225 + #209#130, //#226 + #209#131, //#227 + #209#132, //#228 + #209#133, //#229 + #209#134, //#230 + #209#135, //#231 + #209#136, //#232 + #209#137, //#233 + #209#138, //#234 + #209#139, //#235 + #209#140, //#236 + #209#141, //#237 + #209#142, //#238 + #209#143, //#239 + #208#129, //#240 + #209#145, //#241 + #208#132, //#242 + #209#148, //#243 + #208#135, //#244 + #209#151, //#245 + #208#142, //#246 + #209#158, //#247 + #194#176, //#248 + #226#136#153, //#249 + #194#183, //#250 + #226#136#154, //#251 + #226#132#150, //#252 + #194#164, //#253 + #226#150#160, //#254 + #194#160 //#255 + ); + + + ArrayCP1250ToUTF8: TCharToUTF8Table = ( + #0, // #0 + #1, // #1 + #2, // #2 + #3, // #3 + #4, // #4 + #5, // #5 + #6, // #6 + #7, // #7 + #8, // #8 + #9, // #9 + #10, // #10 + #11, // #11 + #12, // #12 + #13, // #13 + #14, // #14 + #15, // #15 + #16, // #16 + #17, // #17 + #18, // #18 + #19, // #19 + #20, // #20 + #21, // #21 + #22, // #22 + #23, // #23 + #24, // #24 + #25, // #25 + #26, // #26 + #27, // #27 + #28, // #28 + #29, // #29 + #30, // #30 + #31, // #31 + ' ', // ' ' + '!', // '!' + '"', // '"' + '#', // '#' + '$', // '$' + '%', // '%' + '&', // '&' + '''', // '''' + '(', // '(' + ')', // ')' + '*', // '*' + '+', // '+' + ',', // ',' + '-', // '-' + '.', // '.' + '/', // '/' + '0', // '0' + '1', // '1' + '2', // '2' + '3', // '3' + '4', // '4' + '5', // '5' + '6', // '6' + '7', // '7' + '8', // '8' + '9', // '9' + ':', // ':' + ';', // ';' + '<', // '<' + '=', // '=' + '>', // '>' + '?', // '?' + '@', // '@' + 'A', // 'A' + 'B', // 'B' + 'C', // 'C' + 'D', // 'D' + 'E', // 'E' + 'F', // 'F' + 'G', // 'G' + 'H', // 'H' + 'I', // 'I' + 'J', // 'J' + 'K', // 'K' + 'L', // 'L' + 'M', // 'M' + 'N', // 'N' + 'O', // 'O' + 'P', // 'P' + 'Q', // 'Q' + 'R', // 'R' + 'S', // 'S' + 'T', // 'T' + 'U', // 'U' + 'V', // 'V' + 'W', // 'W' + 'X', // 'X' + 'Y', // 'Y' + 'Z', // 'Z' + '[', // '[' + '\', // '\' + ']', // ']' + '^', // '^' + '_', // '_' + '`', // '`' + 'a', // 'a' + 'b', // 'b' + 'c', // 'c' + 'd', // 'd' + 'e', // 'e' + 'f', // 'f' + 'g', // 'g' + 'h', // 'h' + 'i', // 'i' + 'j', // 'j' + 'k', // 'k' + 'l', // 'l' + 'm', // 'm' + 'n', // 'n' + 'o', // 'o' + 'p', // 'p' + 'q', // 'q' + 'r', // 'r' + 's', // 's' + 't', // 't' + 'u', // 'u' + 'v', // 'v' + 'w', // 'w' + 'x', // 'x' + 'y', // 'y' + 'z', // 'z' + '{', // '{' + '|', // '|' + '}', // '}' + '~', // '~' + #127, // #127 + #226#130#172, // #128 + '', // #129 + #226#128#154, // #130 + '', // #131 + #226#128#158, // #132 + #226#128#166, // #133 + #226#128#160, // #134 + #226#128#161, // #135 + '', // #136 + #226#128#176, // #137 + #197#160, // #138 + #226#128#185, // #139 + #197#154, // #140 + #197#164, // #141 + #197#189, // #142 + #197#185, // #143 + '', // #144 + #226#128#152, // #145 + #226#128#153, // #146 + #226#128#156, // #147 + #226#128#157, // #148 + #226#128#162, // #149 + #226#128#147, // #150 + #226#128#148, // #151 + '', // #152 + #226#132#162, // #153 + #197#161, // #154 + #226#128#186, // #155 + #197#155, // #156 + #197#165, // #157 + #197#190, // #158 + #197#186, // #159 + #194#160, // #160 + #203#135, // #161 + #203#152, // #162 + #197#129, // #163 + #194#164, // #164 + #196#132, // #165 + #194#166, // #166 + #194#167, // #167 + #194#168, // #168 + #194#169, // #169 + #197#158, // #170 + #194#171, // #171 + #194#172, // #172 + #194#173, // #173 + #194#174, // #174 + #197#187, // #175 + #194#176, // #176 + #194#177, // #177 + #203#155, // #178 + #197#130, // #179 + #194#180, // #180 + #194#181, // #181 + #194#182, // #182 + #194#183, // #183 + #194#184, // #184 + #196#133, // #185 + #197#159, // #186 + #194#187, // #187 + #196#189, // #188 + #203#157, // #189 + #196#190, // #190 + #197#188, // #191 + #197#148, // #192 + #195#129, // #193 + #195#130, // #194 + #196#130, // #195 + #195#132, // #196 + #196#185, // #197 + #196#134, // #198 + #195#135, // #199 + #196#140, // #200 + #195#137, // #201 + #196#152, // #202 + #195#139, // #203 + #196#154, // #204 + #195#141, // #205 + #195#142, // #206 + #196#142, // #207 + #196#144, // #208 + #197#131, // #209 + #197#135, // #210 + #195#147, // #211 + #195#148, // #212 + #197#144, // #213 + #195#150, // #214 + #195#151, // #215 + #197#152, // #216 + #197#174, // #217 + #195#154, // #218 + #197#176, // #219 + #195#156, // #220 + #195#157, // #221 + #197#162, // #222 + #195#159, // #223 + #197#149, // #224 + #195#161, // #225 + #195#162, // #226 + #196#131, // #227 + #195#164, // #228 + #196#186, // #229 + #196#135, // #230 + #195#167, // #231 + #196#141, // #232 + #195#169, // #233 + #196#153, // #234 + #195#171, // #235 + #196#155, // #236 + #195#173, // #237 + #195#174, // #238 + #196#143, // #239 + #196#145, // #240 + #197#132, // #241 + #197#136, // #242 + #195#179, // #243 + #195#180, // #244 + #197#145, // #245 + #195#182, // #246 + #195#183, // #247 + #197#153, // #248 + #197#175, // #249 + #195#186, // #250 + #197#177, // #251 + #195#188, // #252 + #195#189, // #253 + #197#163, // #254 + #203#153 // #255 + ); + ArrayIBMGraphToUTF8: TCharToUTF8Table = ( #0, // #0 @@ -1465,6 +1987,16 @@ begin Result := SingleByteToUTF8(s, ArrayCP850ToUTF8); end; +function CP866ToUTF8(const s: string): TfpgString; +begin + Result := SingleByteToUTF8(s, ArrayCP866ToUTF8); +end; + +function CP1250ToUTF8(const s: string): TfpgString; +begin + Result := SingleByteToUTF8(s, ArrayCP1250ToUTF8); +end; + function IBMGraphToUTF8(const s: string): TfpgString; begin Result := SingleByteToUTF8(s, ArrayIBMGraphToUTF8); @@ -1539,6 +2071,19 @@ begin SetLength(Result, PtrUInt(Dest)-PtrUInt(Result)); end; +function ConvertTextToUTF8(const AEncoding: TfpgTextEncoding; const AText: AnsiString): TfpgString; +begin + case AEncoding of + encUTF8: Result := IPFToUTF8(AText); + encCP437: Result := CP437ToUTF8(AText); + encCP850: Result := CP850ToUTF8(AText); + encCP866: Result := CP866ToUTF8(AText); + encIBMGraph: Result := IBMGraphToUTF8(AText); + else + Result := IPFToUTF8(AText); + end; +end; + end. diff --git a/src/corelib/fpg_utils.pas b/src/corelib/fpg_utils.pas index 9d0e907d..9a135d73 100644 --- a/src/corelib/fpg_utils.pas +++ b/src/corelib/fpg_utils.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -51,6 +51,7 @@ function fpgIsBitSet(const AData: integer; const AIndex: integer): boolean; // RTL wrapper filesystem functions with platform independant encoding // These functions are common for all platforms and rely on fpgXXXPlatformEncoding +function fpgApplicationName: TfpgString; function fpgFindFirst(const Path: TfpgString; Attr: longint; out Rslt: TSearchRec): longint; function fpgFindNext(var Rslt: TSearchRec): longint; function fpgGetCurrentDir: TfpgString; @@ -63,7 +64,7 @@ function fpgExtractFileDir(const FileName: TfpgString): TfpgString; function fpgExtractFilePath(const FileName: TfpgString): TfpgString; function fpgExtractFileName(const FileName: TfpgString): TfpgString; function fpgExtractFileExt(const FileName: TfpgString): TfpgString; -function fpgExtractRelativepath(const ABaseName, ADestName: TfpgString): TfpgString; +function fpgExtractRelativePath(const ABaseName, ADestName: TfpgString): TfpgString; function fpgForceDirectories(const ADirectory: TfpgString): Boolean; function fpgChangeFileExt(const FileName, Extension: TfpgString): TfpgString; function fpgGetAppConfigDir(const Global: Boolean): TfpgString; @@ -101,6 +102,11 @@ begin Result := ALine; end; +function fpgApplicationName: TfpgString; +begin + Result := fpgFromOSEncoding(ApplicationName); +end; + function fpgFindFirst(const Path: TfpgString; Attr: longint; out Rslt: TSearchRec): longint; begin Result := FindFirst(fpgToOSEncoding(Path), Attr, Rslt); @@ -165,7 +171,7 @@ begin Result := ExtractFileExt(fpgToOSEncoding(Filename)); end; -function fpgExtractRelativepath(const ABaseName, ADestName: TfpgString): TfpgString; +function fpgExtractRelativePath(const ABaseName, ADestName: TfpgString): TfpgString; begin Result := ExtractRelativepath(fpgToOSEncoding(ABaseName), fpgToOSEncoding(ADestName)); end; diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas index a74c1b30..527e2987 100644 --- a/src/corelib/fpg_widget.pas +++ b/src/corelib/fpg_widget.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 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -39,6 +39,8 @@ type TfpgDragDropEvent = procedure(Sender, Source: TObject; X, Y: integer; AData: variant) of object; + { TfpgWidget } + TfpgWidget = class(TfpgWindow) private FAcceptDrops: boolean; @@ -50,12 +52,14 @@ type FOnDragLeave: TNotifyEvent; FOnEnter: TNotifyEvent; FOnExit: TNotifyEvent; + FOnKeyChar: TfpgKeyCharEvent; FOnMouseDown: TMouseButtonEvent; FOnMouseEnter: TNotifyEvent; FOnMouseExit: TNotifyEvent; FOnMouseMove: TMouseMoveEvent; FOnMouseUp: TMouseButtonEvent; FOnMouseScroll: TMouseWheelEvent; + FOnMouseHorizScroll: TMouseWheelEvent; FOnPaint: TPaintEvent; FOnKeyPress: TKeyPressEvent; FOnResize: TNotifyEvent; @@ -81,6 +85,7 @@ type procedure MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER; procedure MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT; procedure MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL; + procedure MsgMouseHorizScroll(var msg: TfpgMessageRec); message FPGM_HSCROLL; procedure MsgDropEnter(var msg: TfpgMessageRec); message FPGM_DROPENTER; procedure MsgDropExit(var msg: TfpgMessageRec); message FPGM_DROPEXIT; protected @@ -134,6 +139,7 @@ type procedure HandleMouseEnter; virtual; procedure HandleMouseExit; virtual; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual; function FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; procedure HandleAlignments(const dwidth, dheight: TfpgCoord); virtual; procedure HandleShow; virtual; @@ -146,6 +152,7 @@ type property OnDoubleClick: TMouseButtonEvent read FOnDoubleClick write FOnDoubleClick; property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; property OnExit: TNotifyEvent read FOnExit write FOnExit; + property OnKeyChar: TfpgKeyCharEvent read FOnKeyChar write FOnKeyChar; property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress; property OnMouseDown: TMouseButtonEvent read FOnMouseDown write FOnMouseDown; property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; @@ -153,6 +160,7 @@ type property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp; property OnMouseScroll: TMouseWheelEvent read FOnMouseScroll write FOnMouseScroll; + property OnMouseHorizScroll: TMouseWheelEvent read FOnMouseHorizScroll write FOnMouseHorizScroll; property OnPaint: TPaintEvent read FOnPaint write FOnPaint; property OnResize: TNotifyEvent read FOnResize write FOnResize; property OnShowHint: THintEvent read GetOnShowHint write SetOnShowHint; @@ -161,6 +169,7 @@ type destructor Destroy; override; procedure AfterConstruction; override; function InDesigner: boolean; + function IsLoading: boolean; procedure InvokeHelp; virtual; procedure Realign; procedure SetFocus; @@ -432,6 +441,11 @@ begin Result := (FFormDesigner <> nil) end; +function TfpgWidget.IsLoading: boolean; +begin + Result := csLoading in ComponentState; +end; + procedure TfpgWidget.InvokeHelp; begin case HelpType of @@ -854,6 +868,12 @@ begin msg.Params.mouse.shiftstate, msg.Params.mouse.delta); end; +procedure TfpgWidget.MsgMouseHorizScroll(var msg: TfpgMessageRec); +begin + HandleMouseHorizScroll(msg.Params.mouse.x, msg.Params.mouse.y, + msg.Params.mouse.shiftstate, msg.Params.mouse.delta); +end; + procedure TfpgWidget.MsgDropEnter(var msg: TfpgMessageRec); begin // do nothing @@ -943,7 +963,8 @@ end; procedure TfpgWidget.HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); begin - // descendants will implement this. + if FFocusable and Assigned(OnKeyChar) then + OnKeyChar(self, AText, consumed); end; procedure TfpgWidget.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; @@ -962,8 +983,11 @@ begin if not consumed and (keycode = fpgApplication.HelpKey) and (shiftstate=[]) then begin - InvokeHelp; - consumed := True; + if fpgApplication.HelpFile <> '' then + begin + InvokeHelp; + consumed := True; + end; end; case keycode of @@ -1189,6 +1213,12 @@ begin FOnMouseScroll(self, shiftstate, delta, Point(x, y)); end; +procedure TfpgWidget.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +begin + if Assigned(FOnMouseHorizScroll) then + FOnMouseHorizScroll(self, shiftstate, delta, Point(x, y)); +end; + function TfpgWidget.FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; var w: TfpgWidget; diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas index 196e467a..f1372928 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 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -40,7 +40,7 @@ uses fpg_base, fpg_impl {$IFDEF DEBUG} - ,dbugintf + ,fpg_dbugintf {$ENDIF DEBUG} ,fpg_OLEDragDrop ; @@ -147,6 +147,7 @@ type public constructor Create(awin: TfpgWindowBase); override; destructor Destroy; override; + procedure CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; var ASrcRect: TfpgRect); override; end; @@ -262,10 +263,13 @@ type TfpgGDIFileList = class(TfpgFileListBase) + private function EncodeAttributesString(attrs: longword): TFileModeString; - constructor Create; override; + protected function InitializeEntry(sr: TSearchRec): TFileEntry; override; procedure PopulateSpecialDirs(const aDirectory: TfpgString); override; + public + constructor Create; override; end; @@ -705,6 +709,7 @@ var wmsg: TMsg; PaintStruct: TPaintStruct; TmpW: widestring; + wheelpos: integer; //------------ procedure SetMinMaxInfo(var MinMaxInfo: TMINMAXINFO); @@ -722,7 +727,7 @@ var dy := 0; IntfWidth := AWidth; IntfHeight := AHeight; - + GetWindowBorderDimensions(w, dx, dy); Inc(IntfWidth, dx); Inc(IntfHeight, dy); @@ -850,7 +855,7 @@ begin msgp.keyboard.keychar := UTF8Encode(tmpW); fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp); end; - + // Allow Alt+F4 and other system key combinations if (uMsg = WM_SYSKEYUP) or (uMsg = WM_SYSKEYDOWN) then Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); @@ -877,7 +882,7 @@ begin begin {$IFDEF DEBUG} if uMsg <> WM_MOUSEMOVE then - writeln('fpGFX/GDI: Found a mouse button event'); + SendDebug('fpGFX/GDI: Found a mouse button event'); {$ENDIF} // msgp.mouse.x := smallint(lParam and $FFFF); // msgp.mouse.y := smallint((lParam and $FFFF0000) shr 16); @@ -962,7 +967,7 @@ begin end; mcode := FPGM_MOUSEDOWN; end; - + WM_LBUTTONUP, WM_MBUTTONUP, WM_RBUTTONUP: @@ -1000,7 +1005,7 @@ begin WM_LBUTTONDOWN, WM_LBUTTONUP: msgp.mouse.Buttons := MOUSE_LEFT; - + WM_MBUTTONDOWN, WM_MBUTTONUP: msgp.mouse.Buttons := MOUSE_MIDDLE; @@ -1029,8 +1034,8 @@ begin begin if w.FSkipResizeMessage then Exit; - - // note that WM_SIZING allows some control on sizeing + + // note that WM_SIZING allows some control on sizing //writeln('WM_SIZE: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); msgp.rect.Width := smallint(lParam and $FFFF); msgp.rect.Height := smallint((lParam and $FFFF0000) shr 16); @@ -1090,7 +1095,13 @@ begin begin msgp.mouse.x := pt.x; msgp.mouse.y := pt.y; - msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120; + { calculate direction of the mouse wheel } + wheelpos := 0; + dec(wheelpos, SmallInt(HiWord(wParam))); + if wheelpos > 0 then + msgp.mouse.delta := 1 + else + msgp.mouse.delta := -1; i := 0; if (wParam and MK_LBUTTON) <> 0 then @@ -1128,7 +1139,7 @@ begin {$IFDEF DEBUG} SendDebug(w.ClassName + ': WM_TIMECHANGE'); {$ENDIF} - writeln('fpGUI/GDI: ' + w.ClassName + ': WM_TIMECHANGE'); +// writeln('fpGUI/GDI: ' + w.ClassName + ': WM_TIMECHANGE'); fpgResetAllTimers; end; @@ -1248,6 +1259,8 @@ begin end; function TfpgGDIApplication.GetHiddenWindow: HWND; +var + lHandle: TfpgWinHandle; begin if (FHiddenWindow = 0) then begin @@ -1263,8 +1276,12 @@ begin end; Windows.RegisterClass(@HiddenWndClass); + if MainForm <> nil then + lHandle := TfpgGDIWindow(MainForm).FWinHandle + else + lHandle := -1; FHiddenWindow := CreateWindow('FPGHIDDEN', '', - DWORD(WS_POPUP), 0, 0, 0, 0, TfpgGDIWindow(MainForm).FWinHandle, 0, MainInstance, nil); + DWORD(WS_POPUP), 0, 0, 0, 0, lHandle, 0, MainInstance, nil); end; Result := FHiddenWindow; end; @@ -1413,7 +1430,7 @@ var wg: TfpgWidget; begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIWindow.HandleDNDLeave '); + SendDebug('TfpgGDIWindow.HandleDNDLeave '); {$ENDIF} FUserMimeSelection := ''; wg := self as TfpgWidget; @@ -1437,7 +1454,7 @@ var msgp: TfpgMessageParams; begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIWindow.HandleDNDEnter '); + SendDebug('TfpgGDIWindow.HandleDNDEnter '); {$ENDIF} wg := self as TfpgWidget; if wg.AcceptDrops then @@ -1500,7 +1517,7 @@ begin if FDropPos <> PT then begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIWindow.HandleDNDPosition '); + SendDebug('TfpgGDIWindow.HandleDNDPosition '); {$ENDIF} FDropPos.x := PT.x; FDropPos.y := PT.y; @@ -1521,12 +1538,13 @@ var swg: TfpgWidget; { source widget } CF: DWORD; lIsTranslated: Boolean; + lPoint: Windows.Point; begin if not FUserAcceptDrag then exit; {$IFDEF DND_DEBUG} - Writeln('TfpgGDIWindow.HandleDNDDrop'); + SendDebug('TfpgGDIWindow.HandleDNDDrop'); {$ENDIF} wg := self as TfpgWidget; @@ -1546,7 +1564,11 @@ begin swg := uDragSource as TfpgWidget else swg := nil; - wg.OnDragDrop(wg, swg, pt.x, pt.y, data); + // convert mouse screen coordinates to widget coordinates + lPoint.x := pt.x; + lPoint.y := pt.y; + ScreenToClient(wg.WinHandle, lPoint); + wg.OnDragDrop(wg, swg, lPoint.x, lPoint.y, data); uDragSource := nil; end; GlobalUnlock(stgmed.HGLOBAL); @@ -1603,7 +1625,7 @@ begin CurrentWindowHndl := WindowFromPoint(spt); CursorInDifferentWindow := (CurrentWindowHndl <> uLastWindowHndl); - + if CursorInDifferentWindow then begin FillChar(msgp, sizeof(msgp), 0); @@ -1623,7 +1645,7 @@ begin fpgSendMessage(nil, CurrentWindow, FPGM_MOUSEENTER, msgp); end; end; - + uLastWindowHndl := CurrentWindowHndl; end; @@ -1646,18 +1668,18 @@ begin FNonFullscreenRect.Left := 0; if FNonFullscreenRect.Top < 0 then FNonFullscreenRect.Top := 0; - + Left := 0; Top := 0; Width := wapplication.GetScreenWidth; Height := wapplication.GetScreenHeight; - + if aUpdate then UpdateWindowPosition; FWinStyle := WS_POPUP or WS_SYSMENU; FWinStyle := FWinStyle and not(WS_CAPTION or WS_THICKFRAME); - + if aUpdate then begin {$IFDEF CPU64} @@ -1687,7 +1709,7 @@ begin Top := FNonFullscreenRect.Top; Width := FNonFullscreenRect.Width; Height := FNonFullscreenRect.Height; - + if aUpdate then UpdateWindowPosition; end; @@ -1710,7 +1732,7 @@ var begin if FWinHandle > 0 then Exit; //==> - + FSkipResizeMessage := True; FWinStyle := WS_OVERLAPPEDWINDOW; @@ -1766,7 +1788,7 @@ begin FWinStyle := FWinStyle and not (WS_SIZEBOX or WS_MAXIMIZEBOX); FWinStyle := FWinStyle or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; - + if waFullScreen in FWindowAttributes then WindowSetFullscreen(True, False); @@ -2131,6 +2153,27 @@ begin inherited; end; +procedure TfpgGDICanvas.CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; + var ASrcRect: TfpgRect); +var + srcdc: HDC; + destdc: HDC; +begin + if (TfpgWindow(FWindow).WinHandle <= 0) or (TfpgWindow(TfpgGDICanvas(ASrcCanvas).FWindow).WinHandle <= 0) then + begin + debugln(' no winhandle available'); + exit; + end; + + destdc := Windows.GetDC(TfpgWindow(FWindow).WinHandle); + srcdc := Windows.GetDC(TfpgWindow(TfpgGDICanvas(ASrcCanvas).FWindow).WinHandle); + + BitBlt(destdc, ADest_x, ADest_y, ASrcRect.Width, ASrcRect.Height, srcdc, ASrcRect.Left, ASrcRect.Top, SRCCOPY); + + ReleaseDC(TfpgWindow(TfpgGDICanvas(ASrcCanvas).FWindow).WinHandle, srcdc); + ReleaseDC(TfpgWindow(FWindow).WinHandle, destdc); +end; + procedure TfpgGDICanvas.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); var ARect: TfpgRect; @@ -2199,7 +2242,7 @@ begin DeleteObject(FClipRegion); TryFreeBackBuffer; - + Windows.ReleaseDC(FDrawWindow.FWinHandle, FWingc); FDrawing := False; @@ -2212,8 +2255,10 @@ var c: longword; begin c := Windows.GetPixel(FWinGC, X, Y); + {$IFDEF DEBUG} if c = CLR_INVALID then - Writeln('fpGFX/GDI: TfpgGDICanvas.GetPixel returned an invalid color'); + SendDebug('fpGFX/GDI: TfpgGDICanvas.GetPixel returned an invalid color'); + {$ENDIF} Result := WinColorTofpgColor(c); end; @@ -2457,7 +2502,7 @@ begin if FBufferBitmap > 0 then DeleteObject(FBufferBitmap); FBufferBitmap := 0; - + if FBufgc > 0 then DeleteDC(FBufgc); FBufgc := 0; @@ -2882,7 +2927,7 @@ var drvs: string; begin FSpecialDirs.Clear; - + // making drive list if Copy(aDirectory, 2, 1) = ':' then begin @@ -2929,7 +2974,7 @@ end; destructor TfpgGDIDrag.Destroy; begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIDrag.Destroy '); + SendDebug('TfpgGDIDrag.Destroy '); {$ENDIF} inherited Destroy; end; @@ -2951,14 +2996,14 @@ begin if FDragging then begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIDrag.Execute (already dragging)'); + SendDebug('TfpgGDIDrag.Execute (already dragging)'); {$ENDIF} Result := daIgnore; end else begin {$IFDEF DND_DEBUG} - writeln('TfpgGDIDrag.Execute (new drag)'); + SendDebug('TfpgGDIDrag.Execute (new drag)'); {$ENDIF} FDragging := True; wapplication.Drag := self; @@ -2973,7 +3018,7 @@ begin {$Note OLE DND: We are only handling strings at the moment, this needs to be extended to other types too } itm := FMimeData[i]; {$IFDEF DND_DEBUG} - writeln(' Processing mime-type: ', itm.Format); + SendDebug(' Processing mime-type: ', itm.Format); {$ENDIF} { description of data we are sending } @@ -3089,7 +3134,11 @@ begin ActiveX.RevokeDragDrop(TfpgWidget(FDropTarget).WinHandle); end; -procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT; dwTime: DWORD); stdcall; +{$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; +{$IFEND} begin { idEvent contains the handle to the timer that got triggered } fpgCheckTimers; @@ -3102,7 +3151,6 @@ begin inherited SetEnabled(AValue); if FEnabled then begin -// FHandle := Windows.SetTimer(0, 0, Interval, nil); FHandle := Windows.SetTimer(0, 0, Interval, @TimerCallBackProc); end else @@ -3164,7 +3212,7 @@ initialization GetVersionEx(WinVersion); UnicodeEnabledOS := (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) or (WinVersion.dwPlatformID = VER_PLATFORM_WIN32_CE); - + if SystemParametersInfo(SPI_GETFONTSMOOTHINGTYPE, 0, @FontSmoothingType, 0) and (FontSmoothingType = FE_FONTSMOOTHINGCLEARTYPE) then FontSmoothingType := CLEARTYPE_QUALITY diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk index bf019e5f..dfe56c14 100644 --- a/src/corelib/gdi/fpgui_toolkit.lpk +++ b/src/corelib/gdi/fpgui_toolkit.lpk @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <Package Version="4"> <PathDelim Value="\"/> @@ -30,8 +30,8 @@ </CompilerOptions> <Description Value="fpGUI Toolkit"/> <License Value="LGPL 2 with static linking exception."/> - <Version Major="1"/> - <Files Count="98"> + <Version Major="1" Minor="2"/> + <Files Count="104"> <Item1> <Filename Value="..\stdimages.inc"/> <Type Value="Include"/> @@ -424,8 +424,32 @@ <Filename Value="..\render\software\Agg2D.pas"/> <UnitName Value="Agg2D"/> </Item98> + <Item99> + <Filename Value="..\fpg_dbugintf.pas"/> + <UnitName Value="fpg_dbugintf"/> + </Item99> + <Item100> + <Filename Value="..\fpg_dbugmsg.pas"/> + <UnitName Value="fpg_dbugmsg"/> + </Item100> + <Item101> + <Filename Value="..\..\gui\fpg_style_carbon.pas"/> + <UnitName Value="fpg_style_carbon"/> + </Item101> + <Item102> + <Filename Value="..\..\gui\fpg_style_plastic.pas"/> + <UnitName Value="fpg_style_plastic"/> + </Item102> + <Item103> + <Filename Value="..\..\gui\fpg_style_win8.pas"/> + <UnitName Value="fpg_style_win8"/> + </Item103> + <Item104> + <Filename Value="..\..\gui\inputquerydialog.inc"/> + <Type Value="Include"/> + </Item104> </Files> - <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/> + <LazDoc Paths="..\..\..\docs\xml\corelib;..\..\..\docs\xml\corelib\x11;..\..\..\docs\xml\corelib\gdi;..\..\..\docs\xml\gui"/> <RequiredPkgs Count="1"> <Item1> <PackageName Value="FCL"/> diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas index 05501714..12ac41b9 100644 --- a/src/corelib/gdi/fpgui_toolkit.pas +++ b/src/corelib/gdi/fpgui_toolkit.pas @@ -21,7 +21,8 @@ uses 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; + U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg, + fpg_style_carbon, fpg_style_plastic, fpg_style_win8; implementation diff --git a/src/corelib/predefinedcolors.inc b/src/corelib/predefinedcolors.inc index 130cdd9f..7ad000d4 100644 --- a/src/corelib/predefinedcolors.inc +++ b/src/corelib/predefinedcolors.inc @@ -69,6 +69,7 @@ clGridInactiveSel = TfpgColor(cl_BaseNamedColor + 30); clGridInactiveSelText = TfpgColor(cl_BaseNamedColor + 31); clSplitterGrabBar = TfpgColor(cl_BaseNamedColor + 32); + clHyperLink = TfpgColor(cl_BaseNamedColor + 33); diff --git a/src/corelib/render/software/Agg2D.pas b/src/corelib/render/software/Agg2D.pas index 50a68fb8..229294d2 100644 --- a/src/corelib/render/software/Agg2D.pas +++ b/src/corelib/render/software/Agg2D.pas @@ -400,6 +400,8 @@ type procedure ClearAll(c : TAggColor ); overload; procedure ClearAll(r ,g ,b : byte; a : byte = 255 ); overload; + procedure FillAll(c: TAggColor); overload; + procedure FillAll(r, g, b: byte; a: byte = 255); overload; // Master Rendering Properties procedure BlendMode(m : TAggBlendMode ); overload; @@ -1288,6 +1290,9 @@ begin m_pathTransform.Construct (@m_convCurve ,@m_transform ); m_strokeTransform.Construct(@m_convStroke ,@m_transform ); + m_convDash.remove_all_dashes; + m_convDash.add_dash(600, 0); {$NOTE Find a better way to prevent dash generation } + {$IFDEF AGG2D_USE_FREETYPE } m_fontEngine.Construct; {$ENDIF } @@ -1491,6 +1496,22 @@ begin end; +procedure TAgg2D.FillAll(c: TAggColor); +var + clr: aggclr; +begin + clr.Construct (c ); + m_renBase.fill(@clr ); +end; + +procedure TAgg2D.FillAll(r, g, b: byte; a: byte); +var + clr: TAggColor; +begin + clr.Construct(r, g, b, a); + FillAll(clr); +end; + { CLEARCLIPBOX } procedure TAgg2D.ClearClipBox(c : TAggColor ); var @@ -1517,14 +1538,14 @@ end; { WORLDTOSCREEN } procedure TAgg2D.WorldToScreen(x ,y : PDouble ); begin - m_transform.transform(@m_transform ,double_ptr(x ) ,double_ptr(y ) ); + m_transform.transform(@m_transform, x, y); end; { SCREENTOWORLD } procedure TAgg2D.ScreenToWorld(x ,y : PDouble ); begin - m_transform.inverse_transform(@m_transform ,double_ptr(x ) ,double_ptr(y ) ); + m_transform.inverse_transform(@m_transform, x, y); end; @@ -2649,7 +2670,8 @@ begin m_fontEngine.hinting_(m_textHints ); if cache = AGG_VectorFontCache then - m_fontEngine.height_(height ) + {$NOTE We need to fix this. Translating from font pt to pixels is inaccurate. This is just a temp fix for now. } + m_fontEngine.height_(height * 1.3333 ) // 9pt = ~12px so that is a ratio of 1.3333 else m_fontEngine.height_(worldToScreen(height ) ); {$ENDIF} @@ -3534,18 +3556,29 @@ begin end; procedure TAgg2D.DoSetFontRes(fntres: TfpgFontResourceBase); +{$IFDEF WINDOWS} begin - {$NOTE This is only temporary until I can correctly query font names } - {$IFDEF WINDOWS} + {$IFDEF AGG2D_USE_FREETYPE } + Font('c:\WINNT\Fonts\arial.ttf', 10); + {$ENDIF } + {$IFDEF AGG2D_USE_WINFONTS} Font('Arial', 13); - {$ELSE} - {$IFDEF BSD} - Font('/usr/local/lib/X11/fonts/Liberation/LiberationSans-Regular.ttf', 13); - {$ELSE} - Font('/usr/share/fonts/truetype/ttf-liberation/LiberationSans-Regular.ttf', 13); - {$ENDIF} - {$ENDIF} + {$ENDIF } end; +{$ENDIF} +{$IFDEF UNIX} +var + s: TfpgString; + i: integer; + fnt: TFontCacheItem; + lSize: double; +begin + fnt := FontCacheItemFromFontDesc(TfpgFontResource(fntres).FontDesc, lSize); + i := gFontCache.Find(fnt); + if i > 0 then + Font(gFontCache.Items[i].FileName, lSize, fnt.IsBold, fnt.IsItalic, AGG_VectorFontCache, Deg2Rad(fnt.Angle)); +end; +{$ENDIF} procedure TAgg2D.DoSetTextColor(cl: TfpgColor); var @@ -3555,7 +3588,7 @@ begin c := fpgColorToRGB(cl); t := fpgColorToRGBTriple(c); - FillColor(t.Red, t.Green, t.Blue{, t.Alpha}); + FillColor(t.Red, t.Green, t.Blue, t.Alpha); end; procedure TAgg2D.DoSetColor(cl: TfpgColor); @@ -3566,7 +3599,7 @@ begin c := fpgColorToRGB(cl); t := fpgColorToRGBTriple(c); - LineColor(t.Red, t.Green, t.Blue{, t.Alpha}); + LineColor(t.Red, t.Green, t.Blue, t.Alpha); end; procedure TAgg2D.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); @@ -3635,7 +3668,10 @@ end; procedure TAgg2D.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); begin - + LineWidth(1); + FillColor(LineColor); + LineColor(LineColor); + Triangle(x1+0.5, y1+0.5, x2+0.5, y2+0.5, x3+0.5, y3+0.5); end; procedure TAgg2D.DoDrawRectangle(x, y, w, h: TfpgCoord); diff --git a/src/corelib/render/software/agg-demos/Agg2DConsole.dpr b/src/corelib/render/software/agg-demos/Agg2DConsole.dpr new file mode 100644 index 00000000..bc8badbc --- /dev/null +++ b/src/corelib/render/software/agg-demos/Agg2DConsole.dpr @@ -0,0 +1,148 @@ +{ + This is a console application demo. It uses the Agg2D object, + which has a much friendlier API, to do all the drawing. We then + save the image buffer to a JPG, using the fcl-image package, + which comes standard with the Free Pascal Compiler. + +// Paths: ..\;..\svg;..\util;expat-wrap +} +program console_aggpas_2; + +{$mode objfpc}{$H+} + +uses + sysutils, + FPimage, + FPWriteJPEG, + agg_2D, + agg_basics; + +const + ImageWidth = 800; + ImageHeight = 480; + RGBA_Width = 4; + LineCount = 30; + {$IFDEF Unix} + FontFile = '../../arial.ttf'; + {$ENDIF} + {$IFDEF Windows} + FontFile = 'Arial'; + {$ENDIF} + +type + TPainter = class(TObject) + public + procedure HandlePlug; + procedure DrawStuff(agg: Agg2D_ptr); + end; + + +procedure TPainter.HandlePlug; +var + agg: Agg2D_ptr; + buf: array of int8; + image: TFPMemoryImage; + writer: TFPWriterJPEG; + x, y: Integer; + c: TFPColor; + time, totalTime: TDateTime; + function getBufItemAsWord(aDelta: byte): Word; + var + actualY: Integer; + begin + actualY := ImageHeight - y - 1; + result := + Word(buf[x * RGBA_Width + actualY * ImageWidth * RGBA_Width + aDelta] shl 8) + or Word(128); + end; +begin + totalTime := Now; + time := Now; + SetLength(buf, ImageWidth * ImageHeight * RGBA_Width); + New(agg, Construct); + agg^.attach(@(buf[0]), ImageWidth, ImageHeight, ImageWidth * RGBA_Width); + DrawStuff(agg); + Dispose(agg, Destruct); // not necessary to keep it after rendering is finished + time := Now - time; +// Logger.Emit('Draw: time spent: ' + TimeStampToString(time)); + time := Now; + image := TFPMemoryImage.create(ImageWidth, ImageHeight); + for x := 0 to ImageWidth - 1 do + for y := 0 to ImageHeight - 1 do + begin + c.red := getBufItemAsWord(2); + c.green := getBufItemAsWord(1); + c.blue := getBufItemAsWord(0); + c.alpha := getBufItemAsWord(3); + image.Colors[x, y] := c; + end; + time := Now - time; +// WriteLn('Image copy: time spent: ' + DateTimeToString(time)); + time := Now; + writer := TFPWriterJPEG.Create; + writer.CompressionQuality := $FF div 3; // bad quality plz + writer.ProgressiveEncoding := True; + image.SaveToFile('test.jpeg', writer); + image.Free; + writer.Free; + time := Now - time; +// WriteLn('Image encode: time spent: ' + DateTimeToString(time)); + totalTime := Now - totalTime; +// WriteLn('Total time: ' + DateTimeToString(totalTime)); +end; + +procedure TPainter.DrawStuff(agg: Agg2D_ptr); +var + i: Integer; + x, y, px, py, d: Double; +begin + agg^.clearAll(0, 0, 0); + agg^.lineColor(0, 0, 0, 255); + agg^.lineWidth(3); + agg^.rectangle(0, 0, ImageWidth, ImageHeight); + agg^.font(fontfile, 16); + d := ImageWidth / LineCount; + agg^.lineColor(0, 0, 0, 100); + agg^.lineWidth(1); + for i := 1 to LineCount - 1 do + begin + x := i * d; + agg^.line(x, 0, x, ImageHeight); + end; + for i := 1 to trunc(ImageHeight / d) do + begin + y := i * d; + agg^.line(0, y, ImageWidth, y); + end; + x := 0; + y := ImageHeight / 2; + px := x; + py := y; + agg^.lineColor(255, 0, 0, 200); + agg^.fillColor(0, 0, 0, 200); + agg^.lineWidth(3); + for i := 0 to LineCount - 1 do + begin + x := x + d; + y := y + Random(Round(ImageHeight / 3)) - ImageHeight / 6; + if y < 0 then + y := ImageHeight / 6; + if y >= ImageHeight then + y := ImageHeight - ImageHeight / 6; + agg^.line(px, py, x, y); + agg^.text(x, y, char_ptr(IntToStr(i) + ' point'{' шта?'})); + px := x; + py := y; + end; +end; + + +var + p: TPainter; +begin + Randomize; + p := TPainter.Create; + p.HandlePlug; + p.Free; +end. + diff --git a/src/corelib/render/software/agg_2D.pas b/src/corelib/render/software/agg_2D.pas index a6296e2c..45d88e44 100644 --- a/src/corelib/render/software/agg_2D.pas +++ b/src/corelib/render/software/agg_2D.pas @@ -3,11 +3,11 @@ // Based on Anti-Grain Geometry // Copyright (C) 2005 Maxim Shemanarev (http://www.antigrain.com) // -// Agg2D - Version 1.0 Release Milano 3 (AggPas 2.3 RM3) +// Agg2D - Version 1.0 Release Milano 3 (AggPas 2.4 RM3) // Pascal Port By: Milan Marusinec alias Milano // milan@marusinec.sk // http://www.aggpas.org -// Copyright (c) 2007 +// Copyright (c) 2007 - 2008 // // Permission to copy, use, modify, sell and distribute this software // is granted provided this copyright notice appears in all copies. @@ -325,6 +325,8 @@ type procedure clearAll(c : Color ); overload; procedure clearAll(r ,g ,b : unsigned; a : unsigned = 255 ); overload; + procedure FillAll(c: Color); overload; + procedure FillAll(r, g, b: byte; a: byte = 255); overload; procedure clearClipBox(c : Color ); overload; procedure clearClipBox(r ,g ,b : unsigned; a : unsigned = 255 ); overload; @@ -424,7 +426,7 @@ type rxTop ,ryTop : double ); overload; procedure ellipse(cx ,cy ,rx ,ry : double ); - + procedure arc (cx ,cy ,rx ,ry ,start ,sweep : double ); procedure star(cx ,cy ,r1 ,r2 ,startAngle : double; numRays : int ); @@ -932,6 +934,22 @@ begin end; +procedure Agg2D.FillAll(c: Color); +var + clr: aggclr; +begin + clr.Construct (c ); + m_renBase.fill(@clr ); +end; + +procedure Agg2D.FillAll(r, g, b: byte; a: byte); +var + clr: Color; +begin + clr.Construct(r, g, b, a); + FillAll(clr); +end; + { CLEARCLIPBOX } procedure Agg2D.clearClipBox(c : Color ); var diff --git a/src/corelib/render/software/agg_basics.pas b/src/corelib/render/software/agg_basics.pas index cc116cfe..56eb6fba 100644 --- a/src/corelib/render/software/agg_basics.pas +++ b/src/corelib/render/software/agg_basics.pas @@ -357,8 +357,8 @@ type procedure NoP; { These implementations have changed to use FPC's Sar*() functions, so should - now support all platforms with ASM code. At a later date these functions - could be removed completely. } + now support all platforms without the need for ASM code. At a later date these + functions could be removed completely. } function shr_int8 (i ,shift : int8 ) : int8; inline; function shr_int16(i ,shift : int16 ) : int16; inline; function shr_int32(i ,shift : int ) : int; inline; diff --git a/src/corelib/render/software/agg_platform_x11.inc b/src/corelib/render/software/agg_platform_x11.inc index 331b572e..dc5556fa 100644 --- a/src/corelib/render/software/agg_platform_x11.inc +++ b/src/corelib/render/software/agg_platform_x11.inc @@ -18,6 +18,7 @@ {$ifdef uses_implementation} fpg_x11, + fpg_fontcache, {$endif} @@ -27,6 +28,88 @@ type // to get access to protected methods (seeing that FPC doesn't support Friend-classes) TImageHack = class(TfpgImage); +function FontCacheItemFromFontDesc(const desc: string; var asize: double): TFontCacheItem; +var + facename: string; + cp: integer; + c: char; + token: string; + prop, propval: string; + + function NextC: char; + begin + Inc(cp); + if cp > length(desc) then + c := #0 + else + c := desc[cp]; + Result := c; + end; + + procedure NextToken; + begin + token := ''; + while (c <> #0) and (c in [' ', 'a'..'z', 'A'..'Z', '_', '0'..'9', '.']) do + begin + token := token + c; + NextC; + end; + end; + +begin + Result := TFontCacheItem.Create(''); + + cp := 0; + NextC; + NextToken; + + facename := token; + // Add known substites + if lowercase(facename) = 'times' then + facename := 'Times New Roman' + else if lowercase(facename) = 'courier' then + facename := 'Courier New' + else if lowercase(facename) = 'monospace' then + facename := 'Courier New'; + Result.FamilyName := facename; + + if c = '-' then + begin + NextC; + NextToken; + asize := StrToIntDef(token, 0); + end; + + while c = ':' do + begin + NextC; + NextToken; + + prop := UpperCase(token); + propval := ''; + + if c = '=' then + begin + NextC; + NextToken; + propval := UpperCase(token); + end; + + if prop = 'BOLD' then + Result.IsBold := True + else if prop = 'ITALIC' then + Result.IsItalic := True + else if prop = 'ANGLE' then + Result.Angle := StrToFloatDef(propval, 0.0); +// else if prop = 'ANTIALIAS' then +// if propval = 'FALSE' then +// lf.lfQuality := NONANTIALIASED_QUALITY else +// if propval = 'DEFAULT' then +// lf.lfQuality := DEFAULT_QUALITY; + end; +end; + + procedure TAgg2D.DoPutBufferToScreen(x, y, w, h: TfpgCoord); var drawgc: Tgc; diff --git a/src/corelib/render/software/agg_renderer_base.pas b/src/corelib/render/software/agg_renderer_base.pas index 926aebd5..cc2bade4 100644 --- a/src/corelib/render/software/agg_renderer_base.pas +++ b/src/corelib/render/software/agg_renderer_base.pas @@ -79,6 +79,7 @@ type function bounding_ymax : int; virtual; procedure clear(c : aggclr_ptr ); + procedure fill(const c: aggclr_ptr); procedure copy_pixel (x ,y : int; c : aggclr_ptr ); virtual; procedure blend_pixel(x ,y : int; c : aggclr_ptr; cover : int8u ); virtual; @@ -348,6 +349,17 @@ begin end; +procedure renderer_base.fill(const c: aggclr_ptr); +var + y: unsigned; +begin + if (width > 0) and (height > 0) then + begin + for y:=0 to height - 1 do + m_ren.blend_hline(m_ren, 0, y, width, c, cover_mask); + end; +end; + { COPY_PIXEL } procedure renderer_base.copy_pixel(x, y: int; c: aggclr_ptr); begin diff --git a/src/corelib/render/software/fpg_fontcache.pas b/src/corelib/render/software/fpg_fontcache.pas new file mode 100644 index 00000000..15f65e40 --- /dev/null +++ b/src/corelib/render/software/fpg_fontcache.pas @@ -0,0 +1,347 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This is a homegrown font cache, or font translation system. AggPas + references font files (eg: *.ttf) directly, whereas the rest + of fpGUI doesn't. Under X11 for example, the translation of + 'Aria-12' to the actual *.ttf file will be done by the fontconfig + library. Unfortunately fontconfig doesn't have an API to give + use that *.ttf font file it resolved too. So for AggPas (or rather + the AggPas backend in fpGUI) we had to implement our own + font translation system. +} + +unit fpg_fontcache; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, contnrs, fpg_base; + +type + TFontCacheItem = class(TObject) + private + FAngle: double; + FFamilyName: TfpgString; + FFileName: TfpgString; + FFixedWidth: boolean; + FStyleFlags: Integer; + function GetIsBold: boolean; + function GetIsFixedWidth: boolean; + function GetIsItalic: boolean; + function GetIsRegular: boolean; + procedure SetIsBold(AValue: boolean); + procedure SetIsFixedWidth(AValue: boolean); + procedure SetIsItalic(AValue: boolean); + procedure SetIsRegular(AValue: boolean); + public + constructor Create(const AFilename: TfpgString); + property FileName: TfpgString read FFileName write FFileName; + property FamilyName: TfpgString read FFamilyName write FFamilyName; + property StyleFlags: Integer read FStyleFlags write FStyleFlags; + property IsFixedWidth: boolean read GetIsFixedWidth write SetIsFixedWidth; + property IsRegular: boolean read GetIsRegular write SetIsRegular; + property IsItalic: boolean read GetIsItalic write SetIsItalic; + property IsBold: boolean read GetIsBold write SetIsBold; + { following properties are used by FontCacheItemFromFontDesc() only } + property Angle: double read FAngle write FAngle; + end; + + + TFontCacheList = class(TObject) + private + FList: TObjectList; + procedure SearchForFont(const AFontPath: TfpgString); + function BuildFontCacheItem(const AFontFile: TfpgString): TFontCacheItem; + procedure SetStyleIfExists(var AText: Ansistring; var AStyleFlags: integer; const AStyleName: AnsiString; const AStyleBit: integer); + protected + function GetCount: integer; virtual; + function GetItem(AIndex: Integer): TFontCacheItem; virtual; + procedure SetItem(AIndex: Integer; AValue: TFontCacheItem); virtual; + public + constructor Create; + destructor Destroy; override; + procedure BuildFontCache; + function Add(const AObject: TFontCacheItem): integer; + procedure Clear; + property Count: integer read GetCount; + function IndexOf(const AObject: TFontCacheItem): integer; + function Find(const AFontCacheItem: TFontCacheItem): integer; + property Items[AIndex: Integer]: TFontCacheItem read GetItem write SetItem; default; + end; + + +function gFontCache: TFontCacheList; + +implementation + +uses + fpg_utils, + agg_font_freetype_lib; + +const + FPG_FONT_STYLE_REGULAR = 1 shl 0; { Regular, Plain, Book } + FPG_FONT_STYLE_ITALIC = 1 shl 1; { Itelic } + FPG_FONT_STYLE_BOLD = 1 shl 2; { Bold } + FPG_FONT_STYLE_CONDENSED = 1 shl 3; { Condensed } + FPG_FONT_STYLE_EXTRALIGHT = 1 shl 4; { ExtraLight } + FPG_FONT_STYLE_LIGHT = 1 shl 5; { Light } + FPG_FONT_STYLE_SEMIBOLD = 1 shl 6; { Semibold } + FPG_FONT_STYLE_MEDIUM = 1 shl 7; { Medium } + FPG_FONT_STYLE_BLACK = 1 shl 8; { Black } + FPG_FONT_STYLE_FIXEDWIDTH = 1 shl 9; { Fixedwidth } + +var + m_library: FT_Library_ptr; + uFontCacheList: TFontCacheList; + +function gFontCache: TFontCacheList; +begin + if not Assigned(uFontCacheList) then + begin + uFontCacheList := TFontCacheList.Create; + uFontCacheList.BuildFontCache; + end; + Result := uFontCacheList; +end; + +{ TFontCacheItem } + +function TFontCacheItem.GetIsBold: boolean; +begin + Result := (FStyleFlags and FPG_FONT_STYLE_BOLD) <> 0; +end; + +function TFontCacheItem.GetIsFixedWidth: boolean; +begin + Result := (FStyleFlags and FPG_FONT_STYLE_FIXEDWIDTH) <> 0; +end; + +function TFontCacheItem.GetIsItalic: boolean; +begin + Result := (FStyleFlags and FPG_FONT_STYLE_ITALIC) <> 0; +end; + +function TFontCacheItem.GetIsRegular: boolean; +begin + Result := (FStyleFlags and FPG_FONT_STYLE_REGULAR) <> 0; +end; + +procedure TFontCacheItem.SetIsBold(AValue: boolean); +begin + FStyleFlags := FStyleFlags or FPG_FONT_STYLE_BOLD; +end; + +procedure TFontCacheItem.SetIsFixedWidth(AValue: boolean); +begin + FStyleFlags := FStyleFlags or FPG_FONT_STYLE_FIXEDWIDTH; + FStyleFlags := FStyleFlags and (not FPG_FONT_STYLE_REGULAR); +end; + +procedure TFontCacheItem.SetIsItalic(AValue: boolean); +begin + FStyleFlags := FStyleFlags or FPG_FONT_STYLE_ITALIC; +end; + +procedure TFontCacheItem.SetIsRegular(AValue: boolean); +begin + FStyleFlags := FStyleFlags or FPG_FONT_STYLE_REGULAR; + FStyleFlags := FStyleFlags and (not FPG_FONT_STYLE_FIXEDWIDTH); +end; + +constructor TFontCacheItem.Create(const AFilename: TfpgString); +begin + inherited Create; + FFileName := AFilename; + FStyleFlags := FPG_FONT_STYLE_REGULAR; + FAngle := 0.0; +end; + +{ TFontCacheList } + +procedure TFontCacheList.SearchForFont(const AFontPath: TfpgString); +var + sr: TSearchRec; + lFont: TFontCacheItem; + s: TfpgString; +begin + // The extra 'or' includes Normal attribute files under Windows. faAnyFile doesn't return those. + // Reported to FPC as bug 9440 in Mantis. + if fpgFindFirst(AFontPath + AllFilesMask, faAnyFile or $00000080, sr) = 0 then + begin + repeat + // check if special files to skip + if (sr.Name = '.') or (sr.Name = '..') or (sr.Name = '') then + Continue; + // We got something, so lets continue + s := fpgFromOSEncoding(sr.Name); + if (sr.Attr and faDirectory) <> 0 then // found a directory + SearchForFont(fpgAppendPathDelim(AFontPath + s)) + else + begin // we have a file + if (lowercase(fpgExtractFileExt(s)) = '.ttf') or + (lowercase(fpgExtractFileExt(s)) = '.otf') then + begin + lFont := BuildFontCacheItem(AFontPath + s); + Add(lFont); + end; + end; + until fpgFindNext(sr) <> 0; + end; +end; + +function TFontCacheList.BuildFontCacheItem(const AFontFile: TfpgString): TFontCacheItem; +var + face_ptr: FT_Face_ptr; + s: Ansistring; + i: integer; + flags: integer; +begin + FT_New_Face(m_library, PChar(AFontFile), 0, face_ptr); + Result := TFontCacheItem.Create(AFontFile); + Result.FamilyName := face_ptr^.family_name; + + // extract simple styles first +// if (face_ptr^.face_flags and FT_FACE_FLAG_FIXED_WIDTH) <> 0 then +// Result.StyleFlags := FPG_FONT_STYLE_FIXEDWIDTH; // this should overwrite Regular style + + if (face_ptr^.style_flags and FT_STYLE_FLAG_ITALIC) <> 0 then + Result.StyleFlags := Result.StyleFlags or FPG_FONT_STYLE_ITALIC; + + if (face_ptr^.style_flags and FT_STYLE_FLAG_BOLD) <> 0 then + Result.StyleFlags := Result.StyleFlags or FPG_FONT_STYLE_BOLD; + + // Now to more complex styles stored in StyleName field. eg: 'Condensed Medium' + s := face_ptr^.style_name; + flags := Result.StyleFlags; + SetStyleIfExists(s, flags, 'Condensed', FPG_FONT_STYLE_CONDENSED); + SetStyleIfExists(s, flags, 'ExtraLight', FPG_FONT_STYLE_EXTRALIGHT); + SetStyleIfExists(s, flags, 'Light', FPG_FONT_STYLE_LIGHT); + SetStyleIfExists(s, flags, 'Semibold', FPG_FONT_STYLE_SEMIBOLD); + SetStyleIfExists(s, flags, 'Medium', FPG_FONT_STYLE_MEDIUM); + SetStyleIfExists(s, flags, 'Black', FPG_FONT_STYLE_BLACK); + Result.StyleFlags := flags; + + FT_Done_Face(face_ptr); +end; + +procedure TFontCacheList.SetStyleIfExists(var AText: Ansistring; var AStyleFlags: integer; + const AStyleName: AnsiString; const AStyleBit: integer); +var + i: integer; +begin + i := Pos(AStyleName, AText); + if i > 0 then + begin + AStyleFlags := AStyleFlags or AStyleBit; + Delete(AText, Length(AStyleName), i); + end; +end; + +function TFontCacheList.GetCount: integer; +begin + Result := FList.Count; +end; + +function TFontCacheList.GetItem(AIndex: Integer): TFontCacheItem; +begin + Result := TFontCacheItem(FList.Items[AIndex]); +end; + +procedure TFontCacheList.SetItem(AIndex: Integer; AValue: TFontCacheItem); +begin + FList.Items[AIndex] := AValue; +end; + +constructor TFontCacheList.Create; +begin + inherited Create; + FList := TObjectList.Create; +end; + +destructor TFontCacheList.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +procedure TFontCacheList.BuildFontCache; +var + lPath: TfpgString; + lPathList: TStringList; + i: integer; +begin + try + m_library := nil; + FT_Init_FreeType(m_library); + + lPathList := TStringList.Create; + lPathList.Add('/usr/share/cups/fonts/'); + lPathList.Add('/usr/share/fonts/truetype/'); + lPathList.Add('/usr/local/lib/X11/fonts/'); + lPathList.Add(GetUserDir + '.fonts/'); + for i := 0 to lPathList.Count-1 do + begin + lPath := lPathList[i]; + SearchForFont(lPath); + end; + finally + FT_Done_FreeType(m_library); + m_library := nil; + lPathList.Free; + end; +end; + +function TFontCacheList.Add(const AObject: TFontCacheItem): integer; +begin + Result := FList.Add(AObject); +end; + +procedure TFontCacheList.Clear; +begin + FList.Clear; +end; + +function TFontCacheList.IndexOf(const AObject: TFontCacheItem): integer; +begin + Result := FList.IndexOf(AObject); +end; + +function TFontCacheList.Find(const AFontCacheItem: TFontCacheItem): integer; +var + i: integer; +begin + Result := -1; // nothing found + for i := 0 to Count-1 do + begin + if (Items[i].FamilyName = AFontCacheItem.FamilyName) and + (Items[i].StyleFlags = AFontCacheItem.StyleFlags) then + begin + Result := i; + exit; + end; + end; +end; + + +initialization + uFontCacheList := nil; + +finalization + uFontCacheList.Free; + +end. + diff --git a/src/corelib/render/software/platform/mac/agg_platform_support.pas b/src/corelib/render/software/platform/mac/agg_platform_support.pas index 608b7854..e9886b64 100644 --- a/src/corelib/render/software/platform/mac/agg_platform_support.pas +++ b/src/corelib/render/software/platform/mac/agg_platform_support.pas @@ -92,10 +92,10 @@ type // Possible formats of the rendering buffer. Initially I thought that it's // reasonable to create the buffer and the rendering functions in // accordance with the native pixel format of the system because it -// would have no overhead for pixel format conersion. +// would have no overhead for pixel format conversion. // But eventually I came to a conclusion that having a possibility to // convert pixel formats on demand is a good idea. First, it was X11 where -// there lots of different formats and visuals and it would be great to +// there are lots of different formats and visuals and it would be great to // render everything in, say, RGB-24 and display it automatically without // any additional efforts. The second reason is to have a possibility to // debug renderers for different pixel formats and colorspaces having only diff --git a/src/corelib/x11/fpg_netlayer_x11.pas b/src/corelib/x11/fpg_netlayer_x11.pas index b328378d..eb9207b0 100644 --- a/src/corelib/x11/fpg_netlayer_x11.pas +++ b/src/corelib/x11/fpg_netlayer_x11.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -415,7 +415,7 @@ begin end; if AValue = nmsBoth then Exit; - // now remove properties we dont want + // now remove properties we don't want Msg.data.l[0] := _NET_WM_STATE_REMOVE; Msg.data.l[1] := 0; @@ -690,6 +690,8 @@ var bytes_after: culong; begin Result := False; + if (AWindow = 0) or (AProperty = 0) then + Exit; XGetWindowProperty (FDisplay, AWindow, AProperty, 0, MaxInt, TBool(False), XA_ATOM, @atomtype, @format, @nitems, @bytes_after, @Atoms); diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas index 20974dfe..569772ae 100644 --- a/src/corelib/x11/fpg_x11.pas +++ b/src/corelib/x11/fpg_x11.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -24,7 +24,7 @@ unit fpg_x11; { TODO : Compiz effects: Menu popup with correct window hint. Same for Combo dropdown window. } { TODO : Under Compiz restoring a window position moves the window down/right the width and height - of the window borders. This as something to do with win_gravity = StaticGravity setting. } + of the window borders. This has something to do with win_gravity = StaticGravity setting. } interface @@ -215,6 +215,7 @@ type public constructor Create(awin: TfpgWindowBase); override; destructor Destroy; override; + procedure CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; var ASrcRect: TfpgRect); override; end; @@ -315,6 +316,7 @@ type xia_wm_delete_window: TAtom; xia_wm_state: TAtom; xia_targets: TAtom; + xia_save_targets: TAtom; netlayer: TNETWindowLayer; InputMethod: PXIM; InputContext: PXIC; @@ -322,6 +324,7 @@ type function DoGetFontFaceList: TStringList; override; procedure DoWaitWindowMessage(atimeoutms: integer); override; function MessagesPending: boolean; override; + function GetHelpViewer: TfpgString; override; public constructor Create(const AParams: string); override; destructor Destroy; override; @@ -340,11 +343,17 @@ type TfpgX11Clipboard = class(TfpgClipboardBase) private FWaitingForSelection: Boolean; + FOwnsSelection: Boolean; + procedure SendClipboardToManager; + procedure DoLostSelection; + procedure DoSetTargets(AWin: TWindow; AProperty: TAtom); protected FClipboardText: TfpgString; function DoGetText: TfpgString; override; procedure DoSetText(const AValue: TfpgString); override; procedure InitClipboard; override; + public + destructor Destroy; override; end; @@ -420,6 +429,7 @@ implementation uses baseunix, + unix, {$IFDEF LINUX} users, { For Linux user and group name support. FPC only supports this in Linux. } {$ENDIF} @@ -430,6 +440,7 @@ uses fpg_utils, fpg_form, // for modal event support fpg_cmdlineparams, + fpg_constants, cursorfont, xatom, // used for XA_WM_NAME keysym, @@ -477,20 +488,27 @@ begin Result := Result or ((rgb and $F80000) shr 8); end; +function ConvertTo555Pixel(rgb: longword): word; +begin + Result := (rgb and $F8) shr 3; + Result := Result or ((rgb and $F800) shr 6); + Result := Result or ((rgb and $F80000) shr 9); +end; + function fpgColorToX(col: TfpgColor): longword; var xc: TXColor; c: TfpgColor; begin c := fpgColorToRGB(col); - if xapplication.DisplayDepth >= 24 then Result := c and $FFFFFF { No Alpha channel information } else if xapplication.DisplayDepth = 16 then Result := ConvertTo565Pixel(c) + else if (xapplication.DisplayDepth = 15) then + Result := ConvertTo555Pixel(c) else begin - c := col; xc.blue := (c and $000000FF) shl 8; xc.green := (c and $0000FF00); xc.red := (c and $00FF0000) shr 8; @@ -665,29 +683,93 @@ begin end; // clipboard event +procedure HandleAtom(var e: TXSelectionEvent; const Atom: TAtom; Prop: TAtom); forward; + + +procedure HandleMultiple(var e: TXSelectionEvent); +type + TAtomPair = record + Target: TAtom; + Prop: TAtom; + end; + +var + Atom: TAtom; + Length: culong; + BytesLeft: culong; + Format: DWord; + Data: Pointer; + xia_Atom_Pair: TAtom; + AtomPair: TAtomPair; + i: Integer; + r: cint; +begin + + xia_Atom_Pair := XInternAtom(xapplication.Display, 'ATOM_PAIR', False); + + // find out how much data there is + r := XGetWindowProperty(xapplication.Display, e.requestor, e._property, 0, 0, False, AnyPropertyType, + @Atom, @Format, @Length, @BytesLeft, @Data); + + if (r <> Success) or (Format <> 32) or (Atom <> xia_Atom_Pair) then + Exit; // ==> + + // read one entry at a time + while BytesLeft > 0 do + begin + // read the data + r := XGetWindowProperty(xapplication.Display, e.requestor, e._property, 0, SizeOf(AtomPair), False, AnyPropertyType, + @Atom, @Format, @Length, @BytesLeft, @Data); + + if r <> Success then + Exit; // ==> + + // copy data to our variable + Move(Data^, AtomPair, SizeOf(TAtomPair)); + XFree(Data); + + // process this target in the list; + HandleAtom(e, AtomPair.Target, AtomPair.Prop); + end; +end; + +procedure HandleAtom(var e: TXSelectionEvent; const Atom: TAtom; Prop: TAtom); +begin + if Atom = None then + begin + Exit; // ==> + end; + + if Atom = xapplication.xia_targets then + begin + fpgClipboard.DoSetTargets(e.requestor, Prop); + end + else if Atom = XInternAtom(xapplication.Display, 'MULTIPLE', False) then + begin + // multiple targets + HandleMultiple(e); + end + else// if Atom = XA_STRING then + begin + XChangeProperty(xapplication.Display, e.requestor, Prop, Atom, + 8, PropModeReplace, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText)); + end; + //else WriteLn('Unhandled Selection atom: ', XGetAtomName(xapplication.Display, Atom)); +end; + procedure ProcessSelectionRequest(var ev: TXEvent); var e: TXSelectionEvent; - a: TAtom; begin e._type := SelectionNotify; + e.display := ev.xselectionrequest.display; e.requestor := ev.xselectionrequest.requestor; e.selection := ev.xselectionrequest.selection; e.target := ev.xselectionrequest.target; e.time := ev.xselectionrequest.time; e._property := ev.xselectionrequest._property; - if e.target = xapplication.xia_targets then - begin - a := XA_STRING; - XChangeProperty(xapplication.Display, e.requestor, e._property, XA_ATOM, - 32, PropModeReplace, PByte(@a), Sizeof(TAtom)); // I think last parameter is right? - end - else - begin - XChangeProperty(xapplication.Display, e.requestor, e._property, e.target, - 8, PropModeReplace, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText)); - end; + HandleAtom(e, e.target, e._property); XSendEvent(xapplication.Display, e.requestor, false, 0, @e ); end; @@ -1396,6 +1478,7 @@ begin // Initialize atoms xia_clipboard := XInternAtom(FDisplay, 'CLIPBOARD', TBool(False)); xia_targets := XInternAtom(FDisplay, 'TARGETS', TBool(False)); + xia_save_targets := XInternAtom(FDisplay, 'SAVE_TARGETS', TBool(False)); xia_motif_wm_hints := XInternAtom(FDisplay, '_MOTIF_WM_HINTS', TBool(False)); xia_wm_protocols := XInternAtom(FDisplay, 'WM_PROTOCOLS', TBool(False)); xia_wm_delete_window := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', TBool(False)); @@ -1433,6 +1516,16 @@ begin fpgCheckTimers; end; +function TfpgX11Application.GetHelpViewer: TfpgString; +begin + Result := inherited GetHelpViewer; + if not fpgFileExists(Result) then + begin + if fpsystem('which ' + FPG_HELPVIEWER) = 0 then + Result := FPG_HELPVIEWER; + end; +end; + function GetParentWindow(wh: TfpgWinHandle; var pw, rw: TfpgWinHandle): boolean; var rootw: TfpgWinHandle; @@ -1749,31 +1842,50 @@ begin if not blockmsg then begin if (ev.xbutton.button >= 4) and (ev.xbutton.button <= 7) then // mouse wheel + // 4=up, 5=down, 6=left, 7=right begin // generate scroll events: if ev._type = X.ButtonPress then begin - if ev.xbutton.button = Button4 then + if (ev.xbutton.button = Button4) or (ev.xbutton.button = 6) then // x.pp lacks Button6, Button7 i := -1 else i := 1; // Check for other mouse wheel messages in the queue - while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do - begin - if NewEvent.xbutton.Button = 4 then - Dec(i) - else if NewEvent.xbutton.Button = 5 then - Inc(i) - else - begin - XPutBackEvent(display, @NewEvent); - break; - end; - end; + if ev.xbutton.button in [Button4,Button5] then + while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do + begin + if NewEvent.xbutton.Button = 4 then + Dec(i) + else if NewEvent.xbutton.Button = 5 then + Inc(i) + else + begin + XPutBackEvent(display, @NewEvent); + break; + end; + end + else // button is 6 or 7 + while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do + begin + if NewEvent.xbutton.Button = 6 then + Dec(i) + else if NewEvent.xbutton.Button = 7 then + Inc(i) + else + begin + XPutBackEvent(display, @NewEvent); + break; + end; + end; msgp.mouse.delta := i; - fpgPostMessage(nil, w, FPGM_SCROLL, msgp); + + if ev.xbutton.button in [Button4,Button5] then + fpgPostMessage(nil, w, FPGM_SCROLL, msgp) + else + fpgPostMessage(nil, w, FPGM_HSCROLL, msgp); end; end else @@ -2026,9 +2138,13 @@ begin X.SelectionClear: begin { TODO : Not sure if I am handling this correctly? } + { We Get this message when another program has declared that + it has ownership of the xia_clipboard selection atom + } if ev.xselectionclear.selection = xia_clipboard then begin fpgClipboard.FClipboardText := ''; + fpgClipboard.DoLostSelection; Exit; end; end; @@ -2281,9 +2397,17 @@ begin if (FWindowType <> wtChild) and (waSizeable in FWindowAttributes) then begin - hints.flags := hints.flags or PMinSize; + hints.flags := hints.flags or PMinSize or PMaxSize; hints.min_width := FMinWidth; hints.min_height := FMinHeight; + if FMaxWidth > 0 then + hints.max_width := FMaxWidth + else + hints.max_width := xapplication.ScreenWidth; + if FMaxHeight > 0 then + hints.max_height := FMaxHeight + else + hints.max_height := xapplication.ScreenHeight; end else begin @@ -2736,6 +2860,13 @@ begin inherited Destroy; end; +procedure TfpgX11Canvas.CopyRect(ADest_x, ADest_y: TfpgCoord; ASrcCanvas: TfpgCanvasBase; + var ASrcRect: TfpgRect); +begin + SortRect(ASrcRect); + XCopyArea(xapplication.Display, TfpgX11Canvas(ASrcCanvas).FDrawHandle, FDrawHandle, Fgc, ASrcRect.Left, ASrcRect.Top, ASrcRect.Width, ASrcRect.Height, ADest_x, ADest_y); +end; + procedure TfpgX11Canvas.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); var x: integer; @@ -2907,7 +3038,8 @@ begin Trunc(64 * a1), Trunc(64 * a2)); end; -procedure TfpgX11Canvas.DoDrawPolygon(Points: fpg_base.PPoint; NumPts: Integer; Winding: boolean); +procedure TfpgX11Canvas.DoDrawPolygon(Points: PPoint; NumPts: Integer; + Winding: boolean); var PointArray: PXPoint; i: integer; @@ -3265,8 +3397,70 @@ end; { TfpgX11Clipboard } +procedure TfpgX11Clipboard.SendClipboardToManager; +var + ClipboardManager: TAtom; + StartTime: DWord; +begin + // if we don't own the clipboard then there is nothing to save + if not FOwnsSelection then + Exit; // ==> + + // check if the manager atom exists + ClipboardManager:= XInternAtom(xapplication.Display, 'CLIPBOARD_MANAGER', False); + if ClipboardManager = None then + Exit; // ==> + + // check if a program has control of the manager atom + if XGetSelectionOwner(xapplication.Display, ClipboardManager) = None then + Exit; // ==> + + // this triggers the manager to request the clipboard contents from us + XConvertSelection(xapplication.Display, + ClipboardManager, + xapplication.xia_save_targets, + None, //XInternAtom(xapplication.Display, 'FPG_CLIPBOARD', True), // 'None' seems to work as the property name + FClipboardWndHandle, + CurrentTime); + + XSync(xapplication.Display, False); + + StartTime := fpgGetTickCount; + // now wait for the manager to get the clipboard + repeat + fpgWaitWindowMessage; + fpgDeliverMessages; + until not FOwnsSelection or ((fpgGetTickCount - StartTime) > 3000); // allow 3 seconds for the clipboard to be read +end; + +procedure TfpgX11Clipboard.DoLostSelection; +begin + FOwnsSelection := False; +end; + +procedure TfpgX11Clipboard.DoSetTargets(AWin: TWindow; AProperty: TAtom); +const + target_count = 3; +var + targets: array[0..target_count-1] of TAtom; +begin + + targets[0] := XA_STRING; + targets[1] := xapplication.xia_targets; + targets[2] := xapplication.xia_save_targets; + //targets[3] := XInternAtom(xapplication.Display, 'UTF8_STRING', True); + //targets[4] := XInternAtom(xapplication.Display, 'MULTIPLE', True); + + // list the types of data we have in the clipboard + XChangeProperty(xapplication.Display, AWin, AProperty, XA_ATOM, 32, + PropModeReplace, @targets[0], target_count); +end; + function TfpgX11Clipboard.DoGetText: TfpgString; begin + if FOwnsSelection then + Exit(FClipboardText); // ==> + XConvertSelection(xapplication.Display, xapplication.xia_clipboard, XA_STRING, xapplication.xia_clipboard, FClipboardWndHandle, 0); @@ -3286,6 +3480,8 @@ begin FClipboardText := AValue; XSetSelectionOwner(xapplication.Display, xapplication.xia_clipboard, FClipboardWndHandle, CurrentTime); + DoSetTargets(FClipboardWndHandle, xapplication.xia_targets); + FOwnsSelection := True; end; procedure TfpgX11Clipboard.InitClipboard; @@ -3295,6 +3491,12 @@ begin xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0); end; +destructor TfpgX11Clipboard.Destroy; +begin + SendClipboardToManager; + inherited Destroy; +end; + { TfpgX11FileList } function TfpgX11FileList.EncodeModeString(FileMode: longword): TFileModeString; diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index c769331e..ec8c841f 100644 --- a/src/corelib/x11/fpgui_toolkit.lpk +++ b/src/corelib/x11/fpgui_toolkit.lpk @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <Package Version="4"> <Name Value="fpgui_toolkit"/> @@ -28,8 +28,8 @@ </CompilerOptions> <Description Value="fpGUI Toolkit"/> <License Value="LGPL 2 with static linking exception."/> - <Version Major="1"/> - <Files Count="99"> + <Version Major="1" Minor="2"/> + <Files Count="107"> <Item1> <Filename Value="../stdimages.inc"/> <Type Value="Include"/> @@ -426,6 +426,38 @@ <Filename Value="../render/software/Agg2D.pas"/> <UnitName Value="Agg2D"/> </Item99> + <Item100> + <Filename Value="../fpg_dbugintf.pas"/> + <UnitName Value="fpg_dbugintf"/> + </Item100> + <Item101> + <Filename Value="../fpg_dbugmsg.pas"/> + <UnitName Value="fpg_dbugmsg"/> + </Item101> + <Item102> + <Filename Value="../render/software/fpg_fontcache.pas"/> + <UnitName Value="fpg_fontcache"/> + </Item102> + <Item103> + <Filename Value="../../gui/fpg_style_carbon.pas"/> + <UnitName Value="fpg_style_carbon"/> + </Item103> + <Item104> + <Filename Value="../../gui/fpg_style_plastic.pas"/> + <UnitName Value="fpg_style_plastic"/> + </Item104> + <Item105> + <Filename Value="../../gui/fpg_style_win8.pas"/> + <UnitName Value="fpg_style_win8"/> + </Item105> + <Item106> + <Filename Value="../../gui/fpg_scrollframe.pas"/> + <UnitName Value="fpg_scrollframe"/> + </Item106> + <Item107> + <Filename Value="../../gui/inputintegerdialog.inc"/> + <Type Value="Include"/> + </Item107> </Files> <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/> <RequiredPkgs Count="1"> diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas index 10dc7f27..86e456f4 100644 --- a/src/corelib/x11/fpgui_toolkit.pas +++ b/src/corelib/x11/fpgui_toolkit.pas @@ -8,19 +8,22 @@ interface uses 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_x11, fpg_netlayer_x11, fpg_keyconv_x11, - fpg_xft_x11, 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_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_x11, + fpg_netlayer_x11, fpg_keyconv_x11, fpg_xft_x11, 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_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_fontcache, fpg_style_carbon, + fpg_style_plastic, fpg_style_win8, fpg_scrollframe; implementation diff --git a/src/extrafpc.cfg b/src/extrafpc.cfg index 24f678b2..d1600da1 100644 --- a/src/extrafpc.cfg +++ b/src/extrafpc.cfg @@ -26,6 +26,8 @@ # For a release compile with optimizes and strip debuginfo #IFDEF RELEASE -Xs + -O2 + -B #WRITE Compiling Release Version #ENDIF @@ -33,6 +35,7 @@ #IFDEF DEBUG -g -Crtoi + -B #WRITE Compiling Debug Version #ENDIF diff --git a/src/gui/fpg_animation.pas b/src/gui/fpg_animation.pas index 36972877..468016f8 100644 --- a/src/gui/fpg_animation.pas +++ b/src/gui/fpg_animation.pas @@ -48,7 +48,7 @@ type protected procedure HandlePaint; override; procedure SetEnabled(const AValue: boolean); override; - procedure SetImageFilename(const AValue: TfpgString); virtual; + procedure SetImageFilename(const AValue: TfpgString); overload; // property Interval: integer read FInterval write SetInterval default 50; property ImageFileName: TfpgString read FImageFilename write SetImageFilename; @@ -58,6 +58,9 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure ImageFromByteArray(ABmp: Pointer; ASize: longword); overload; + procedure ImageFromByteArray(ABmp: Pointer; ASize: longword; AMaskSample: TPoint); overload; + procedure SetImageFilename(const AValue: TfpgString; AMaskSample: TPoint); overload; end; @@ -121,7 +124,7 @@ end; procedure TfpgBaseImgAnim.HandlePaint; begin - if (FImageFilename = '') or (FImage = nil) then + if (FImage = nil) then Exit; //==> Canvas.BeginDraw; Canvas.Clear(clWindowBackground); @@ -138,6 +141,11 @@ end; procedure TfpgBaseImgAnim.SetImageFilename(const AValue: TfpgString); begin + SetImageFilename(AValue, Point(0,0)); +end; + +procedure TfpgBaseImgAnim.SetImageFilename(const AValue: TfpgString; AMaskSample: TPoint); +begin if FImageFilename = AValue then Exit; //==> @@ -154,7 +162,29 @@ begin FImage := LoadImage_BMP(FImageFilename); if FTransparent then begin - FImage.CreateMaskFromSample(0, 0); + FImage.CreateMaskFromSample(AMaskSample.X, AMaskSample.Y); + FImage.UpdateImage; + end; + RecalcImageWidth; + Repaint; +end; + +procedure TfpgBaseImgAnim.ImageFromByteArray(ABmp: Pointer; ASize: longword); +begin + ImageFromByteArray(ABmp, ASize, Point(0,0)); +end; + +procedure TfpgBaseImgAnim.ImageFromByteArray(ABmp: Pointer; ASize: longword; AMaskSample: TPoint); +begin + if ABmp=nil then + Exit; + + FTimer.Enabled := False; + FImage.Free; + FImage := CreateImage_BMP(ABmp, ASize); + if FTransparent then + begin + FImage.CreateMaskFromSample(AMaskSample.X, AMaskSample.Y); FImage.UpdateImage; end; RecalcImageWidth; diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 51b50408..cbce739f 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.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 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -40,6 +40,7 @@ type TfpgGridHeaderStyle = (ghsButton, ghsThin, ghsFlat); TfpgFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: Integer) of object; + TfpgHeaderClick = procedure(Sender: TObject; ACol: Integer) of object; TfpgRowChangeNotify = procedure(Sender: TObject; ARow: Integer) of object; TfpgCanSelectCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; var ACanSelect: boolean) of object; TfpgDrawCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean) of object; @@ -50,12 +51,14 @@ type // Column 2 is special just for testing purposes. Descendant classes will // override that special behavior anyway. + TfpgBaseGrid = class(TfpgWidget) private FColResizing: boolean; FDragPos: integer; // used for column resizing FHeaderStyle: TfpgGridHeaderStyle; FOnDrawCell: TfpgDrawCellEvent; + FOnHeaderClick: TfpgHeaderClick; FResizedCol: integer; // used for column resizing FDefaultColWidth: integer; FDefaultRowHeight: integer; @@ -70,7 +73,6 @@ type FFirstRow: Integer; FFirstCol: Integer; FXOffset: integer; // used for go_SmoothScroll - FMargin: integer; FFont: TfpgFont; FHeaderFont: TfpgFont; FRowSelect: boolean; @@ -88,6 +90,7 @@ type function GetFontDesc: string; function GetHeaderFontDesc: string; function GetTotalColumnWidth: integer; + function GetAdjustedBorderSizes: TRect; procedure HScrollBarMove(Sender: TObject; position: integer); procedure SetFontDesc(const AValue: string); procedure SetHeaderFontDesc(const AValue: string); @@ -103,8 +106,6 @@ type procedure SetShowGrid(const AValue: boolean); procedure SetShowHeader(const AValue: boolean); function VisibleLines: Integer; - function VisibleWidth: integer; - function VisibleHeight: integer; procedure SetFirstRow(const AValue: Integer); procedure SetAlternativeBGColor(const AValue: TfpgColor); procedure SetBorderStyle(AValue: TfpgEditBorderStyle); @@ -132,11 +133,13 @@ type procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure FollowFocus; virtual; + procedure PrepareCells (firstrow, lastrow, firstcol, lastcol : integer); virtual; property AlternateBGColor: TfpgColor read FAlternativeBGColor write SetAlternativeBGColor default clHilite1; property BorderStyle: TfpgEditBorderStyle read FBorderStyle write SetBorderStyle default ebsDefault; property DefaultColWidth: integer read FDefaultColWidth write SetDefaultColWidth default 64; @@ -166,6 +169,7 @@ type property Options: TfpgGridOptions read FOptions write FOptions default []; property OnDrawCell: TfpgDrawCellEvent read FOnDrawCell write FOnDrawCell; property OnFocusChange: TfpgFocusChangeNotify read FOnFocusChange write FOnFocusChange; + property OnHeaderClick: TfpgHeaderClick read FOnHeaderClick write FOnHeaderClick; property OnRowChange: TfpgRowChangeNotify read FOnRowChange write FOnRowChange; property OnCanSelectCell: TfpgCanSelectCellEvent read FOnCanSelectCell write FOnCanSelectCell; public @@ -176,6 +180,9 @@ type procedure BeginUpdate; procedure EndUpdate; procedure MouseToCell(X, Y: Integer; var ACol, ARow: Integer); + function GetClientRect: TfpgRect; override; + function VisibleWidth: integer; + function VisibleHeight: integer; end; @@ -226,6 +233,32 @@ begin Result := Result + ColumnWidth[i]; end; +// Adjust theme borders based on BorderStyle property +function TfpgBaseGrid.GetAdjustedBorderSizes: TRect; +begin + Result := fpgStyle.GetControlFrameBorders; + case BorderStyle of + ebsNone: + begin + Result.Left := 0; + Result.Right := 0; + Result.Top := 0; + Result.Bottom := 0; + end; + ebsDefault: + begin + // do nothing - the theme values are correct + end; + ebsSingle: + begin + Result.Left := 1; + Result.Right := 1; + Result.Top := 1; + Result.Bottom := 1; + end; + end; +end; + procedure TfpgBaseGrid.SetFontDesc(const AValue: string); begin FFont.Free; @@ -528,7 +561,7 @@ begin hh := 0; if ShowHeader then hh := hh + FHeaderHeight+1; - Result := (Height - (2*FMargin) - hh) div FDefaultRowHeight; + Result := (GetClientRect.Height - hh) div FDefaultRowHeight; end; function TfpgBaseGrid.VisibleWidth: integer; @@ -536,10 +569,10 @@ var sw: integer; begin if FVScrollBar.Visible then - sw := FVScrollBar.Width-1 + sw := FVScrollBar.Width else sw := 0; - Result := Width - (FMargin*2) - sw; + Result := GetClientRect.Width - sw end; function TfpgBaseGrid.VisibleHeight: integer; @@ -547,10 +580,10 @@ var sw: integer; begin if FHScrollBar.Visible then - sw := FHScrollBar.Height-1 + sw := FHScrollBar.Height else sw := 0; - Result := Height - (FMargin*2) - sw; + Result := GetClientRect.Height - sw; end; procedure TfpgBaseGrid.SetFirstRow(const AValue: Integer); @@ -585,76 +618,186 @@ var VHeight: integer; vw: integer; cw: integer; + vl: integer; i: integer; x: integer; -begin - VHeight := Height - 4; - HWidth := Width - 4; - - vw := VisibleWidth; - cw := 0; - for i := 0 to ColumnCount-1 do - cw := cw + ColumnWidth[i]; - - // This needs improving while resizing - if cw > vw then - FHScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssVertical]) - else + hmax: integer; + vmax: integer; + Hfits, showH : boolean; + Vfits, showV : boolean; + crect: TfpgRect; + borders: TRect; + + procedure hideScrollbar (sb : TfpgScrollBar); begin - FHScrollBar.Visible := False; - FFirstCol := 0; - FXOffset := 0; + with sb do + if Visible then + begin + Visible := False; + UpdateWindowPosition; + end; end; - // This needs improving while resizing - if (RowCount > VisibleLines) then - FVScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssHorizontal]) - else + procedure getVisWidth; begin - FVScrollBar.Visible := False; - FFirstRow := 0; + if showV then + vw := HWidth - (FVScrollBar.Width-1) + else + vw := HWidth; + Hfits := vw >= cw; end; - if FVScrollBar.Visible then + procedure getVisLines; + var + hh : integer; // header height begin + hh := 0; + if ShowHeader then + inc (hh, FHeaderHeight+1); + if showH then + inc (hh, FHScrollBar.Height); + vl := (VHeight - hh) div FDefaultRowHeight; + Vfits := vl >= RowCount; + end; + +begin + // if we don't want any scrollbars, hide them and exit + if FScrollBarStyle = ssNone then + begin + hideScrollbar(FHScrollBar); + hideScrollbar(FVScrollBar); + exit; + end; + + borders := GetAdjustedBorderSizes; + // preliminary width/height calculations + crect := GetClientRect; + VHeight := crect.Height; + HWidth := crect.Width; + cw := 0; + for i := 0 to ColumnCount-1 do + cw := cw + ColumnWidth[i]; + showV := False; + showH := False; + getVisWidth; + getVisLines; + + // determine whether to show scrollbars for different configurations + case FScrollBarStyle of + ssHorizontal: + begin + hideScrollbar (FVScrollBar); + if not Hfits then + begin + showH := true; + getVisLines; + end; + end; + ssVertical: + begin + hideScrollbar (FHScrollBar); + if not Vfits then + begin + showV := true; + getVisWidth; + end; + end; + ssAutoBoth: + if not Vfits then + begin + showV := true; + getVisWidth; + if not Hfits then + begin + showH := true; + getVisLines; + getVisWidth; + end; + end + else if not Hfits then + begin + showH := true; + getVisLines; + if not Vfits then + begin + showV := true; + getVisWidth; + getVisLines; + end; + end; + end; + + // set the scrollbar width/height space + if showV then Dec(HWidth, FVScrollBar.Width); - FVScrollBar.Min := 0; + if showH then + Dec(VHeight, FHScrollBar.Height); + + // show or hide the scrollbars + + if showV then + begin + FVScrollBar.Visible := true; + FVScrollBar.Min := 0; if RowCount > 0 then FVScrollBar.SliderSize := VisibleLines / RowCount else FVScrollBar.SliderSize := 0; - FVScrollBar.Max := RowCount-VisibleLines; - FVScrollBar.Position := FFirstRow; + vmax := RowCount - VisibleLines; + if FFirstRow > vmax then + FFirstRow := vmax; + FVScrollBar.Max := vmax; + FVScrollBar.Position := FFirstRow; FVScrollBar.RepaintSlider; + FVScrollBar.Top := borders.Top; + FVScrollBar.Left := Width - FVScrollBar.Width - borders.Right; + FVScrollBar.Height := VHeight; + end + else + begin + FVScrollBar.Visible := false; + if Vfits then + FFirstRow := 0; + // if vertical doesn't fit and no scrollbar, do not change firstrow end; - - if FHScrollBar.Visible then + + if showH then begin - Dec(VHeight, FHScrollBar.Height); + FHScrollBar.Visible := true; FHScrollBar.Min := 0; if go_SmoothScroll in FOptions then begin - FHScrollBar.Max := cw - vw; + hmax := cw - vw; + FHScrollBar.Max := hmax; + if FXOffset>hmax then + FXOffset:=hmax; FHScrollBar.Position := FXOffset; - FHScrollBar.SliderSize := Width / TotalColumnWidth; + FHScrollBar.SliderSize := HWidth / TotalColumnWidth; + FHScrollBar.PageSize := 5; end else begin FHScrollBar.Max := ColumnCount-1; FHScrollBar.Position := FFirstCol; - FHScrollBar.SliderSize := 1 / ColumnCount; + FHScrollBar.SliderSize := 1 / ColumnCount; + FHScrollBar.PageSize := 1; end; FHScrollBar.RepaintSlider; + FHScrollBar.Top := Height - FHScrollBar.Height - borders.Bottom; + FHScrollBar.Left := borders.Left; + FHScrollBar.Width := HWidth; + end + else + begin + FHScrollBar.Visible := False; + if Hfits then + begin + FFirstCol := 0; + FXOffset := 0; + end; + // if horizontal doesn't fit and no scrollbar, do not change firstcol/xoffset end; - FHScrollBar.Top := Height -FHScrollBar.Height - 2; - FHScrollBar.Left := 2; - FHScrollBar.Width := HWidth; - - FVScrollBar.Top := 2; - FVScrollBar.Left := Width - FVScrollBar.Width - 2; - FVScrollBar.Height := VHeight; - FVScrollBar.UpdateWindowPosition; FHScrollBar.UpdateWindowPosition; end; @@ -673,10 +816,12 @@ var clipr: TfpgRect; // clip rectangle drawstate: TfpgGridDrawState; cLeft: integer; - c: integer; + rTop: integer; + firstcol, lastcol, firstrow, lastrow : integer; + cWidths: array of integer; + rect: TRect; begin Canvas.ClearClipRect; - r.SetRect(0, 0, Width, Height); case BorderStyle of ebsNone: @@ -685,51 +830,103 @@ begin end; ebsDefault: begin - Canvas.DrawControlFrame(r); - InflateRect(r, -2, -2); + fpgStyle.DrawControlFrame(Canvas, r); end; ebsSingle: begin Canvas.SetColor(clShadow2); Canvas.DrawRectangle(r); - InflateRect(r, -1, -1); end; end; - Canvas.SetClipRect(r); + r := GetClientRect; + clipr := r; + Canvas.SetClipRect(clipr); Canvas.SetColor(FBackgroundColor); Canvas.FillRectangle(r); - clipr.SetRect(FMargin, FMargin, VisibleWidth, VisibleHeight); - r := clipr; + cLeft := r.Left; // column starting point + rTop := r.Top; // row starting point - cLeft := FMargin; // column starting point if go_SmoothScroll in FOptions then begin if FHScrollBar.Visible then Dec(cLeft, FHScrollBar.Position); - c := 0; + firstcol := 0; end else begin - c := FFirstCol; + firstcol := FFirstCol; end; + // calculate column widths, and first/last columns + if (ColumnCount <= 0) then + begin + firstcol := -1; + lastcol := -2; + end + else + begin + setlength (cWidths, ColumnCount); + r.Left := cLeft; + for col := firstcol to ColumnCount-1 do + begin + cWidths[col] := ColumnWidth[col]; + r.Width := cWidths[col]; + if (go_SmoothScroll in FOptions) and (r.Left <= clipr.Left) then + begin + firstcol := col; + if col>0 then inc (cLeft, cWidths[col-1]); + end; + lastcol := col; + if r.Right >= clipr.Right then + break; + inc (r.Left, r.Width); + end; + // first/last rows... + if (RowCount <= 0) then + begin + firstrow := -1; + lastrow := -2; + end + else + begin + if ShowHeader then + inc (r.Top, FHeaderHeight); + if r.Top > clipr.Bottom then + begin + firstrow := -1; + lastrow := -2; + end + else + begin + firstrow := FFirstRow; + lastrow := firstrow + (clipr.Bottom - r.Top) div DefaultRowHeight; + if lastrow >= RowCount then + lastrow := RowCount-1; + end; + end; + end; + + PrepareCells (firstrow, lastrow, firstcol, lastcol); + + r.Left := cLeft; + r.Top := rTop; + if (ColumnCount > 0) and ShowHeader then begin // Drawing horizontal headers - r.Left := cLeft; r.Height := FHeaderHeight; Canvas.SetFont(FHeaderFont); - for col := c to ColumnCount-1 do + for col := firstcol to lastcol do begin - r.Width := ColumnWidth[col]; + r.Width := cWidths[col]; Canvas.SetClipRect(clipr); Canvas.AddClipRect(r); DrawHeader(col, r, 0); inc(r.Left, r.Width); - if r.Left >= clipr.Right then - Break; // small optimization. Don't draw what we can't see + //if r.Left >= clipr.Right then + // Break; // optimization made obsolete by lastcol end; inc(r.Top, r.Height); end; @@ -740,13 +937,13 @@ begin r.Height := DefaultRowHeight; Canvas.SetFont(FFont); - for row := FFirstRow to RowCount-1 do + for row := firstrow to lastrow do begin r.Left := cLeft; - for col := c to ColumnCount-1 do + for col := firstcol to lastcol do begin drawstate := []; - r.Width := ColumnWidth[col]; + r.Width := cWidths[col]; Canvas.SetClipRect(clipr); if (row = FFocusRow) and (RowSelect or (col = FFocusCol)) and not (go_HideFocusRect in FOptions) then @@ -774,7 +971,6 @@ begin Include(drawstate, gdFocused); if (row = FFocusRow) and (col = FFocusCol) then Include(drawstate, gdSelected); - if DoDrawCellEvent(row, col, r, drawstate) then DrawCell(row, col, r, drawstate); @@ -783,13 +979,13 @@ begin DrawGrid(row, col, r, 0); inc(r.Left, r.Width); - if r.Left >= clipr.Right then - Break; // small optimization. Don't draw what we can't see + //if r.Left >= clipr.Right then + // Break; // optimization made obsolete by lastcol end; // Inc(r.Top, FDefaultRowHeight+1); inc(r.Top, r.Height); - if r.Top >= clipr.Bottom then - break; + //if r.Top >= clipr.Bottom then + // break; // optimization made obsolete by lastrow end; end; // item drawing @@ -1008,49 +1204,66 @@ end; procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var lRow: Integer; - lCol: Integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); lRow := FFirstRow; - lCol := FFirstCol; - if delta > 0 then // scroll down - inc(FFirstRow, abs(delta)*3) - else // scroll up - if FFirstRow > 0 then - dec(FFirstRow, abs(delta)*3); + // If vertical scrollbar is not visible, but + // horizontal is, Mouse wheel will scroll horizontally. :) + if FHScrollBar.Visible and (not FVScrollBar.Visible) then + begin + HandleMouseHorizScroll(x, y, shiftstate, delta); + Exit; + end; + + inc(FFirstRow, delta*3); // apply limits if FFirstRow > RowCount - VisibleLines then FFirstRow := RowCount - VisibleLines; if FFirstRow < 0 then FFirstRow := 0; - - // scroll left/right - // If vertical scrollbar is not visible, but - // horizontal is. Mouse wheel will scroll horizontally. :) - if FHScrollBar.Visible and (not FVScrollBar.Visible) then - begin - if delta > 0 then // scroll right - begin - if FFirstCol < (ColumnCount-1) then - inc(FFirstCol); - end - else - begin - if FFirstCol > 0 then - dec(FFirstCol); - end; - end; - if (lRow <> FFirstRow) or (lCol <> FFirstCol) then + if lRow <> FFirstRow then begin UpdateScrollBars; RePaint; end; end; +procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +var + old_val: Integer; +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + + if go_SmoothScroll in Options then + begin + old_val := FXOffset; + inc(FXOffset, delta*FHScrollBar.ScrollStep); + if (FXOffset<0) then + FXOffset:=0; + // finding the maximum Xoffset is tricky, let updatescrollbars do it. + if (FXOffset=old_val) then + Exit; + end + else + begin + old_val := FFirstCol; + inc(FFirstCol, delta); + if FFirstCol<0 then + FFirstCol:=0 + else if FFirstCol > ColumnCount-1 then + FFirstCol:=ColumnCount-1; + if FFirstCol=old_val then + Exit; + end; + + UpdateScrollBars; + RePaint; +end; + procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); var hh: integer; @@ -1059,6 +1272,7 @@ var colresize: boolean; cLeft: integer; c: integer; + borders: TRect; begin inherited HandleMouseMove(x, y, btnstate, shiftstate); @@ -1082,8 +1296,9 @@ begin begin colresize := False; hh := FHeaderHeight; + borders := GetAdjustedBorderSizes; - cLeft := FMargin; // column starting point + cLeft := borders.Left; // column starting point if go_SmoothScroll in FOptions then begin if FHScrollBar.Visible then @@ -1095,7 +1310,7 @@ begin c := FFirstCol; end; - if (y <= FMargin + hh) then // we are over the Header row + if (y <= (borders.Top + hh)) then // we are over the Header row begin cw := 0; for n := c to ColumnCount-1 do @@ -1120,12 +1335,62 @@ begin end; procedure TfpgBaseGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +var + lColumn: integer; + hh: integer; { header height } + cLeft: integer; { column left } + c: integer; + n: integer; + cw: integer; + borders: TRect; begin inherited HandleLMouseUp(x, y, shiftstate); + if not FColResizing then + begin + if not ShowHeader then + Exit; + if (ColumnCount = 0) then + Exit; //==> + // searching for the appropriate character position + hh := FHeaderHeight; + borders := GetAdjustedBorderSizes; + + if (y < (borders.Top+hh)) then // inside Header row + begin + {$IFDEF DEBUG} Writeln('header click...'); {$ENDIF} + + cLeft := borders.Left; // column starting point + if go_SmoothScroll in FOptions then + begin + if FHScrollBar.Visible then + Dec(cLeft, FHScrollBar.Position); + c := 0; + end + else + begin + c := FFirstCol; + end; + + cw := 0; + for n := c to ColumnCount-1 do + begin + inc(cw, ColumnWidth[n]); + if x < (cLeft+cw+4) then + begin + if Assigned(FOnHeaderClick) then + FOnHeaderClick(self, n); + Break; + end; + end; { for } + end; + end; {if not FColResizing } + {$IFDEF DEBUG} if FColResizing then + begin Writeln('Column ', FResizedCol,' width = ', ColumnWidth[FResizedCol]); + end; {$ENDIF} FColResizing := False; @@ -1142,6 +1407,7 @@ var pcol: Integer; c: integer; cLeft: integer; + borders: TRect; begin inherited HandleLMouseDown(x, y, shiftstate); @@ -1150,18 +1416,19 @@ begin pcol := FFocusCol; prow := FFocusRow; + borders := GetAdjustedBorderSizes; // searching for the appropriate character position if ShowHeader then - hh := FHeaderHeight+1 + hh := FHeaderHeight else hh := 0; - if ShowHeader and (y <= FMargin+hh) then // inside Header row + if ShowHeader and (y < (borders.Top+hh)) then // inside Header row begin {$IFDEF DEBUG} Writeln('header click...'); {$ENDIF} - cLeft := FMargin; // column starting point + cLeft := borders.Left; // column starting point if go_SmoothScroll in FOptions then begin if FHScrollBar.Visible then @@ -1226,7 +1493,7 @@ begin else hh := 0; - if ShowHeader and (y > FMargin+hh) then // not in Header row + if ShowHeader and (y > (fpgStyle.GetControlFrameBorders.Top + hh)) then // not in Header row begin PopupMenu.ShowAt(self, x, y); end; @@ -1268,7 +1535,7 @@ begin w := 0; for n := FFocusCol downto FFirstCol do begin - w := w + ColumnWidth[n]+1; + w := w + ColumnWidth[n]; if w > VisibleWidth then begin if n = FFocusCol then @@ -1283,7 +1550,14 @@ begin UpdateScrollBars; end; +procedure TfpgBaseGrid.PrepareCells(firstrow, lastrow, firstcol, lastcol: integer); +begin + // for descendents +end; + constructor TfpgBaseGrid.Create(AOwner: TComponent); +var + borders: TRect; begin Updating; inherited Create(AOwner); @@ -1296,7 +1570,6 @@ begin FPrevRow := -1; FFirstRow := 0; FFirstCol := 0; - FMargin := 2; FShowHeader := True; FShowGrid := True; FRowSelect := False; @@ -1306,6 +1579,8 @@ begin FHeaderStyle := ghsButton; FBorderStyle := ebsDefault; + borders := GetAdjustedBorderSizes; + FFont := fpgGetFont('#Grid'); FHeaderFont := fpgGetFont('#GridHeader'); @@ -1317,8 +1592,8 @@ begin FAlternativeBGColor := clHilite1; FColResizing := False; - MinHeight := HeaderHeight + DefaultRowHeight + FMargin; - MinWidth := DefaultColWidth + FMargin; + MinHeight := HeaderHeight + DefaultRowHeight + borders.Top + borders.Bottom; + MinWidth := DefaultColWidth + borders.Left + borders.Right; FVScrollBar := TfpgScrollBar.Create(self); FVScrollBar.Orientation := orVertical; @@ -1329,7 +1604,7 @@ begin FHScrollBar.Orientation := orHorizontal; FHScrollBar.Visible := False; FHScrollBar.OnScroll := @HScrollBarMove; - FHScrollBar.ScrollStep := 5; + FHScrollBar.ScrollStep := 20; end; destructor TfpgBaseGrid.Destroy; @@ -1388,11 +1663,11 @@ begin else hh := 0; - ARow := FFirstRow + ((y - FMargin - hh) div FDefaultRowHeight); + ARow := FFirstRow + ((y - fpgStyle.GetControlFrameBorders.Top - hh) div FDefaultRowHeight); if ARow > RowCount-1 then ARow := RowCount-1; - cLeft := FMargin; // column starting point + cLeft := fpgStyle.GetControlFrameBorders.Left; // column starting point if go_SmoothScroll in FOptions then begin if FHScrollBar.Visible then @@ -1416,6 +1691,19 @@ begin end; end; +function TfpgBaseGrid.GetClientRect: TfpgRect; +var + rect: TRect; +begin + Result := inherited GetClientRect; + rect := fpgStyle.GetControlFrameBorders; + case BorderStyle of +// ebsNone: // nothing to do + ebsDefault: InflateRect(Result, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } + ebsSingle: InflateRect(Result, -1, -1); + end; +end; + end. diff --git a/src/gui/fpg_button.pas b/src/gui/fpg_button.pas index 3bc026de..0cbb1397 100644 --- a/src/gui/fpg_button.pas +++ b/src/gui/fpg_button.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -171,6 +171,9 @@ type property OnDragLeave; property OnDragDrop; property OnDragStartDetected; + property OnEnter; + property OnExit; + property OnKeyPress; property OnMouseDown; property OnMouseExit; property OnMouseEnter; @@ -543,6 +546,9 @@ begin if FEmbedded then Include(lBtnFlags, btfIsEmbedded); + if not Enabled then + Include(lBtnFlags, btfDisabled); + // In the UI Designer we want the button more visible if not (csDesigning in ComponentState) then begin diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas index 886f69ca..2b4b11d8 100644 --- a/src/gui/fpg_checkbox.pas +++ b/src/gui/fpg_checkbox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -210,8 +210,7 @@ begin ix := (2 + (Ord(FChecked) * 2)) - Ord(FChecked); // paint the check (in this case a X) - img := fpgImages.GetImage('sys.checkboxes'); // Do NOT localize - Canvas.DrawImagePart(r.Left, r.Top, img, ix*FBoxSize, 0, FBoxSize, FBoxSize); + fpgStyle.DrawCheckbox(Canvas, r.Left, r.Top, ix*FBoxSize, 0); r := GetClientRect; { max focus rectangle and text boundry } @@ -291,7 +290,7 @@ begin FTextColor := Parent.TextColor; FBackgroundColor := Parent.BackgroundColor; FFocusable := True; - FBoxSize := 13; + FBoxSize := fpgStyle.GetCheckBoxSize; FImgTextSpacing := 6; FChecked := False; FIsPressed := False; diff --git a/src/gui/fpg_colorwheel.pas b/src/gui/fpg_colorwheel.pas index a6b3795b..e699aebc 100644 --- a/src/gui/fpg_colorwheel.pas +++ b/src/gui/fpg_colorwheel.pas @@ -554,7 +554,7 @@ begin Canvas.FillRectangle(r); Canvas.Color := clBlack; - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); end; procedure TfpgValueBar.SetMarginWidth(NewWidth: longint); diff --git a/src/gui/fpg_combobox.pas b/src/gui/fpg_combobox.pas index 8c10f195..bb26ada6 100644 --- a/src/gui/fpg_combobox.pas +++ b/src/gui/fpg_combobox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -100,7 +100,6 @@ type procedure DoOnDropDown; virtual; procedure DoDropDown; virtual; abstract; procedure DoOnCloseUp; virtual; - procedure PaintInternalButton; virtual; function GetDropDownPos(AParent, AComboBox, ADropDown: TfpgWidget): TfpgRect; virtual; property AutoSize: Boolean read FAutoSize write SetAutoSize default False; property DropDownCount: integer read FDropDownCount write SetDropDownCount default 8; @@ -182,14 +181,16 @@ type function CreateComboBox(AOwner: TComponent; x, y, w: TfpgCoord; AList: TStringList; - h: TfpgCoord = 0): TfpgComboBox; + h: TfpgCoord = 24): TfpgComboBox; implementation uses fpg_listbox, - dbugintf, + {$IFDEF DEBUG} + fpg_dbugintf, + {$ENDIF} math; @@ -385,42 +386,6 @@ begin OnCloseUp(self); end; -procedure TfpgBaseComboBox.PaintInternalButton; -var - ar: TfpgRect; - btnflags: TfpgButtonFlags; -begin - Canvas.BeginDraw; - btnflags := []; - ar := FInternalBtnRect; - - { The bounding rectangle for the arrow } - ar.Width := 8; - ar.Height := 6; - ar.Left := FInternalBtnRect.Left + ((FInternalBtnRect.Width-ar.Width) div 2); - ar.Top := FInternalBtnRect.Top + ((FInternalBtnRect.Height-ar.Height) div 2); - - if FBtnPressed then - begin - Include(btnflags, btfIsPressed); - OffsetRect(ar, 1, 1); - end; - // paint button face - fpgStyle.DrawButtonFace(Canvas, - FInternalBtnRect.Left, - FInternalBtnRect.Top, - FInternalBtnRect.Width, - FInternalBtnRect.Height, btnflags); - if Enabled then - Canvas.SetColor(clText1) - else - Canvas.SetColor(clShadow1); - - // paint arrow - fpgStyle.DrawDirectionArrow(Canvas, ar.Left, ar.Top, ar.Width, ar.Height, adDown); - Canvas.EndDraw(FInternalBtnRect); -end; - function TfpgBaseComboBox.GetDropDownPos(AParent, AComboBox, ADropDown: TfpgWidget): TfpgRect; var pt: TPoint; @@ -535,7 +500,9 @@ end; function CreateComboBox(AOwner: TComponent; x, y, w: TfpgCoord; AList: TStringList; - h: TfpgCoord = 0): TfpgComboBox; + h: TfpgCoord): TfpgComboBox; +var + lh: integer; begin Result := TfpgComboBox.Create(AOwner); Result.Left := x; @@ -543,8 +510,9 @@ begin Result.Width := w; Result.Focusable := True; - if h < TfpgComboBox(Result).FFont.Height + (Result.FMargin * 2) then - Result.Height := TfpgComboBox(Result).FFont.Height + (Result.FMargin * 2) + lh := TfpgComboBox(Result).FFont.Height + (Result.FMargin * 2); + if h < lh then + Result.Height := lh else Result.Height := h; @@ -683,7 +651,7 @@ begin inherited HandleLMouseDown(x, y, shiftstate); // button state is down only if user clicked in the button rectangle. FBtnPressed := PtInRect(FInternalBtnRect, Point(x, y)); - PaintInternalButton; + Repaint; DoDropDown; end; @@ -691,7 +659,7 @@ procedure TfpgBaseStaticCombo.HandleLMouseUp(x, y: integer; shiftstate: TShiftSt begin inherited HandleLMouseUp(x, y, shiftstate); FBtnPressed := False; - PaintInternalButton; + Repaint; end; procedure TfpgBaseStaticCombo.HandleMouseScroll(x, y: integer; @@ -722,47 +690,25 @@ end; procedure TfpgBaseStaticCombo.HandlePaint; var r: TfpgRect; + rect: TRect; begin // inherited HandlePaint; Canvas.ClearClipRect; r.SetRect(0, 0, Width, Height); - Canvas.DrawControlFrame(r); - - // internal background rectangle (without frame) - InflateRect(r, -2, -2); + fpgStyle.DrawControlFrame(Canvas, r); + rect := fpgStyle.GetControlFrameBorders; + InflateRect(r, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } Canvas.SetClipRect(r); - if Enabled then - begin - if ReadOnly then - Canvas.SetColor(clWindowBackground) - else - Canvas.SetColor(FBackgroundColor); - end - else - Canvas.SetColor(clWindowBackground); - - Canvas.FillRectangle(r); - - // paint the fake dropdown button - PaintInternalButton; + fpgStyle.DrawStaticComboBox(Canvas, r, Enabled, Focused, ReadOnly, FBackgroundColor, FInternalBtnRect, FBtnPressed); - Dec(r.Width, FInternalBtnRect.Width); - Canvas.SetClipRect(r); +// Dec(r.Width, FInternalBtnRect.Width); +// Canvas.SetClipRect(r); Canvas.SetFont(Font); - if Focused then - begin - Canvas.SetColor(clSelection); - Canvas.SetTextColor(clSelectionText); - InflateRect(r, -1, -1); - Canvas.FillRectangle(r); - end + Canvas.SetTextColor(clSelectionText) else - begin Canvas.SetTextColor(FTextColor); - end; - { adjust rectangle size smaller for text } r.Left := r.Left + Margin; r.Width := r.Width - (Margin*2); diff --git a/src/gui/fpg_customgrid.pas b/src/gui/fpg_customgrid.pas index 83d35aa7..98040374 100644 --- a/src/gui/fpg_customgrid.pas +++ b/src/gui/fpg_customgrid.pas @@ -65,6 +65,7 @@ type FColumns: TFPList; procedure HandleSetFocus; override; procedure SetTextColor(const AValue: TfpgColor); override; + procedure SetBackgroundColor(const AValue: TfpgColor); override; function GetColumns(AIndex: integer): TfpgGridColumn; virtual; procedure DoDeleteColumn(ACol: integer); virtual; procedure DoSetRowCount(AValue: integer); virtual; @@ -140,6 +141,18 @@ begin Update; end; +procedure TfpgCustomGrid.SetBackgroundColor(const AValue: TfpgColor); +var + i: integer; +begin + inherited SetBackgroundColor(AValue); + for i := 0 to ColumnCount-1 do + begin + TfpgGridColumn(FColumns.Items[i]).BackgroundColor := AValue; + end; + RePaint; +end; + function TfpgCustomGrid.GetColumns(AIndex: integer): TfpgGridColumn; begin if (AIndex < 0) or (AIndex > FColumns.Count-1) then diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas index 8f3639e6..781c0745 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 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -58,10 +58,10 @@ uses type TfpgMsgDlgType = (mtAbout, mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); - + TfpgMsgDlgBtn = (mbNoButton, mbOK, mbCancel, mbYes, mbNo, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp, mbClose); - + TfpgMsgDlgButtons = set of TfpgMsgDlgBtn; const @@ -104,7 +104,7 @@ type property CentreText: Boolean read FCentreText write FCentreText default False; property FontDesc: string read GetFontDesc write SetFontDesc; end; - + TfpgBaseDialog = class(TfpgForm) protected @@ -152,8 +152,8 @@ type constructor Create(AOwner: TComponent); override; procedure SetSampleText(AText: string); end; - - + + TfpgFileDialog = class(TfpgBaseDialog) private chlDir: TfpgComboBox; @@ -227,6 +227,7 @@ type {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I inputintegerdialog.inc} {$I managebookmarksdialog.inc} @@ -240,6 +241,7 @@ function SelectDirDialog(const AStartDir: TfpgString = ''): TfpgString; function fpgShowCharMap: TfpgString; function fpgSelectColorDialog(APresetColor: TfpgColor = clBlack): TfpgColor; function fpgInputQuery(const ACaption, APrompt: TfpgString; var Value: TfpgString): Boolean; +function fpgIntegerQuery(const ACaption, APrompt: TfpgString; var Value: Integer; const MaxValue: Integer; const MinValue: Integer = 0): Boolean; implementation @@ -253,8 +255,8 @@ uses {$ENDIF} ,DateUtils ; - - + + procedure WrapText(const AText: String; ALines: TStrings; AFont: TfpgFont; const ALineWidth: Integer; out AWidth: Integer); var @@ -396,7 +398,7 @@ begin dres := dlg.RunOpenFile else dres := dlg.RunSaveFile; - + if dres then Result := dlg.FileName else @@ -532,7 +534,7 @@ var outw: integer; begin WrapText(AMessage, FLines, FFont, FMaxLineWidth, outw); - + // dialog width with 10 pixel border on both sides Width := outw + 2*10; @@ -744,7 +746,7 @@ var NextC; end; end; - + procedure ProcessAliasFont; var i: integer; @@ -785,7 +787,7 @@ begin NextToken; lbFaces.FocusItem := lbFaces.Items.IndexOf(token); - + if c = '-' then begin NextC; @@ -846,7 +848,7 @@ begin MinHeight := Height; FSampleText := 'The quick brown fox jumps over the lazy dog. 0123456789 [oO0,ilLI]'; FMode := 1; // normal fonts - + btnCancel.Left := Width - FDefaultButtonWidth - FSpacing; btnOK.Left := btnCancel.Left - FDefaultButtonWidth - FSpacing; @@ -1000,7 +1002,7 @@ begin Exit; //==> if AText = '' then Exit; //==> - + FSampleText := AText; memSample.Text := FSampleText; end; @@ -1171,7 +1173,7 @@ begin end; { Create lower Panel details } - + pnlFileInfo := TfpgPanel.Create(self); with pnlFileInfo do begin @@ -1194,7 +1196,7 @@ begin OnChange := @edFilenameChanged; OnKeyPress := @edFilenameKeyPressed; end; - + { Filter section } chlFilter := TfpgComboBox.Create(self); @@ -1398,7 +1400,7 @@ begin ExcludeTrailingPathDelimiter(grid.FileList.DirectoryName)) else fsel := ''; - + grid.FileList.FileMask := GetFileFilter; grid.FileList.ShowHidden := ShowHidden; @@ -1407,7 +1409,7 @@ begin ShowMessage(Format(rsErrCouldNotOpenDir, [ADir]), rsError); Exit; //==> end; - + grid.FileList.Sort(soFileName); // we don't want chlDir to call DirChange while populating items @@ -1420,7 +1422,7 @@ begin HighlightFile(fsel) else grid.FocusRow := 0; - + grid.Update; grid.SetFocus; @@ -1583,7 +1585,7 @@ begin if not HighlightFile(fname) then edFilename.Text := fname; - + WindowTitle := rsOpenAFile; btnOK.ImageName := 'stdimg.open'; // Do NOT localize btnOK.Text := rsOpen; @@ -1632,6 +1634,7 @@ end; {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I inputintegerdialog.inc} {$I managebookmarksdialog.inc} diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index f164ef76..0ed17bfd 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 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -187,6 +187,7 @@ type property OnDragStartDetected; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; property OnMouseEnter; property OnMouseExit; @@ -279,6 +280,7 @@ type property OnChange; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; property OnMouseEnter; property OnMouseExit; @@ -328,6 +330,7 @@ type property OnChange; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; property OnMouseEnter; property OnMouseExit; @@ -375,6 +378,7 @@ type property OnChange; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; property OnMouseEnter; property OnMouseExit; @@ -725,7 +729,7 @@ begin end; ebsDefault: begin - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); rect := fpgStyle.GetControlFrameBorders; InflateRect(r, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } end; @@ -754,10 +758,14 @@ var s: TfpgChar; prevval: string; begin + inherited HandleKeyChar(AText, shiftstate, consumed); + if consumed then + Exit; //==> + prevval := Text; s := AText; - if (not consumed) and (not ReadOnly) then + if (not ReadOnly) then begin // Handle only printable characters // UTF-8 characters beyond ANSI range are supposed to be printable @@ -780,8 +788,6 @@ begin if consumed then RePaint; - - inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgBaseEdit.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); @@ -1110,21 +1116,24 @@ begin end; procedure TfpgBaseEdit.SetFontDesc(const AValue: string); +var + rect: TRect; begin FFont.Free; FFont := fpgGetFont(AValue); if AutoSize then begin + rect := fpgStyle.GetControlFrameBorders; case BorderStyle of ebsNone: if Height < FFont.Height + (FHeightMargin * 2) then - Height:= FFont.Height + (FHeightMargin * 2); + Height := FFont.Height + (FHeightMargin * 2); ebsDefault: - if Height < FFont.Height + 4 + (FHeightMargin * 2) then - Height:= FFont.Height + 4 + (FHeightMargin * 2); + if Height < FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2) then + Height := FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2); ebsSingle: - if Height < FFont.Height + 2 + (FHeightMargin * 2) then - Height:= FFont.Height + 2 + (FHeightMargin * 2); + if Height < FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2) then + Height := FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2); end; end; Adjust; @@ -1173,18 +1182,24 @@ begin end; procedure TfpgBaseEdit.SetHeightMargin(const AValue: integer); +var + rect: TRect; begin if (FHeightMargin = AValue) or (AValue <= 0) then Exit; //=> FHeightMargin := AValue; - case BorderStyle of - ebsNone: - Height:= FFont.Height + (FHeightMargin * 2); - ebsDefault: - Height:= FFont.Height + 4 + (FHeightMargin * 2); - ebsSingle: - Height:= FFont.Height + 2 + (FHeightMargin * 2); + if AutoSize then + begin + rect := fpgStyle.GetControlFrameBorders; + case BorderStyle of + ebsNone: + Height := FFont.Height + (FHeightMargin * 2); + ebsDefault: + Height := FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2); + ebsSingle: + Height := FFont.Height + rect.Top + rect.Bottom + (FHeightMargin * 2); end; + end; Repaint; end; @@ -1420,11 +1435,15 @@ begin end; function TfpgBaseEdit.GetClientRect: TfpgRect; +var + rect: TRect; begin + Result := inherited GetClientRect; + rect := fpgStyle.GetControlFrameBorders; case BorderStyle of - ebsNone: Result := inherited GetClientRect; - ebsDefault: Result.SetRect(2, 2, Width-4, Height-4); - ebsSingle: Result.SetRect(1, 1, Width-2, Height-2); +// ebsNone: // nothing to do + ebsDefault: InflateRect(Result, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } + ebsSingle: InflateRect(Result, -1, -1); end; end; @@ -1866,6 +1885,7 @@ begin FAlignment := taRightJustify; FDecimalSeparator := DecimalSeparator; FThousandSeparator := ThousandSeparator; + FShowThousand := True; FNegativeColor := clRed; FOldColor := TextColor; FMaxLimit := False; @@ -1992,8 +2012,10 @@ begin if ((n >= 48) and (n <= 57) or (AText = '-') and (UTF8Pos(AText, Text) <= 0)) then consumed := False else - consumed := True; + Exit; //==> + inherited HandleKeyChar(AText, shiftstate, consumed); + if FMaxLimit then if GetValue > FMaxValue then SetValue(FMaxValue); @@ -2042,7 +2064,6 @@ end; constructor TfpgEditInteger.Create(AOwner: TComponent); begin inherited Create(AOwner); - FShowThousand := True; FDecimals := 0; end; @@ -2216,8 +2237,10 @@ begin or ((AText = FDecimalSeparator) and (UTF8Pos(AText, Text) <= 0)) then consumed := False else - consumed := True; + Exit; //==> + inherited HandleKeyChar(AText, shiftstate, consumed); + if FMaxLimit then if GetValue > FMaxValue then SetValue(FMaxValue); @@ -2284,7 +2307,6 @@ begin inherited Create(AOwner); FDecimals := -1; FFixedDecimals := -1; - FShowThousand := True; end; { TfpgEditCurrency } @@ -2437,8 +2459,10 @@ begin or ((AText = FDecimalSeparator) and (UTF8Pos(AText, Text) <= 0)) then consumed := False else - consumed := True; + Exit; //==> + inherited HandleKeyChar(AText, shiftstate, consumed); + if FMaxLimit then if GetValue > FMaxValue then SetValue(FMaxValue); @@ -2488,7 +2512,6 @@ constructor TfpgEditCurrency.Create(AOwner: TComponent); begin inherited Create(AOwner); FDecimals := 2; - FShowThousand := True; end; diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 3887cd13..5b011b4d 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.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 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -128,15 +128,24 @@ type property Hint; property Items; property Margin; + property ReadOnly; property Text; property TextColor; property Width; property OnChange; property OnCloseUp; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; property OnDropDown; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; + property OnMouseEnter; + property OnMouseExit; + property OnPaint; property OnShowHint; end; @@ -522,6 +531,9 @@ var prevval: string; i: integer; begin + inherited HandleKeyChar(AText, shiftstate, consumed); + if Consumed then + Exit; //==> prevval := FText; s := AText; consumed := False; @@ -529,7 +541,7 @@ begin FNewItem := False; // Handle only printable characters - // Note: This is now UTF-8 compliant! + // Note: This is not UTF-8 compliant! if Enabled and (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then begin if (FMaxLength <= 0) or (UTF8Length(FText) < FMaxLength) then @@ -572,8 +584,6 @@ begin if consumed then RePaint; -// else - inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgBaseEditCombo.HandleKeyPress(var keycode: word; @@ -687,12 +697,12 @@ begin FBtnPressed := PtInRect(FInternalBtnRect, Point(x, y)); if not FAutoCompletion then begin - PaintInternalButton; + Repaint; DoDropDown; end else if FBtnPressed then begin - PaintInternalButton; + Repaint; DoDropDown; end; end; @@ -702,7 +712,7 @@ procedure TfpgBaseEditCombo.HandleLMouseUp(x, y: integer; begin inherited HandleLMouseUp(x, y, shiftstate); FBtnPressed := False; - PaintInternalButton; + Repaint; end; procedure TfpgBaseEditCombo.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); @@ -717,6 +727,7 @@ end; procedure TfpgBaseEditCombo.HandlePaint; var r: TfpgRect; + rect: TRect; tw, tw2, st, len: integer; Texte: string; @@ -761,25 +772,28 @@ var end; begin - Canvas.BeginDraw; // inherited HandlePaint; Canvas.ClearClipRect; r.SetRect(0, 0, Width, Height); - Canvas.DrawControlFrame(r); - - // internal background rectangle (without frame) - InflateRect(r, -2, -2); + fpgStyle.DrawControlFrame(Canvas, r); + rect := fpgStyle.GetControlFrameBorders; + InflateRect(r, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } Canvas.SetClipRect(r); if Enabled then - Canvas.SetColor(FBackgroundColor) + begin + if ReadOnly then + Canvas.SetColor(clWindowBackground) + else + Canvas.SetColor(FBackgroundColor); + end else Canvas.SetColor(clWindowBackground); Canvas.FillRectangle(r); // paint the fake dropdown button - PaintInternalButton; + fpgStyle.DrawInternalComboBoxButton(Canvas, FInternalBtnRect, Enabled, FBtnPressed); Dec(r.Width, FInternalBtnRect.Width); Canvas.SetClipRect(r); @@ -860,8 +874,6 @@ begin else fpgCaret.UnSetCaret(Canvas); end; - - Canvas.EndDraw; end; constructor TfpgBaseEditCombo.Create(AOwner: TComponent); diff --git a/src/gui/fpg_grid.pas b/src/gui/fpg_grid.pas index b7800b55..3f8b52fb 100644 --- a/src/gui/fpg_grid.pas +++ b/src/gui/fpg_grid.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -68,8 +68,17 @@ type property ScrollBarStyle; property TabOrder; property TopRow; - property OnRowChange; + property OnClick; property OnDoubleClick; + property OnEnter; + property OnExit; + property OnKeyPress; + property OnMouseDown; + property OnMouseEnter; + property OnMouseExit; + property OnMouseMove; + property OnMouseUp; + property OnRowChange; property OnShowHint; end; @@ -106,8 +115,7 @@ type property Columns[AIndex: Integer]: TfpgStringColumn read GetColumns; public constructor Create(AOwner: TComponent); override; - function AddColumn(ATitle: string; AWidth: integer; AAlignment: TAlignment = taLeftJustify; - AbackgroundColor: TfpgColor = clDefault; ATextColor: TfpgColor = clDefault): TfpgStringColumn; overload; + function AddColumn(ATitle: string; AWidth: integer; AAlignment: TAlignment = taLeftJustify; AbackgroundColor: TfpgColor = clDefault; ATextColor: TfpgColor = clDefault): TfpgStringColumn; overload; procedure DeleteRow(AIndex: integer); override; property Cells[ACol, ARow: Integer]: string read GetCell write SetCell; property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; @@ -160,7 +168,10 @@ type property OnClick; property OnDoubleClick; property OnDrawCell; + property OnEnter; + property OnExit; property OnFocusChange; + property OnHeaderClick; property OnKeyPress; property OnMouseDown; property OnMouseEnter; @@ -171,6 +182,7 @@ type property OnShowHint; end; + function CreateStringGrid(AOwner: TComponent; x, y, w, h: TfpgCoord; AColumnCount: integer = 0): TfpgStringGrid; @@ -330,9 +342,9 @@ end; function TfpgCustomStringGrid.GetCell(ACol, ARow: Integer): string; begin - if ACol > ColumnCount-1 then + if (ACol < 0) or (ACol > ColumnCount-1) then Exit; //==> - if ARow > RowCount-1 then + if (ARow < 0) or (ARow > RowCount-1) then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow]; end; diff --git a/src/gui/fpg_hyperlink.pas b/src/gui/fpg_hyperlink.pas index a61cb80d..0f0e0896 100644 --- a/src/gui/fpg_hyperlink.pas +++ b/src/gui/fpg_hyperlink.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -58,7 +58,7 @@ type property FontDesc; property Height; property Hint; - property HotTrackColor: TfpgColor read FHotTrackColor write SetHotTrackColor default clBlue; + property HotTrackColor: TfpgColor read FHotTrackColor write SetHotTrackColor default clHyperLink; property HotTrackFont: TfpgString read FHTFont write SetHotTrackFont; property Layout; property Left; @@ -66,7 +66,7 @@ type property ParentShowHint; property ShowHint; property Text; - property TextColor default clBlue; + property TextColor default clHyperLink; property URL: TfpgString read FUrl write SetURL; property Top; property Width; @@ -80,7 +80,9 @@ end; implementation uses - fpg_utils; + fpg_utils + ,fpg_constants + ; { TfpgHyperlink } @@ -89,12 +91,12 @@ constructor TfpgHyperlink.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 120; - FHotTrackColor := clBlue; - TextColor := clBlue; - FUrl := 'http://opensoft.homeip.net/fpgui/'; + FHotTrackColor := clHyperLink; + TextColor := clHyperLink; + FUrl := fpGUIWebsite; FText := 'fpGUI website'; - FHTFont := 'Arial-8:antialias=true:underline:bold'; - FontDesc := 'Arial-8:antialias=true:underline'; + FHTFont := FPG_DEFAULT_SANS + '-8:antialias=true:underline:bold'; + FontDesc := FPG_DEFAULT_SANS + '-8:antialias=true:underline'; end; procedure TfpgHyperlink.SetURL(const Value: TfpgString); diff --git a/src/gui/fpg_iniutils.pas b/src/gui/fpg_iniutils.pas index dec642d3..6bbe83bd 100644 --- a/src/gui/fpg_iniutils.pas +++ b/src/gui/fpg_iniutils.pas @@ -80,7 +80,7 @@ begin lFileName := fpgExtractFileName(AFileName); if lDir = '' then - lDir := GetAppConfigDir(False); + lDir := fpgGetAppConfigDir(False); if not (lDir[Length(lDir)] = PathDelim) then lDir := lDir + PathDelim; @@ -90,12 +90,12 @@ begin if lFileName = '' then - lFileName := ApplicationName + '.ini' + lFileName := fpgApplicationName + '.ini' else if fpgExtractFileExt(lFileName) = '' then lFileName := lFileName + '.ini'; lFileName := lDir + lFileName; - Create(lFileName); + Create(fpgToOSEncoding(lFileName)); end; function TfpgINIFile.ReadString(const ASection, AIdent, ADefault: string): string; diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas index bbcd4530..11baed01 100644 --- a/src/gui/fpg_listbox.pas +++ b/src/gui/fpg_listbox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -63,6 +63,10 @@ type procedure SetPopupFrame(const AValue: boolean); procedure UpdateScrollbarCoords; procedure SetAutoHeight(const AValue: boolean); + function GetScrollBarPage: integer; + procedure SetScrollBarPage(const AValue: integer); + function GetScrollBarWidth: integer; + procedure SetScrollBarWidth(const AValue: integer); protected FFont: TfpgFont; FScrollBar: TfpgScrollBar; @@ -74,7 +78,6 @@ type procedure UpdateScrollBar; procedure FollowFocus; function ListHeight: TfpgCoord; - function ScrollBarWidth: TfpgCoord; function PageLength: integer; procedure ScrollBarMove(Sender: TObject; APosition: integer); procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); virtual; @@ -90,6 +93,8 @@ type procedure HandleShow; override; procedure HandlePaint; override; property AutoHeight: boolean read FAutoHeight write SetAutoHeight default False; + property ScrollBarPage: Integer read GetScrollBarPage write SetScrollBarPage; + property ScrollBarWidth: Integer read GetScrollBarWidth write SetScrollBarWidth; property FocusItem: integer read FFocusItem write SetFocusItem; property FontDesc: string read GetFontDesc write SetFontDesc; property HotTrack: boolean read FHotTrack write FHotTrack default False; @@ -105,6 +110,7 @@ type function RowHeight: integer; virtual; procedure SetFirstItem(item: integer); property Font: TfpgFont read FFont; + property VisibleItems: integer read PageLength; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnKeyPress; // to allow to detect return or tab key has been pressed property OnScroll: TNotifyEvent read FOnScroll write FOnScroll; @@ -147,6 +153,8 @@ type property Items; property ParentShowHint; property PopupFrame; + property ScrollBarPage; + property ScrollBarWidth; property ShowHint; property TabOrder; property Text; @@ -416,6 +424,33 @@ begin Height := (Succ(PageLength) * RowHeight) + (2 * FMargin); end; +function TfpgBaseListBox.GetScrollBarPage: integer; +begin + Result:= FScrollBar.PageSize; +end; + +procedure TfpgBaseListBox.SetScrollBarPage(const AValue: integer); +begin + if AValue= FScrollBar.PageSize then + Exit; //==> + FScrollBar.PageSize:= AValue; +end; + +function TfpgBaseListBox.GetScrollBarWidth: integer; +begin + if FScrollBar.Visible then + result := FScrollBar.Width + else + result := 0; +end; + +procedure TfpgBaseListBox.SetScrollBarWidth(const AValue: integer); +begin + if AValue = FScrollBar.Width then + Exit; //==> + FScrollBar.Width := AValue; +end; + procedure TfpgBaseListBox.MsgPaint(var msg: TfpgMessageRec); begin // Optimising painting and preventing OnPaint from firing if not needed @@ -482,14 +517,6 @@ begin result := height - (2*FMargin); end; -function TfpgBaseListBox.ScrollBarWidth: TfpgCoord; -begin - if FScrollBar.Visible then - result := FScrollBar.Width - else - result := 0; -end; - function TfpgBaseListBox.PageLength: integer; begin result := (ListHeight div RowHeight)-1; // component height minus 1 line @@ -673,6 +700,7 @@ procedure TfpgBaseListBox.HandlePaint; var n: integer; r: TfpgRect; + rect: TRect; begin //if FUpdateCount > 0 then // Exit; //==> @@ -691,8 +719,9 @@ begin end else begin - Canvas.DrawControlFrame(r); - InflateRect(r, -2, -2); + fpgStyle.DrawControlFrame(Canvas, r); + rect := fpgStyle.GetControlFrameBorders; + InflateRect(r, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } end; Canvas.SetClipRect(r); @@ -797,6 +826,7 @@ begin r.SetBottom(Height - FMargin); Canvas.FillRectangle(r); end; + UpdateScrollBar; end; constructor TfpgBaseListBox.Create(AOwner: TComponent); @@ -1277,4 +1307,3 @@ begin end; end. - diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas index 8703d6de..0278c952 100644 --- a/src/gui/fpg_listview.pas +++ b/src/gui/fpg_listview.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -209,8 +209,6 @@ type TfpgListView = class(TfpgWidget, IfpgLVItemViewer) private - procedure SetShiftIsPressed(const AValue: Boolean); - private FImages: array[TfpgLVItemStates] of TfpgImageList; FSubitemImages: array[TfpgLVItemStates] of TfpgImageList; FItemIndex: Integer; @@ -225,6 +223,7 @@ type FUpdateCount: Integer; FVScrollBar: TfpgScrollBar; FHScrollBar: TfpgScrollBar; + FScrollBarWidth: integer; FColumns: TfpgLVColumns; FItems: TfpgLVItems; FOnPaintItem: TfpgLVPaintItemEvent; @@ -241,7 +240,9 @@ type procedure SetItems(const AValue: TfpgLVItems); procedure SetMultiSelect(const AValue: Boolean); procedure SetOnColumnClick(const AValue: TfpgLVColumnClickEvent); + procedure SetScrollBarWidth(const AValue: integer); procedure SetShowHeaders(const AValue: Boolean); + procedure SetShiftIsPressed(const AValue: Boolean); function SubItemGetImages(AIndex: integer): TfpgImageList; procedure SubItemSetImages(AIndex: integer; const AValue: TfpgImageList); procedure VScrollChange(Sender: TObject; Position: Integer); @@ -308,6 +309,7 @@ type property Hint; property MultiSelect: Boolean read FMultiSelect write SetMultiSelect; property ParentShowHint; + property ScrollBarWidth: Integer read FScrollBarWidth write SetScrollBarWidth; property SelectionFollowsFocus: Boolean read FSelectionFollowsFocus write FSelectionFollowsFocus; property SubItemImages: TfpgImageList index Ord(lisNoState) read SubItemGetImages write SubItemSetImages; property SubItemImagesSelected: TfpgImageList index Ord(lisSelected) read SubItemGetImages write SubItemSetImages; @@ -738,6 +740,15 @@ begin FOnColumnClick:=AValue; end; +procedure TfpgListView.SetScrollBarWidth(const AValue: integer); +begin + if AValue = FScrollBarWidth then + Exit; //==> + FScrollBarWidth := AValue; + FVScrollBar.Width := FScrollBarWidth; + FHScrollBar.Height:= FScrollBarWidth; +end; + procedure TfpgListView.SetShiftIsPressed(const AValue: Boolean); begin if AValue = FShiftIsPressed then @@ -1077,7 +1088,7 @@ end; procedure TfpgListView.MsgPaint(var msg: TfpgMessageRec); begin // Optimises painting and prevents Begin[End]Draw and OnPaint event firing - // in not needed. + // if not needed. if FUpdateCount = 0 then inherited MsgPaint(msg); end; @@ -1404,23 +1415,38 @@ end; procedure TfpgListView.HandlePaint; var ClipRect: TfpgRect; + rect: TRect; begin //if FScrollBarNeedsUpdate then UpdateScrollBarPositions; - fpgStyle.DrawControlFrame(Canvas, 0, 0, Width, Height); - - ClipRect.SetRect(2, 2, Width-4, Height-4); + Canvas.ClearClipRect; + ClipRect.SetRect(0, 0, Width, Height); + fpgStyle.DrawControlFrame(Canvas, ClipRect); + rect := fpgStyle.GetControlFrameBorders; + InflateRect(ClipRect, -rect.Left, -rect.Top); { assuming borders are even on opposite sides } Canvas.SetClipRect(ClipRect); + if Enabled then + begin +// if ReadOnly then +// Canvas.SetColor(clWindowBackground) +// else + Canvas.SetColor(FBackgroundColor); + end + else + Canvas.SetColor(clWindowBackground); + + Canvas.FillRectangle(ClipRect); + // This paints the small square remaining below the vscrollbar // and to the right of the hscrollbar if FVScrollBar.Visible and FHScrollBar.Visible then begin Canvas.Color := clButtonFace; - Canvas.FillRectangle(Width - 2 - FVScrollBar.Width, - Height - 2 - FHScrollBar.Height, - Width - 2, - Height - 2); + Canvas.FillRectangle(FHScrollBar.Left+FHScrollBar.Width, + FVScrollBar.Top+FVScrollBar.Height, + FVScrollBar.Width, + FHScrollBar.Height); end; if FVScrollBar.Visible then @@ -1777,6 +1803,7 @@ begin FSelectionFollowsFocus := True; FItemIndex := -1; FScrollBarNeedsUpdate := True; + FScrollBarWidth := FVScrollBar.Width; end; destructor TfpgListView.Destroy; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index df16367b..374c8d47 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 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -145,9 +145,17 @@ type property TabOrder; property TextColor; property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; property OnEnter; property OnExit; + property OnKeyChar; property OnKeyPress; + property OnMouseEnter; + property OnMouseExit; + property OnPaint; property OnShowHint; end; @@ -938,7 +946,7 @@ begin end; ebsDefault: begin - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); InflateRect(r, -2, -2); end; ebsSingle: @@ -1058,11 +1066,14 @@ var s: string; ls: string; begin - inherited; + inherited HandleKeyChar(AText, shiftstate, consumed); + if consumed then + Exit; //==> + prevval := Text; s := AText; - if (not consumed) and (not ReadOnly) then + if (not ReadOnly) then begin // Printable characters only // Note: This is now UTF-8 compliant! @@ -1082,15 +1093,13 @@ begin FSelEndLine := -1; AdjustCursor; end; - consumed := True; end; if prevval <> Text then if Assigned(FOnChange) then FOnChange(self); - end; - + end; { if not ReadOnly } if consumed then RePaint; @@ -1670,6 +1679,7 @@ begin if FUpdateCount <= 0 then begin Invalidate; + RecalcLongestLine; UpdateScrollBars; end; end; diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas index 91db5992..3f634c02 100644 --- a/src/gui/fpg_menu.pas +++ b/src/gui/fpg_menu.pas @@ -417,6 +417,8 @@ begin inherited HandleMouseMove(x, y, btnstate, shiftstate); newf := CalcMouseCol(x); + if newf = VisibleCount then + Exit; //mouse points over the last item // process menu options if mnuo_nofollowingmouse in FMenuOptions then @@ -467,6 +469,9 @@ begin Exit; // We have no menu items in MainMenu. newf := CalcMouseCol(x); + if newf = VisibleCount then + Exit; //mouse points over the last item + if (FLastItemClicked <> -1) and (FLastItemClicked <> newf) then begin // do nothing @@ -585,6 +590,7 @@ begin FHeight := fpgStyle.MenuFont.Height + 6; // 3px margin top and bottom FMenuOptions := []; FMouseIsOver := False; + FIsContainer := True; end; destructor TfpgMenuBar.Destroy; @@ -660,6 +666,8 @@ begin inc(w, ItemWidth(VisibleItem(n))); inc(n); end; + if x > w then + Result := n; end; function TfpgMenuBar.GetItemPosX(index: integer): integer; diff --git a/src/gui/fpg_panel.pas b/src/gui/fpg_panel.pas index 0a0c6e57..aedb7ace 100644 --- a/src/gui/fpg_panel.pas +++ b/src/gui/fpg_panel.pas @@ -177,6 +177,7 @@ type property OnMouseScroll; property OnMouseUp; property OnPaint; + property OnResize; property OnShowHint; end; @@ -307,8 +308,8 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Image: TfpgImage read FImage write SetImage; - property OwnsImage: Boolean read FOwnsImage write FOwnsImage; - property ScaleImage: Boolean read FScaleImage write SetScaleImage; + property OwnsImage: Boolean read FOwnsImage write FOwnsImage default False; + property ScaleImage: Boolean read FScaleImage write SetScaleImage default False; end; @@ -1109,6 +1110,7 @@ begin inherited Create(AOwner); FImage := nil; FOwnsImage := False; + FScaleImage := False; end; destructor TfpgImagePanel.Destroy; diff --git a/src/gui/fpg_popupcalendar.pas b/src/gui/fpg_popupcalendar.pas index 87b9f3ad..fcadd9af 100644 --- a/src/gui/fpg_popupcalendar.pas +++ b/src/gui/fpg_popupcalendar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -1151,7 +1151,7 @@ begin {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: fpgPopupCalendar} Name := 'fpgPopupCalendar'; - SetPosition(370, 182, 233, 142); + SetPosition(370, 182, 235, 149); Hint := ''; edtYear := TfpgEdit.Create(self); @@ -1268,7 +1268,7 @@ begin with grdName1 do begin Name := 'grdName1'; - SetPosition(0, 23, 233, 119); + SetPosition(0, 23, 235, 125); AddColumn('Sun', 33, taCenter); AddColumn('Mon', 32, taCenter); AddColumn('Tue', 33, taCenter); diff --git a/src/gui/fpg_radiobutton.pas b/src/gui/fpg_radiobutton.pas index 2ce8d566..76f36664 100644 --- a/src/gui/fpg_radiobutton.pas +++ b/src/gui/fpg_radiobutton.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -77,6 +77,17 @@ type property Text: string read FText write SetText; property TextColor; property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseExit; + property OnMouseEnter; + property OnMouseMove; + property OnMouseUp; property OnShowHint; end; diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas index dd0a4c7c..1ec78952 100644 --- a/src/gui/fpg_scrollbar.pas +++ b/src/gui/fpg_scrollbar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -21,10 +21,7 @@ unit fpg_scrollbar; { TODO: - * Set slider button to minimum length (default setting) * Create property to enable dynamic sizing of slider button length. - * Paint scroll area between arrow buttons and slider button a different - color on click. } interface @@ -39,7 +36,7 @@ uses type TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object; - TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth); + TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssBothVisible); TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward); @@ -137,7 +134,6 @@ end; procedure TfpgScrollBar.HandlePaint; begin - Canvas.BeginDraw; // Do not remove - Scrollbars do painting outside HandlePaint as well! if Orientation = orVertical then begin DrawButton(0, 0, Width, Width, 'sys.sb.up', (FScrollbarDownPart = sbpUpBack) and (FPosition <> FMin), (FPosition <> FMin) and (Parent.Enabled)); @@ -148,9 +144,7 @@ begin DrawButton(0, 0, Height, Height, 'sys.sb.left', (FScrollbarDownPart = sbpUpBack) and (FPosition <> FMin), (FPosition <> FMin) and (Parent.Enabled)); DrawButton(Width-Height, 0, Height, Height, 'sys.sb.right', (FScrollbarDownPart = sbpDownForward) and (FPosition <> FMax), (FPosition <> FMax) and (Parent.Enabled)); end; - DrawSlider(FRecalc); - Canvas.EndDraw; // Do not remove - Scrollbars do painting outside HandlePaint as well! FRecalc := False; end; @@ -165,7 +159,7 @@ begin if not HasHandle then Exit; //==> FRecalc := True; - Invalidate;// DrawSlider(True); + Invalidate; end; procedure TfpgScrollBar.LineUp; @@ -222,7 +216,7 @@ begin FPosition := AValue; if HasHandle then - Invalidate;// DrawSlider(False); + Invalidate; end; procedure TfpgScrollBar.Step(ASteps: Integer); @@ -363,8 +357,6 @@ var area: TfpgCoord; mm: TfpgCoord; begin -// Canvas.BeginDraw; - if SliderSize > 1 then SliderSize := 1; @@ -372,12 +364,12 @@ begin if Orientation = orVertical then begin - Canvas.FillRectangle(0, Width, Width, Height-Width-Width); + Canvas.FillRectangle(0, Width, Width, Height - (2 * Width)); area := Height - (Width shl 1); end else begin - Canvas.FillRectangle(Height, 0, Width-Height-Height, Height); + Canvas.FillRectangle(Height, 0, Width - (2 * Height), Height); area := Width - (Height shl 1); end; @@ -414,7 +406,7 @@ begin else if FScrollbarDownPart in [{sbpDownForward,} sbpPageDownForward] then begin Canvas.SetColor(clShadow1); - Canvas.FillRectangle(0, FSliderPos + FSliderLength, Width, Height - Width - (FSliderPos + FSliderLength)); + Canvas.FillRectangle(0, Width + FSliderPos + FSliderLength, Width, Height - (2 * Width) - (FSliderPos + FSliderLength)); Canvas.SetColor(clScrollBar); end; end @@ -429,22 +421,16 @@ begin else if FScrollbarDownPart in [{sbpDownForward,} sbpPageDownForward] then begin Canvas.SetColor(clShadow1); - Canvas.FillRectangle(FSliderPos + FSliderLength, 0, Width - Height - (FSliderPos + FSliderLength), Height); + Canvas.FillRectangle(Height + FSliderPos + FSliderLength, 0, Width - (2 * Height) - (FSliderPos + FSliderLength), Height); Canvas.SetColor(clScrollBar); end; end; // Paint the slider button if Orientation = orVertical then - begin - Canvas.DrawButtonFace(0, Width + FSliderPos, Width, FSliderLength, [btfIsEmbedded]); -// Canvas.EndDraw(0, Width, Width, Height - Width - Width); - end + Canvas.DrawButtonFace(0, Width + FSliderPos, Width, FSliderLength, [btfIsEmbedded]) else - begin Canvas.DrawButtonFace(Height + FSliderPos, 0, FSliderLength, Height, [btfIsEmbedded]); -// Canvas.EndDraw(Height, 0, Width - Height - Height, Height); - end; end; procedure TfpgScrollBar.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); @@ -587,7 +573,7 @@ begin FSliderPos := area; if ppos <> FSliderPos then - Invalidate; // DrawSlider(False); + Invalidate; if area <> 0 then newp := FMin + Trunc((FMax - FMin) * (FSliderPos / area)) @@ -620,7 +606,7 @@ begin if Visible then begin FRecalc := True; - Invalidate; // DrawSlider(True); + Invalidate; end; if Assigned(FOnScroll) then diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas new file mode 100644 index 00000000..008832ce --- /dev/null +++ b/src/gui/fpg_scrollframe.pas @@ -0,0 +1,530 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Defines a scrollable frame widget. + + This unit was originally written by David Emerson <dle3ab@angelbase.com> +} +unit fpg_scrollframe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_widget, + fpg_panel, + fpg_scrollbar; + +type + + TfpgScrollFrame = class; + + + TfpgEmbeddingFrame = class (TfpgFrame) + // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame + private + FParentScrollFrame : TfpgScrollFrame; + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + public + property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; + end; + + + TfpgAutoSizingFrame = class (TfpgEmbeddingFrame) + private + FMarginBR : integer; + procedure SetMarginBR (AValue: integer); + public + procedure AfterConstruction; override; + procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); + procedure AdjustDimsWithout (w : TfpgWidget); + procedure RecalcFrameSize; + property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin + end; + + TfpgASFrameClass = class of TfpgAutoSizingFrame; + + + TfpgScrollFrame = class(TfpgFrame) + private + FContentFrame: TfpgAutoSizingFrame; + FVisibleArea: TfpgEmbeddingFrame; + FHScrollBar: TfpgScrollBar; + FVScrollBar: TfpgScrollBar; + FScrollBarStyle: TfpgScrollStyle; + function GetXOffset: integer; + function GetYOffset: integer; + procedure SetXOffset(x: integer); + procedure SetYOffset(y: integer); + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleResize(awidth, aheight: TfpgCoord); override; + procedure HandleShow; override; + procedure HandlePaint; override; + procedure HScrollBarMove(Sender: TObject; position: integer); + procedure VScrollBarMove(Sender: TObject; position: integer); + procedure UpdateScrollbars; virtual; + property XOffset: integer read GetXOffset write SetXOffset; // these do not... + property YOffset: integer read GetYOffset write SetYOffset; // ...updatewindowposition + public + constructor Create (AOwner: TComponent); override; + constructor Create (AOwner: TComponent; ContentFrameType: TfpgASFrameClass); virtual; + procedure AfterCreate; override; + procedure SetContentFrameType(AContentFrameType: TfpgASFrameClass); + property ContentFrame: TfpgAutoSizingFrame read FContentFrame write FContentFrame; + end; + + +implementation + + +{ TfpgEmbeddingFrame } + +procedure TfpgEmbeddingFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); +end; + +procedure TfpgEmbeddingFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta); +end; + + +{ TfpgAutoSizingFrame } + +procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer); +begin + if FMarginBR=AValue then Exit; + FMarginBR:=AValue; + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.AfterConstruction; +begin + inherited AfterConstruction; + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); +var + new_w, new_h: integer; +begin + if not w.Visible then + Exit; + new_w := w.Right+MarginBR+1; + new_h := w.Bottom+MarginBR+1; + if (Width < new_w) or (Height < new_h) then + begin + HandleResize(new_w, new_h); + if updatewp then + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; + end; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWidget); +begin + if (Width = w.Right+MarginBR+1) + or (Height = w.Bottom+MarginBR+1) then + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.RecalcFrameSize; +var + i : integer; + c : TComponent; + max_w, max_h : integer; + this_need : integer; + par : TfpgWidget; +begin + if ComponentCount=0 then + Exit; + max_w := 1; + max_h := 1; + for i := 0 to ComponentCount-1 do begin + c := Components[i]; + if c is TfpgWidget then + begin + if not TfpgWidget(c).Visible then + continue; + this_need := TfpgWidget(c).right+MarginBR+1; + if (this_need>max_w) then + max_w := this_need; + this_need := TfpgWidget(c).bottom+MarginBR+1; + if (this_need>max_h) then + max_h := this_need; + end; + end; + HandleResize(max_w, max_h); + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; +end; + + +{ TfpgScrollFrame } + +function TfpgScrollFrame.GetXOffset: integer; +begin + result := -FContentFrame.Left; +end; + +function TfpgScrollFrame.GetYOffset: integer; +begin + result := -FContentFrame.Top; +end; + +procedure TfpgScrollFrame.SetXOffset (x: integer); +begin + if ContentFrame.Left = -x then + Exit; + FContentFrame.Left := -x; +end; + +procedure TfpgScrollFrame.SetYOffset (y: integer); +begin + if ContentFrame.Top = -y then + Exit; + FContentFrame.Top := -y; +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 + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if YOffset=Position then + Exit; + YOffset:=Position; + end; + UpdateScrollbars; +end; + +procedure TfpgScrollFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + with FHScrollBar do + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if XOffset=Position then + Exit; + XOffset:=Position; + end; + UpdateScrollbars; +end; + +procedure TfpgScrollFrame.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + if HasHandle then + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HandleShow; +begin + inherited HandleShow; + if (csLoading in ComponentState) then + Exit; + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HandlePaint; +begin + if csDesigning in ComponentState then + begin + // clear background rectangle + Canvas.Clear(clDarkGray); + // When designing, don't draw colors + // but draw an outline + Canvas.SetLineStyle(1, lsDash); + Canvas.DrawRectangle(GetClientRect); + Canvas.SetLineStyle(1, lsSolid); + Canvas.Color := clUIDesignerGreen; + Canvas.DrawLine(0, 0, Width, Height); + Canvas.DrawLine(Width, 0, 0, Height); + Canvas.TextColor := clShadow1; + Canvas.DrawText(5, 5, Name + ': ' + ClassName); + Exit; //==> + end; + + inherited HandlePaint; +end; + +procedure TfpgScrollFrame.HScrollBarMove (Sender: TObject; position: integer); +begin + if position = XOffset then + Exit; + XOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.VScrollBarMove (Sender: TObject; position: integer); +begin + if position = YOffset then + Exit; + YOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.UpdateScrollbars; +var + contentWidth, contentHeight: integer; + visWidth, visHeight: integer; + Hfits, Vfits : boolean; + showHsb, showVsb : boolean; + prevHideHsb, prevHideVsb : boolean; + + procedure hideScrollbar (sb : TfpgScrollBar); + begin + with sb do + if Visible then + begin + Visible := False; + UpdateWindowPosition; + end; + end; + + procedure getVisWidth; + begin + if showVsb then + visWidth := Width - (FVScrollBar.Width-1) + else + visWidth := Width; + Hfits := visWidth >= contentWidth + end; + + procedure getVisHeight; + begin + if showHsb then + visHeight := Height - (FHScrollBar.Height-1) + else + visHeight := Height; + Vfits := visHeight >= contentHeight; + end; + +begin + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + + // if we don't want any scrollbars, hide them and exit + if FScrollBarStyle = ssNone then + begin + hideScrollbar (FHScrollBar); + hideScrollbar (FVScrollBar); + exit; + end; + + // preliminary width/height calculations + prevHideHsb := not FHScrollBar.Visible; + prevHideVsb := not FVScrollBar.Visible; + showVsb := (FScrollBarStyle = ssBothVisible); + showHsb := showVsb; + contentWidth := ContentFrame.Width; + contentHeight := ContentFrame.Height; + getVisWidth; + getVisHeight; + + // determine whether to show scrollbars for different configurations + case FScrollBarStyle of + ssHorizontal: + begin + hideScrollbar (FVScrollBar); + if not Hfits then + begin + showHsb := true; + getVisHeight; + end; + end; + ssVertical: + begin + hideScrollbar (FHScrollBar); + if not Vfits then + begin + showVsb := true; + getVisWidth; + end; + end; + ssAutoBoth: + if not Vfits then + begin + showVsb := true; + getVisWidth; + if not Hfits then + begin + showHsb := true; + getVisHeight; + getVisWidth; + end; + end + else if not Hfits then + begin + showHsb := true; + getVisHeight; + if not Vfits then + begin + showVsb := true; + getVisWidth; + getVisHeight; + end; + end; + end; + + // show or hide the scrollbars + + if showVsb then with FVScrollBar do + begin + if prevHideVsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentHeight - visHeight; // may set position! + YOffset := Position; + if contentHeight > 0 then + SliderSize := visHeight / contentHeight + else + SliderSize := 0; + RepaintSlider; + Top := 0; + Left := visWidth; + Height := visHeight; + PageSize:= visHeight; + end + else + begin + FVScrollBar.Visible := false; + if Vfits then // if vertical doesn't fit and no scrollbar, do not change offset + YOffset := 0; + end; + + if showHsb then with FHScrollBar do + begin + if prevHideHsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentWidth - visWidth; // may set position! + XOffset := Position; + if contentWidth > 0 then + SliderSize := visWidth / contentWidth + else + SliderSize := 0; + RepaintSlider; + Top := visHeight; + Left := 0; + Width := visWidth; + PageSize:= visWidth; + end + else + begin + FHScrollBar.Visible := false; + if Hfits then // if horizontal doesn't fit and no scrollbar, do not change offset + XOffset := 0; + end; + + FVScrollBar.UpdateWindowPosition; + FHScrollBar.UpdateWindowPosition; + + FVisibleArea.SetPosition(0, 0, visWidth, visHeight); + FVisibleArea.UpdateWindowPosition; + + FContentFrame.UpdateWindowPosition; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.HandleMove(0, 0); + FVisibleArea.ParentScrollFrame := self; + + FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass); +begin + inherited Create(AOwner); + + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.HandleMove(0, 0); + FVisibleArea.ParentScrollFrame := self; + + FContentFrame := ContentFrameType.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + +procedure TfpgScrollFrame.AfterCreate; +begin + inherited AfterCreate; + + FVScrollBar := TfpgScrollBar.Create(self); + with FVScrollBar do begin + Orientation := orVertical; + OnScroll := @VScrollBarMove; + Position := 0; + ScrollStep := 10; + end; + + FHScrollBar := TfpgScrollBar.Create(self); + with FHScrollBar do begin + Orientation := orHorizontal; + OnScroll := @HScrollBarMove; + Position := 0; + ScrollStep := 10; + end; + + FScrollBarStyle := ssAutoBoth; +end; + +procedure TfpgScrollFrame.SetContentFrameType(AContentFrameType: TfpgASFrameClass); +begin + if Assigned(FContentFrame) then + FContentFrame.Free; + FContentFrame := AContentFrameType.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + + +end. diff --git a/src/gui/fpg_spinedit.pas b/src/gui/fpg_spinedit.pas index 444fa2c0..6061eb3b 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 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -262,7 +262,7 @@ begin newh := h; Result.SetPosition(x, y, w, newh); - if AMaxValue > AMinValue then + if AMaxValue >= AMinValue then begin Result.MinValue := AMinValue; Result.MaxValue := AMaxValue; @@ -288,7 +288,7 @@ begin newh := h; Result.SetPosition(x, y, w, newh); - if AMaxValue > AMinValue then + if AMaxValue >= AMinValue then begin Result.MinValue := AMinValue; Result.MaxValue := AMaxValue; @@ -550,27 +550,23 @@ end; procedure TfpgSpinEditFloat.SetMaxValue(const AValue: extended); begin - if (FMaxValue <> AValue) and (AValue > FMinValue) then + if (FMaxValue <> AValue) and (AValue >= FMinValue) then begin FMaxValue := AValue; if FValue > FMaxValue then - begin FValue := FMaxValue; - FEdit.Value := FValue; - end; + FEdit.Value := FValue; end; end; procedure TfpgSpinEditFloat.SetMinValue(const AValue: extended); begin - if (FMinValue <> AValue) and (AValue < FMaxValue) then + if (FMinValue <> AValue) and (AValue <= FMaxValue) then begin FMinValue := AValue; if FValue < FMinValue then - begin FValue := FMinValue; - FEdit.Value := FValue; - end; + FEdit.Value := FValue; end; end; @@ -990,27 +986,23 @@ end; procedure TfpgSpinEdit.SetMaxValue(const AValue: integer); begin - if (FMaxValue <> AValue) and (AValue > FMinValue) then + if (FMaxValue <> AValue) and (AValue >= FMinValue) then begin FMaxValue := AValue; if FValue > FMaxValue then - begin FValue := FMaxValue; - FEdit.Value := FValue; - end; + FEdit.Value := FValue; end; end; procedure TfpgSpinEdit.SetMinValue(const AValue: integer); begin - if (FMinValue <> AValue) and (AValue < FMaxValue) then + if (FMinValue <> AValue) and (AValue <= FMaxValue) then begin FMinValue := AValue; if FValue < FMinValue then - begin FValue := FMinValue; - FEdit.Value := FValue; - end; + FEdit.Value := FValue; end; end; diff --git a/src/gui/fpg_style_carbon.pas b/src/gui/fpg_style_carbon.pas new file mode 100644 index 00000000..6ad720ee --- /dev/null +++ b/src/gui/fpg_style_carbon.pas @@ -0,0 +1,250 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Carbon fpGUI styles + + Author: Rochdi Abdelilah +} + +unit fpg_style_carbon; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + fpg_main, + fpg_base; + +type + + TfpgCarbonStyle = class(TfpgStyle) + public + constructor Create; override; + { General } + procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); override; + function GetControlFrameBorders: TRect; override; + procedure DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; ARaised: boolean = True); override; + procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection); override; + procedure DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); override; + procedure DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); override; + { Buttons } + procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); override; + function GetButtonBorders: TRect; override; + function GetButtonShift: TPoint; override; + function HasButtonHoverEffect: boolean; override; + procedure DrawMenuBar(ACanvas: TfpgCanvas; r: TfpgRect; ABackgroundColor: TfpgColor); override; + procedure DrawMenuRow(ACanvas: TfpgCanvas; r: TfpgRect; AFlags: TfpgMenuItemFlags); override; + procedure DrawMenuItemSeparator(ACanvas: TfpgCanvas; r: TfpgRect); override; + end; + + +implementation + +uses + fpg_stylemanager; + +const + CarbonBaseColors: array [0..15] of TfpgColor = ( + $FF333333, $FF191919, $FF616161, + $FF202020, $FF474747, $FFC0C0C0, + $FF6E6E6E, $FF3399FF, $FFEAEAEA, + $FF2D2D2D, $FF494949, $FF24617A, + $FF353535, $FF434343, $FF313131, + $FF27546A); + +{ TfpgCarbonStyle } + +constructor TfpgCarbonStyle.Create; +begin + inherited Create; + fpgSetNamedColor(clWindowBackground, CarbonBaseColors[0]); + fpgSetNamedColor(clBoxColor, CarbonBaseColors[1]); + fpgSetNamedColor(clShadow1, CarbonBaseColors[2]); + fpgSetNamedColor(clShadow2, CarbonBaseColors[1]); + fpgSetNamedColor(clHilite1, CarbonBaseColors[3]); + fpgSetNamedColor(clHilite2, CarbonBaseColors[4]); + fpgSetNamedColor(clText1, CarbonBaseColors[5]); + fpgSetNamedColor(clText4, CarbonBaseColors[6]); + fpgSetNamedColor(clSelection, CarbonBaseColors[7]); + fpgSetNamedColor(clSelectionText, CarbonBaseColors[8]); + fpgSetNamedColor(clInactiveSel, CarbonBaseColors[7]); + fpgSetNamedColor(clInactiveSelText, CarbonBaseColors[8]); + fpgSetNamedColor(clScrollBar, CarbonBaseColors[9]); + fpgSetNamedColor(clButtonFace, CarbonBaseColors[0]); + fpgSetNamedColor(clListBox, CarbonBaseColors[1]); + fpgSetNamedColor(clGridLines, CarbonBaseColors[2]); + fpgSetNamedColor(clGridHeader, CarbonBaseColors[0]); + fpgSetNamedColor(clWidgetFrame, CarbonBaseColors[2]); + fpgSetNamedColor(clInactiveWgFrame, CarbonBaseColors[10]); + fpgSetNamedColor(clUnset, CarbonBaseColors[11]); + fpgSetNamedColor(clMenuText, CarbonBaseColors[5]); + fpgSetNamedColor(clMenuDisabled, CarbonBaseColors[0]); + fpgSetNamedColor(clHintWindow, CarbonBaseColors[0]); + fpgSetNamedColor(clGridSelection, CarbonBaseColors[7]); + fpgSetNamedColor(clGridSelectionText, CarbonBaseColors[8]); + fpgSetNamedColor(clGridInactiveSel, CarbonBaseColors[7]); + fpgSetNamedColor(clGridInactiveSelText, CarbonBaseColors[8]); + fpgSetNamedColor(clSplitterGrabBar, CarbonBaseColors[7]); +end; + +procedure TfpgCarbonStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); +var + r: TfpgRect; +begin + r.SetRect(x, y, w, h); + ACanvas.SetColor(clShadow1); + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.DrawRectangle(r); +end; + +function TfpgCarbonStyle.GetControlFrameBorders: TRect; +begin + Result := Rect(1, 1, 1, 1); +end; + +procedure TfpgCarbonStyle.DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; + ARaised: boolean); +begin + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.GradientFill(fpgRect(x,y,w,h), clUnset, CarbonBaseColors[15], gdVertical); + ACanvas.SetColor(clHilite1); + ACanvas.DrawRectangle(x, y, w, h); +end; + +procedure TfpgCarbonStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; + x, y, w, h: TfpgCoord; direction: TArrowDirection); +begin + ACanvas.SetColor(clBoxColor); + inherited DrawDirectionArrow(ACanvas, x + 1, y + 1, w, h, direction); +end; + +procedure TfpgCarbonStyle.DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; + AText: string; AEnabled: boolean); +begin + if AText = '' then + Exit; + if not AEnabled then + ACanvas.SetTextColor(clText4) + else + ACanvas.SetTextColor(clText1); + ACanvas.DrawString(x, y, AText); +end; + +procedure TfpgCarbonStyle.DrawButtonFace(ACanvas: TfpgCanvas; + x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); +var + r: TfpgRect; +begin + ACanvas.SetColor(clBoxColor); + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.FillRectangle(x, y, w, h); + + r.SetRect(x + 1, y + 1, w - 2, h - 2); + + if (btfIsPressed in AFlags) then + begin + if (btfFlat in AFlags) or (btfHover in AFlags) then + ACanvas.SetColor(clHilite2) + else + begin + ACanvas.GradientFill(r, CarbonBaseColors[14], CarbonBaseColors[13], gdVertical); + ACanvas.SetColor(clInactiveWgFrame); + end; + end + else + begin + if btfHover in AFlags then + begin + ACanvas.GradientFill(r, clHilite2, CarbonBaseColors[12], gdVertical); + ACanvas.SetColor(clShadow1); + end + else + begin + if not ((btfFlat in AFlags) and not (btfIsPressed in AFlags)) then + begin + ACanvas.GradientFill(r, CarbonBaseColors[13], CarbonBaseColors[14], gdVertical); + ACanvas.SetColor(clInactiveWgFrame); + end + else if btfFlat in AFlags then + begin + ACanvas.SetColor(clButtonFace); + ACanvas.FillRectangle(r); + end; + end; + end; + + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.DrawRectangle(r); + if btfIsDefault in AFlags then + begin + ACanvas.SetColor(clUnset); + ACanvas.DrawLine(2, 1, w - 2, 1); + ACanvas.DrawLine(2, h - 2, w - 2, h - 2); + end; +end; + +function TfpgCarbonStyle.GetButtonBorders: TRect; +begin + Result := Rect(2, 2, 2, 2); +end; + +function TfpgCarbonStyle.GetButtonShift: TPoint; +begin + Result := Point(0, 0); +end; + +function TfpgCarbonStyle.HasButtonHoverEffect: boolean; +begin + Result := True; +end; + +procedure TfpgCarbonStyle.DrawMenuRow(ACanvas: TfpgCanvas; r: TfpgRect; + AFlags: TfpgMenuItemFlags); +begin + inherited DrawMenuRow(ACanvas, r, AFlags); + if (mifSelected in AFlags) and not (mifSeparator in AFlags) then + ACanvas.GradientFill(r, clUnset, CarbonBaseColors[15], gdVertical); +end; + + +procedure TfpgCarbonStyle.DrawMenuBar(ACanvas: TfpgCanvas; r: TfpgRect; + ABackgroundColor: TfpgColor); +begin + ACanvas.Clear(clWindowBackground); + ACanvas.SetColor(clShadow1); + ACanvas.DrawLine(r.Left, r.Bottom-1, r.Right + 1, r.Bottom-1); + ACanvas.SetColor(clBoxColor); + ACanvas.DrawLine(r.Left, r.Bottom, r.Right + 1, r.Bottom); +end; + +procedure TfpgCarbonStyle.DrawMenuItemSeparator(ACanvas: TfpgCanvas; r: TfpgRect); +begin + ACanvas.SetColor(clBoxColor); + ACanvas.DrawLine(r.Left + 1, r.Top + 2, r.Right, r.Top + 2); +end; + +procedure TfpgCarbonStyle.DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); +begin + ACanvas.SetColor(clUnset); + ACanvas.SetLineStyle(1, lsSolid); + //InflateRect(r, 1, 1); + ACanvas.DrawRectangle(r); +end; + +initialization + fpgStyleManager.RegisterClass('Carbon', TfpgCarbonStyle); + +end. diff --git a/src/gui/fpg_style_plastic.pas b/src/gui/fpg_style_plastic.pas new file mode 100644 index 00000000..2bb43159 --- /dev/null +++ b/src/gui/fpg_style_plastic.pas @@ -0,0 +1,376 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Plastic fpGUI styles + + Author: Rochdi Abdelilah +} + +{$define RegPlasticDark} +{$define RegPlasticDarkGray} +{$define RegPlasticMediumGray} +{$define RegPlasticLightGray} + +{$IF not defined(RegPlasticDark) and + not defined(RegPlasticDarkGray) and + not defined(RegPlasticMediumGray) and + not defined(RegPlasticLightGray))} + {$define RegPlasticDark} +{$ifend} + +unit fpg_style_plastic; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + fpg_main, + fpg_base; + +type + TPlasticColors = array [0..22] of TfpgColor; + PPlasticColors = ^TPlasticColors; + + TfpgPlasticStyle = class(TfpgStyle) + protected + FPlasticColors: PPlasticColors; + procedure LoadPlasticColors; virtual; abstract; + public + constructor Create; override; + { General } + procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); override; overload; + procedure DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; ARaised: boolean = True); override; + procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection); override; + procedure DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); override; + procedure DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); override; + { Buttons } + procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); override; + function GetButtonBorders: TRect; override; + function GetButtonShift: TPoint; override; + function HasButtonHoverEffect: boolean; override; + procedure DrawMenuBar(ACanvas: TfpgCanvas; r: TfpgRect; ABackgroundColor: TfpgColor); override; + { Menus } + procedure DrawMenuItemSeparator(ACanvas: TfpgCanvas; r: TfpgRect); override; + end; + + { TfpgPlasticDarkStyle } + + {$IFDEF RegPlasticDark} + TfpgPlasticDarkStyle = class(TfpgPlasticStyle) + protected + procedure LoadPlasticColors; override; + end; + {$ENDIF} + + { TfpgPlasticDarkGrayStyle } + + {$IFDEF RegPlasticDarkGray} + TfpgPlasticDarkGrayStyle = class(TfpgPlasticStyle) + protected + procedure LoadPlasticColors; override; + end; + {$ENDIF} + + { TfpgPlasticMediumGrayStyle } + + {$IFDEF RegPlasticMediumGray} + TfpgPlasticMediumGrayStyle = class(TfpgPlasticStyle) + protected + procedure LoadPlasticColors; override; + end; + {$ENDIF} + + { TfpgPlasticLightGrayStyle } + + {$IFDEF RegPlasticLightGray} + TfpgPlasticLightGrayStyle = class(TfpgPlasticStyle) + protected + procedure LoadPlasticColors; override; + end; + {$ENDIF} + +implementation + +uses + fpg_stylemanager; + +const + {$IFDEF RegPlasticDark} + PlasticDarkColors: TPlasticColors = + ($FF343434, $FF222222, $FF141414, $FF454545, + $FFDDDDDD, $FF4B5367, $FF464646, $FF101010, + $FF4A669B, $FF373737, $FF303030, $FF1F1F1F, + $FF878787, $FF696969, $FF646464, $FF4E4E4E, + $FF262626, $FF1D1D1D, $FF3D3D3D, $FF272727, + $FF282828, $FF292929, $FF2A2A2A); + {$ENDIF} + {$IFDEF RegPlasticDarkGray} + PlasticDarkGrayColors: TPlasticColors = + ($FF535353, $FF3a3a3a, $FF282828, $FF6A6A6A, + $FFE5E5E5, $FF596678, $FF6A6A6A, $FF303030, + $FF506FAC, $FF575757, $FF4D4D4D, $FF333333, + $FFA0A0A0, $FF919191, $FF848484, $FF757575, + $FF3F3F3F, $FF373737, $FF626262, $FF444444, + $FF464646, $FF474747, $FF484848); + {$ENDIF} + {$IFDEF RegPlasticMediumGray} + PlasticMediumGrayColors: TPlasticColors = + ($FFB8B8B8, $FFFFFFFF, $FF707070, $FFCDCDCD, + $FF373737, $FFB7CDF9, $FFC8C8C8, $FF686868, + $FF74AAF3, $FFBBBBBB, $FFA9A9A9, $FF7F7F7F, + $FFFAFAFA, $FFF7F7F7, $FFFEFEFE, $FFE7E7E7, + $FF8D8D8D, $FF868686, $FFBDBDBD, $FF909090, + $FF919191, $FF929292, $FF959595); + {$ENDIF} + {$IFDEF RegPlasticLightGray} + PlasticLightGrayColors: TPlasticColors = + ($FFD6D6D6, $FFFFFFFF, $FF737373, $FFEBEBEB, + $FF373737, $FFB7CDF9, $FFE8E8E8, $FF7C7C7C, + $FF9BCAFA, $FFD9D9D9, $FFC3C3C3, $FF999999, + $FFFFFFFF, $FFF5F5F5, $FFFEFEFE, $FFE6E6E6, + $FFA9A9A9, $FFA0A0A0, $FFD7D7D7, $FFACACAC, + $FFAEAEAE, $FFB7B7B7, $FFBABABA); + {$ENDIF} + +{ TfpgPlasticLightGrayStyle } + +{$IFDEF RegPlasticLightGray} +procedure TfpgPlasticLightGrayStyle.LoadPlasticColors; +begin + FPlasticColors := @PlasticLightGrayColors; +end; +{$ENDIF} + +{ TfpgPlasticMediumGrayStyle } + +{$IFDEF RegPlasticMediumGray} +procedure TfpgPlasticMediumGrayStyle.LoadPlasticColors; +begin + FPlasticColors := @PlasticMediumGrayColors; +end; +{$ENDIF} + +{ TfpgPlasticDarkGrayStyle } + +{$IFDEF RegPlasticDarkGray} +procedure TfpgPlasticDarkGrayStyle.LoadPlasticColors; +begin + FPlasticColors := @PlasticDarkGrayColors; +end; +{$ENDIF} + +{ TfpgPlasticDarkStyle } + +{$IFDEF RegPlasticDark} +procedure TfpgPlasticDarkStyle.LoadPlasticColors; +begin + FPlasticColors := @PlasticDarkColors; +end; +{$ENDIF} + +{ TfpgPlasticStyle } + +constructor TfpgPlasticStyle.Create; +begin + inherited Create; + LoadPlasticColors; + fpgSetNamedColor(clWindowBackground, FPlasticColors^[0]); + fpgSetNamedColor(clBoxColor, FPlasticColors^[1]); + fpgSetNamedColor(clShadow1, FPlasticColors^[2]); + fpgSetNamedColor(clShadow2, FPlasticColors^[3]); + fpgSetNamedColor(clHilite1, FPlasticColors^[3]); + fpgSetNamedColor(clHilite2, FPlasticColors^[3]); + fpgSetNamedColor(clText1, FPlasticColors^[4]); + fpgSetNamedColor(clText4, FPlasticColors^[2]); + fpgSetNamedColor(clSelection, FPlasticColors^[5]); + fpgSetNamedColor(clSelectionText, FPlasticColors^[4]); + fpgSetNamedColor(clInactiveSel, FPlasticColors^[5]); + fpgSetNamedColor(clInactiveSelText, FPlasticColors^[4]); + fpgSetNamedColor(clScrollBar, FPlasticColors^[6]); + fpgSetNamedColor(clButtonFace, FPlasticColors^[0]); + fpgSetNamedColor(clListBox, FPlasticColors^[1]); + fpgSetNamedColor(clGridLines, FPlasticColors^[7]); + fpgSetNamedColor(clGridHeader, FPlasticColors^[0]); + fpgSetNamedColor(clWidgetFrame, FPlasticColors^[3]); + fpgSetNamedColor(clInactiveWgFrame, FPlasticColors^[2]); + fpgSetNamedColor(clMenuText, FPlasticColors^[4]); + fpgSetNamedColor(clHintWindow, FPlasticColors^[1]); + fpgSetNamedColor(clGridSelection, FPlasticColors^[5]); + fpgSetNamedColor(clGridSelectionText, FPlasticColors^[4]); + fpgSetNamedColor(clGridInactiveSel, FPlasticColors^[5]); + fpgSetNamedColor(clGridInactiveSelText, FPlasticColors^[4]); + fpgSetNamedColor(clSplitterGrabBar, FPlasticColors^[8]); +end; + +procedure TfpgPlasticStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; + x, y, w, h: TfpgCoord; direction: TArrowDirection); +begin + ACanvas.SetColor(clText1); + inherited DrawDirectionArrow(ACanvas, x + 2, y + 1, w - 2, h - 3, direction); +end; + +procedure TfpgPlasticStyle.DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; + ARaised: boolean); +begin + DrawButtonFace(ACanvas, x, y, w, h, [btfIsPressed]); +end; + +procedure TfpgPlasticStyle.DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; + AText: string; AEnabled: boolean); +var + lOldColor: TfpgColor; +begin + if AText = '' then + Exit; + lOldColor := ACanvas.TextColor; + if not AEnabled then + ACanvas.SetTextColor(clText4) + else + ACanvas.SetTextColor(clText1); + if lOldColor = clShadow1 then + ACanvas.SetTextColor(clHilite2); + ACanvas.DrawString(x, y, AText); + if lOldColor <> clBlue then + ACanvas.SetTextColor(lOldColor); +end; + +procedure TfpgPlasticStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); +begin + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.GradientFill(fpgRect(x, y, w, h), clWindowBackground, clScrollBar, gdVertical); + ACanvas.Pixels[x, y + h - 1] := FPlasticColors^[9]; + ACanvas.Pixels[x + w - 1, y + h - 1] := FPlasticColors^[9]; + ACanvas.SetColor(clGridLines); + ACanvas.DrawRectangle(fpgRect(x + 1, y + 1, w - 2, h - 2)); + ACanvas.Pixels[x + 1, y + 1] := FPlasticColors^[10]; + ACanvas.Pixels[x + w - 2, y + 1] := FPlasticColors^[10]; + ACanvas.Pixels[x + 1, y + h - 2] := FPlasticColors^[10]; + ACanvas.Pixels[x + w - 2, y + h - 2] := FPlasticColors^[10]; +end; + +procedure TfpgPlasticStyle.DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); +begin + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.SetColor(clSplitterGrabBar); + ACanvas.DrawRectangle(r); + ACanvas.Pixels[r.Left, r.Top] := FPlasticColors^[9]; + ACanvas.Pixels[r.Left + 1, r.Top + 1] := clSplitterGrabBar; + ACanvas.Pixels[r.Width - 1, r.Top] := FPlasticColors^[9]; + ACanvas.Pixels[r.Width - 2, r.Top + 1] := clSplitterGrabBar; + ACanvas.Pixels[r.Left, r.Height - 1] := FPlasticColors^[9]; + ACanvas.Pixels[r.Left + 1, r.Height - 2] := clSplitterGrabBar; + ACanvas.Pixels[r.Width - 1, r.Height - 1] := FPlasticColors^[9]; + ACanvas.Pixels[r.Width - 2, r.Height - 2] := clSplitterGrabBar; +end; + +procedure TfpgPlasticStyle.DrawButtonFace(ACanvas: TfpgCanvas; + x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); +var + r: TfpgRect; +begin + ACanvas.SetLineStyle(1, lsSolid); + r.SetRect(x, y, w, h); + DrawControlFrame(ACanvas, r); + r.SetRect(x + 2, y + 3, w - 4, h - 5); + + if (btfIsPressed in AFlags) then + begin + ACanvas.GradientFill(r, FPlasticColors^[16], FPlasticColors^[17], gdVertical); + ACanvas.SetColor(FPlasticColors^[11]); + end + else + begin + if btfHover in AFlags then + begin + ACanvas.GradientFill(r, FPlasticColors^[14], FPlasticColors^[15], gdVertical); + ACanvas.SetColor(FPlasticColors^[12]); + end + else + begin + if not ((btfFlat in AFlags) and not (btfIsPressed in AFlags)) then + begin + ACanvas.GradientFill(r, FPlasticColors^[15], FPlasticColors^[18], gdVertical); + ACanvas.SetColor(FPlasticColors^[13]); + end + else if btfFlat in AFlags then + begin + ACanvas.SetColor(clWindowBackground); + ACanvas.FillRectangle(r); + end; + end; + end; + if not (btfFlat in AFlags) then + begin + if (btfIsDefault in AFlags) and not (btfIsPressed in AFlags) and + not (btfHasFocus in AFlags) then + ACanvas.SetColor(clSplitterGrabBar); + ACanvas.DrawLine(x + 2, y + 2, x + w - 2, y + 2); + end; + ACanvas.Pixels[x + 2, y + 2] := FPlasticColors^[19]; + ACanvas.Pixels[x + w - 3, y + 2] := FPlasticColors^[20]; + ACanvas.Pixels[x + 2, y + h - 3] := FPlasticColors^[21]; + ACanvas.Pixels[x + w - 3, y + h - 3] := FPlasticColors^[22]; +end; + +function TfpgPlasticStyle.GetButtonBorders: TRect; +begin + Result := Rect(0, 0, 0, 0); +end; + +function TfpgPlasticStyle.GetButtonShift: TPoint; +begin + Result := Point(0, 0); +end; + +function TfpgPlasticStyle.HasButtonHoverEffect: boolean; +begin + Result := True; +end; + +procedure TfpgPlasticStyle.DrawMenuBar(ACanvas: TfpgCanvas; r: TfpgRect; + ABackgroundColor: TfpgColor); +begin + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.SetColor(clWindowBackground); + ACanvas.FillRectangle(r); + ACanvas.SetColor(clShadow2); + ACanvas.DrawLine(r.Left, r.Top, r.Left + r.Right, r.Top); + DrawMenuItemSeparator(ACanvas, fpgRect(r.Left - 1, r.Height - 4, r.Width, r.Height)); +end; + +procedure TfpgPlasticStyle.DrawMenuItemSeparator(ACanvas: TfpgCanvas; r: TfpgRect); +begin + ACanvas.SetColor(clShadow1); + ACanvas.DrawLine(r.Left + 1, r.Top + 2, r.Right, r.Top + 2); + ACanvas.SetColor(clShadow2); + ACanvas.DrawLine(r.Left + 1, r.Top + 3, r.Right, r.Top + 3); +end; + + +initialization + {$IFDEF RegPlasticDark} + fpgStyleManager.RegisterClass('Plastic Dark', TfpgPlasticDarkStyle); + {$ENDIF} + {$IFDEF RegPlasticDarkGray} + fpgStyleManager.RegisterClass('Plastic Dark Gray', TfpgPlasticDarkGrayStyle); + {$ENDIF} + {$IFDEF RegPlasticMediumGray} + fpgStyleManager.RegisterClass('Plastic Medium Gray', TfpgPlasticMediumGrayStyle); + {$ENDIF} + {$IFDEF RegPlasticLightGray} + fpgStyleManager.RegisterClass('Plastic Light Gray', TfpgPlasticLightGrayStyle); + {$ENDIF} +end. diff --git a/src/gui/fpg_style_win8.pas b/src/gui/fpg_style_win8.pas new file mode 100644 index 00000000..f3d99705 --- /dev/null +++ b/src/gui/fpg_style_win8.pas @@ -0,0 +1,541 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit implements a Windows 8 (I think) look-alike style + + Author: Graeme Geldenhuys +} + +unit fpg_style_win8; + +{$mode objfpc}{$H+} + +{ + *********************************************************** + ********** This is still under development! *********** + *********************************************************** + + It needs lots of testing and debugging. +} + +interface + +uses + Classes, + fpg_main, + fpg_base; + +type + TfpgWin8Style = class(TfpgStyle) + private + FImages: TfpgImages; + procedure LoadThemeImages; + public + constructor Create; override; + destructor Destroy; override; + { General } + procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); override; overload; + function GetControlFrameBorders: TRect; override; + { Buttons } + procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); override; overload; + function GetButtonBorders: TRect; override; + { Combobox } + procedure DrawStaticComboBox(ACanvas: TfpgCanvas; r: TfpgRect; const IsEnabled: Boolean; const IsFocused: Boolean; const IsReadOnly: Boolean; const ABackgroundColor: TfpgColor; const AInternalBtnRect: TfpgRect; const ABtnPressed: Boolean); override; + { Checkbox } + procedure DrawCheckbox(ACanvas: TfpgCanvas; x, y: TfpgCoord; ix, iy: TfpgCoord); override; + end; + +implementation + +uses + fpg_stylemanager + ; + +const + Win8BaseColors: array [0..16] of TfpgColor = ( + $FFF0F0F0, $FF606060, $FFABADB3, + $FF202020, $FF474747, $FFC0C0C0, + $FF3399FF, $FF3399FF, $FFFFFFFF, + $FF2D2D2D, $FF494949, $FF24617A, + $FF353535, $FF434343, $FF313131, + $FF27546A, $FFE5E5E5); + + +{%region 'Byte arrays of images' -fold} +const + win8_checkboxes: array[0..2601] of byte = ( + 66, 77, 42, 10, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 65, 0, 0, 0, 13, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 244, 9, 0, 0,196, 14, 0, 0,196, 14, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188, 0,112,112,112,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,112,112,112, + 112,112,112,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,112,112,112,188,188,188,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,188,188,188,188,188,188,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,188,188,188,188,188, + 188,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 188,188,188, 0,112,112,112,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,112,112,112,112,112,112,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,207,207,207,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,112,112,112,188,188,188, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,188, + 188,188,188,188,188,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,208,208,208,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,188,188,188,188,188,188,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,188,188,188, 0,112,112,112,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,112,112, + 112,112,112,112,255,255,255,255,255,255,255,255,255,255,255,255, 95, + 95, 95, 0, 0, 0,207,207,207,255,255,255,255,255,255,255,255,255, + 255,255,255,112,112,112,188,188,188,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,188,188,188,188,188,188,230,230,230, + 230,230,230,230,230,230,230,230,230,156,156,156,112,112,112,208,208, + 208,230,230,230,230,230,230,230,230,230,230,230,230,188,188,188,188, + 188,188,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,188,188,188, 0,112,112,112,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,112,112,112,112,112,112,255,255,255,255, + 255,255,239,239,239, 63, 63, 63, 0, 0, 0, 0, 0, 0, 47, 47, 47, + 255,255,255,255,255,255,255,255,255,255,255,255,112,112,112,188,188, + 188,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 188,188,188,188,188,188,230,230,230,230,230,230,223,223,223,141,141, + 141,112,112,112,112,112,112,134,134,134,230,230,230,230,230,230,230, + 230,230,230,230,230,188,188,188,188,188,188,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,188,188,188, 0,112,112,112, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,112, + 112,112,112,112,112,255,255,255,239,239,239, 47, 47, 47, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 0, 0, 0,127,127,127,255,255,255,255,255, + 255,255,255,255,112,112,112,188,188,188,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,188,188,188,188,188,188,230,230, + 230,223,223,223,134,134,134,112,112,112,112,112,112,119,119,119,112, + 112,112,171,171,171,230,230,230,230,230,230,230,230,230,188,188,188, + 188,188,188,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,188,188,188, 0,112,112,112,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,112,112,112,112,112,112,255,255,255, + 159,159,159, 0, 0, 0, 15, 15, 15,207,207,207,175,175,175, 0, 0, + 0, 0, 0, 0,207,207,207,255,255,255,255,255,255,112,112,112,188, + 188,188,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,188,188,188,188,188,188,230,230,230,186,186,186,112,112,112,119, + 119,119,208,208,208,193,193,193,112,112,112,112,112,112,208,208,208, + 230,230,230,230,230,230,188,188,188,188,188,188,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,188,188,188, 0,112,112, + 112,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 112,112,112,112,112,112,255,255,255,255,255,255,127,127,127,207,207, + 207,255,255,255,255,255,255, 79, 79, 79, 0, 0, 0, 47, 47, 47,255, + 255,255,255,255,255,112,112,112,188,188,188,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,188,188,188,188,188,188,230, + 230,230,230,230,230,171,171,171,208,208,208,230,230,230,230,230,230, + 149,149,149,112,112,112,134,134,134,230,230,230,230,230,230,188,188, + 188,188,188,188,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,188,188,188, 0,112,112,112,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,112,112,112,112,112,112,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,239, + 239,239, 15, 15, 15, 0, 0, 0,127,127,127,255,255,255,112,112,112, + 188,188,188,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,188,188,188,188,188,188,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,223,223,223,119,119,119,112,112, + 112,171,171,171,230,230,230,188,188,188,188,188,188,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,188,188,188, 0,112, + 112,112,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,112,112,112,112,112,112,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,175,175,175, 0, 0, 0, + 15, 15, 15,255,255,255,112,112,112,188,188,188,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,188,188,188,188,188,188, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,193,193,193,112,112,112,119,119,119,230,230,230,188, + 188,188,188,188,188,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,188,188,188, 0,112,112,112,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,112,112,112,112,112,112,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,127,127,127,223,223,223,255,255,255,112,112, + 112,188,188,188,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,188,188,188,188,188,188,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,171, + 171,171,215,215,215,230,230,230,188,188,188,188,188,188,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,188,188,188, 0, + 112,112,112,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,112,112,112,112,112,112,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,112,112,112,188,188,188,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,188,188,188,188,188, + 188,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 188,188,188,188,188,188,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,188,188,188, 0,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112,112, + 112,112,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188,188, + 0); + + +const + win8_radiobuttons: array[0..2601] of byte = ( + 66, 77, 42, 10, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 65, 0, 0, 0, 13, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 244, 9, 0, 0,196, 14, 0, 0,196, 14, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255,255,255,255,255,255,255,255,255,209,209,209,168,168, + 168,134,134,134,115,115,115,134,134,134,168,168,168,209,209,209,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 209,209,209,168,168,168,134,134,134,115,115,115,134,134,134,168,168, + 168,209,209,209,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,233,233,233,214,214,214,199,199,199,189,189,189, + 199,199,199,214,214,214,233,233,233,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,233,233,233,214,214,214,199, + 199,199,189,189,189,199,199,199,214,214,214,233,233,233,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,233,233, + 233,214,214,214,199,199,199,189,189,189,199,199,199,214,214,214,233, + 233,233,255,255,255,255,255,255,255,255,255, 0,255,255,255,242,242, + 242,177,177,177,114,114,114,199,199,199,233,233,233,252,252,252,233, + 233,233,199,199,199,114,114,114,177,177,177,242,242,242,255,255,255, + 255,255,255,242,242,242,177,177,177,114,114,114,199,199,199,233,233, + 233,252,252,252,233,233,233,199,199,199,114,114,114,177,177,177,242, + 242,242,255,255,255,255,255,255,249,249,249,218,218,218,189,189,189, + 214,214,214,223,223,223,229,229,229,223,223,223,214,214,214,189,189, + 189,218,218,218,249,249,249,255,255,255,255,255,255,249,249,249,218, + 218,218,189,189,189,214,214,214,223,223,223,229,229,229,223,223,223, + 214,214,214,189,189,189,218,218,218,249,249,249,255,255,255,255,255, + 255,249,249,249,218,218,218,189,189,189,214,214,214,223,223,223,229, + 229,229,223,223,223,214,214,214,189,189,189,218,218,218,249,249,249, + 255,255,255, 0,255,255,255,177,177,177,184,184,184,249,249,249,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,249,249,249, + 184,184,184,177,177,177,255,255,255,255,255,255,177,177,177,184,184, + 184,249,249,249,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,249,249,249,184,184,184,177,177,177,255,255,255,255,255,255, + 218,218,218,209,209,209,228,228,228,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,228,228,228,209,209,209,218,218,218,255, + 255,255,255,255,255,218,218,218,209,209,209,228,228,228,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,228,228,228,209,209, + 209,218,218,218,255,255,255,255,255,255,218,218,218,209,209,209,228, + 228,228,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 228,228,228,209,209,209,218,218,218,255,255,255, 0,209,209,209,114, + 114,114,249,249,249,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,249,249,249,114,114,114,209,209, + 209,209,209,209,114,114,114,249,249,249,255,255,255,171,171,171, 95, + 95, 95, 42, 42, 42, 95, 95, 95,171,171,171,255,255,255,249,249,249, + 114,114,114,209,209,209,233,233,233,189,189,189,228,228,228,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,228,228,228,189,189,189,233,233,233,233,233,233,189,189,189, + 228,228,228,230,230,230,186,186,186,145,145,145,117,117,117,145,145, + 145,186,186,186,230,230,230,228,228,228,189,189,189,233,233,233,233, + 233,233,189,189,189,228,228,228,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,228,228,228,189,189, + 189,233,233,233, 0,168,168,168,199,199,199,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,199,199,199,168,168,168,168,168,168,199,199,199,255, + 255,255,171,171,171, 39, 39, 39, 33, 33, 33, 33, 33, 33, 33, 33, 33, + 39, 39, 39,171,171,171,255,255,255,199,199,199,168,168,168,214,214, + 214,214,214,214,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,214,214,214, + 214,214,214,214,214,214,214,214,214,230,230,230,186,186,186,115,115, + 115,112,112,112,112,112,112,112,112,112,115,115,115,186,186,186,230, + 230,230,214,214,214,214,214,214,214,214,214,214,214,214,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,214,214,214,214,214,214, 0,134,134,134, + 233,233,233,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,233,233,233,134, + 134,134,134,134,134,233,233,233,255,255,255, 95, 95, 95, 33, 33, 33, + 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 95, 95, 95,255,255, + 255,233,233,233,134,134,134,199,199,199,223,223,223,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,223,223,223,199,199,199,199,199,199,223,223, + 223,230,230,230,145,145,145,112,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,145,145,145,230,230,230,223,223,223,199,199,199, + 199,199,199,223,223,223,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,223, + 223,223,199,199,199, 0,115,115,115,252,252,252,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,252,252,252,115,115,115,115,115,115,252,252,252, + 255,255,255, 42, 42, 42, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, + 33, 33, 33, 33, 42, 42, 42,255,255,255,252,252,252,115,115,115,189, + 189,189,229,229,229,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,229,229, + 229,189,189,189,189,189,189,229,229,229,230,230,230,117,117,117,112, + 112,112,112,112,112,112,112,112,112,112,112,112,112,112,117,117,117, + 230,230,230,229,229,229,189,189,189,189,189,189,229,229,229,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,229,229,229,189,189,189, 0,134,134, + 134,233,233,233,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,233,233,233, + 134,134,134,134,134,134,233,233,233,255,255,255, 95, 95, 95, 33, 33, + 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 95, 95, 95,255, + 255,255,233,233,233,134,134,134,199,199,199,223,223,223,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,223,223,223,199,199,199,199,199,199,223, + 223,223,230,230,230,145,145,145,112,112,112,112,112,112,112,112,112, + 112,112,112,112,112,112,145,145,145,230,230,230,223,223,223,199,199, + 199,199,199,199,223,223,223,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 223,223,223,199,199,199, 0,168,168,168,199,199,199,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,199,199,199,168,168,168,168,168,168,199,199, + 199,255,255,255,171,171,171, 39, 39, 39, 33, 33, 33, 33, 33, 33, 33, + 33, 33, 39, 39, 39,171,171,171,255,255,255,199,199,199,168,168,168, + 214,214,214,214,214,214,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,214, + 214,214,214,214,214,214,214,214,214,214,214,230,230,230,186,186,186, + 115,115,115,112,112,112,112,112,112,112,112,112,115,115,115,186,186, + 186,230,230,230,214,214,214,214,214,214,214,214,214,214,214,214,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,214,214,214,214,214,214, 0,209, + 209,209,114,114,114,249,249,249,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,249,249,249,114,114, + 114,209,209,209,209,209,209,114,114,114,249,249,249,255,255,255,171, + 171,171, 95, 95, 95, 42, 42, 42, 95, 95, 95,171,171,171,255,255,255, + 249,249,249,114,114,114,209,209,209,233,233,233,189,189,189,228,228, + 228,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,230,228,228,228,189,189,189,233,233,233,233,233,233, + 189,189,189,228,228,228,230,230,230,186,186,186,145,145,145,117,117, + 117,145,145,145,186,186,186,230,230,230,228,228,228,189,189,189,233, + 233,233,233,233,233,189,189,189,228,228,228,230,230,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,228,228, + 228,189,189,189,233,233,233, 0,255,255,255,177,177,177,184,184,184, + 249,249,249,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,249,249,249,184,184,184,177,177,177,255,255,255,255,255,255,177, + 177,177,184,184,184,249,249,249,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,249,249,249,184,184,184,177,177,177,255,255, + 255,255,255,255,218,218,218,209,209,209,228,228,228,230,230,230,230, + 230,230,230,230,230,230,230,230,230,230,230,228,228,228,209,209,209, + 218,218,218,255,255,255,255,255,255,218,218,218,209,209,209,228,228, + 228,230,230,230,230,230,230,230,230,230,230,230,230,230,230,230,228, + 228,228,209,209,209,218,218,218,255,255,255,255,255,255,218,218,218, + 209,209,209,228,228,228,230,230,230,230,230,230,230,230,230,230,230, + 230,230,230,230,228,228,228,209,209,209,218,218,218,255,255,255, 0, + 255,255,255,242,242,242,177,177,177,114,114,114,199,199,199,233,233, + 233,252,252,252,233,233,233,199,199,199,114,114,114,177,177,177,242, + 242,242,255,255,255,255,255,255,242,242,242,177,177,177,114,114,114, + 199,199,199,233,233,233,252,252,252,233,233,233,199,199,199,114,114, + 114,177,177,177,242,242,242,255,255,255,255,255,255,249,249,249,218, + 218,218,189,189,189,214,214,214,223,223,223,229,229,229,223,223,223, + 214,214,214,189,189,189,218,218,218,249,249,249,255,255,255,255,255, + 255,249,249,249,218,218,218,189,189,189,214,214,214,223,223,223,229, + 229,229,223,223,223,214,214,214,189,189,189,218,218,218,249,249,249, + 255,255,255,255,255,255,249,249,249,218,218,218,189,189,189,214,214, + 214,223,223,223,229,229,229,223,223,223,214,214,214,189,189,189,218, + 218,218,249,249,249,255,255,255, 0,255,255,255,255,255,255,255,255, + 255,209,209,209,168,168,168,134,134,134,115,115,115,134,134,134,168, + 168,168,209,209,209,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,209,209,209,168,168,168,134,134,134,115,115, + 115,134,134,134,168,168,168,209,209,209,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,233,233,233,214,214,214, + 199,199,199,189,189,189,199,199,199,214,214,214,233,233,233,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,233, + 233,233,214,214,214,199,199,199,189,189,189,199,199,199,214,214,214, + 233,233,233,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,233,233,233,214,214,214,199,199,199,189,189,189,199, + 199,199,214,214,214,233,233,233,255,255,255,255,255,255,255,255,255, + 0); + +{%endregion} + +{ TfpgWin8Style } + +procedure TfpgWin8Style.LoadThemeImages; +begin + //FImages.AddMaskedBMP( // 65x13 in total. 5 images of 13x13 each. + // 'win8.radiobuttons', + // @stdimg_radiobuttons, + // sizeof(stdimg_radiobuttons), 0,0); + + FImages.AddBMP( // 65x13 pixels. 5 images of 13x13 each. + 'win8.radiobuttons', + @win8_radiobuttons, + sizeof(win8_radiobuttons)); + + FImages.AddBMP( // 65x13 pixels. 5 images of 13x13 each. + 'win8.checkboxes', + @win8_checkboxes, + sizeof(win8_checkboxes)); +end; + +constructor TfpgWin8Style.Create; +begin + inherited Create; + FImages := TfpgImages.Create; + LoadThemeImages; + + fpgSetNamedColor(clWindowBackground, Win8BaseColors[0]); + //fpgSetNamedColor(clBoxColor, Win8BaseColors[1]); + fpgSetNamedColor(clShadow1, Win8BaseColors[2]); + fpgSetNamedColor(clShadow2, Win8BaseColors[1]); + //fpgSetNamedColor(clHilite1, Win8BaseColors[3]); + //fpgSetNamedColor(clHilite2, Win8BaseColors[4]); + //fpgSetNamedColor(clText1, Win8BaseColors[5]); + //fpgSetNamedColor(clText4, Win8BaseColors[6]); + fpgSetNamedColor(clSelection, Win8BaseColors[7]); + fpgSetNamedColor(clSelectionText, Win8BaseColors[8]); + //fpgSetNamedColor(clInactiveSel, Win8BaseColors[7]); + //fpgSetNamedColor(clInactiveSelText, Win8BaseColors[8]); + //fpgSetNamedColor(clScrollBar, Win8BaseColors[9]); + //fpgSetNamedColor(clButtonFace, Win8BaseColors[0]); + //fpgSetNamedColor(clListBox, Win8BaseColors[1]); + //fpgSetNamedColor(clGridLines, Win8BaseColors[2]); + //fpgSetNamedColor(clGridHeader, Win8BaseColors[0]); + fpgSetNamedColor(clWidgetFrame, Win8BaseColors[2]); + //fpgSetNamedColor(clInactiveWgFrame, Win8BaseColors[10]); + //fpgSetNamedColor(clUnset, Win8BaseColors[11]); + //fpgSetNamedColor(clMenuText, Win8BaseColors[5]); + //fpgSetNamedColor(clMenuDisabled, Win8BaseColors[0]); + //fpgSetNamedColor(clHintWindow, Win8BaseColors[0]); + //fpgSetNamedColor(clGridSelection, Win8BaseColors[7]); + //fpgSetNamedColor(clGridSelectionText, Win8BaseColors[8]); + //fpgSetNamedColor(clGridInactiveSel, Win8BaseColors[7]); + //fpgSetNamedColor(clGridInactiveSelText, Win8BaseColors[8]); + //fpgSetNamedColor(clSplitterGrabBar, Win8BaseColors[7]); + fpgSetNamedColor(clChoiceListBox, Win8BaseColors[16]); +end; + +destructor TfpgWin8Style.Destroy; +begin + FImages.Free; + inherited Destroy; +end; + +procedure TfpgWin8Style.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); +var + r: TfpgRect; +begin + r.SetRect(x, y, w, h); + ACanvas.SetLineStyle(1, lsSolid); + ACanvas.SetColor(clWidgetFrame); + ACanvas.DrawRectangle(r); +end; + +function TfpgWin8Style.GetControlFrameBorders: TRect; +begin + Result := Rect(1, 1, 1, 1); +end; + +procedure TfpgWin8Style.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TfpgButtonFlags); +var + r: TfpgRect; +begin + r.SetRect(x, y, w, h); + ACanvas.SetLineStyle(1, lsSolid); + if btfDisabled in AFlags then + ACanvas.SetColor(TfpgColor($ffd9d9d9)) + else + begin + if btfIsDefault in AFlags then + ACanvas.SetColor(clSelection) + else + ACanvas.SetColor(TfpgColor($ffacacac)); + end; + ACanvas.DrawRectangle(r); + InflateRect(r, -1, -1); + if btfDisabled in AFlags then + begin + ACanvas.SetColor(TfpgColor($ffefefef)); + ACanvas.FillRectangle(r); + end + else + ACanvas.GradientFill(r, clWindowBackground, TfpgColor($ffe5e5e5), gdVertical); +end; + +function TfpgWin8Style.GetButtonBorders: TRect; +begin + Result := Rect(2, 2, 2, 2); +end; + +procedure TfpgWin8Style.DrawStaticComboBox(ACanvas: TfpgCanvas; r: TfpgRect; + const IsEnabled: Boolean; const IsFocused: Boolean; + const IsReadOnly: Boolean; const ABackgroundColor: TfpgColor; + const AInternalBtnRect: TfpgRect; const ABtnPressed: Boolean); +var + ar: TfpgRect; +begin + //if IsEnabled then + // ACanvas.SetColor(TfpgColor($ffacacac)) + //else + // ACanvas.SetColor(TfpgColor($ffacacac)); + ACanvas.GradientFill(r, clWindowBackground, clChoiceListBox, gdVertical); + + // paint arrow + ACanvas.SetColor(clShadow2); + ar := AInternalBtnRect; + { The bounding rectangle for the arrow } + ar.Width := 8; + ar.Height := 6; + ar.Left := AInternalBtnRect.Left + ((AInternalBtnRect.Width-ar.Width) div 2); + ar.Top := AInternalBtnRect.Top + ((AInternalBtnRect.Height-ar.Height) div 2); + DrawDirectionArrow(ACanvas, ar.Left, ar.Top, ar.Width, ar.Height, adDown); +end; + +procedure TfpgWin8Style.DrawCheckbox(ACanvas: TfpgCanvas; x, y: TfpgCoord; ix, iy: TfpgCoord); +var + img: TfpgImage; + size: integer; +begin + img := FImages.GetImage('win8.checkboxes'); // Do NOT localize - return value is a reference only + size := GetCheckBoxSize; + ACanvas.DrawImagePart(x, y, img, ix, iy, size, size); +end; + + +initialization + fpgStyleManager.RegisterClass('win8', TfpgWin8Style); + +end. + diff --git a/src/gui/fpg_stylemanager.pas b/src/gui/fpg_stylemanager.pas index de49d5a7..a4d47a36 100644 --- a/src/gui/fpg_stylemanager.pas +++ b/src/gui/fpg_stylemanager.pas @@ -25,6 +25,7 @@ interface uses Classes ,Contnrs + ,fpg_base ,fpg_main ; @@ -67,6 +68,7 @@ type function CreateInstance: TfpgStyle; overload; procedure FreeStyleInstance; procedure AssignStyleTypes(const AStrings: TStrings); + function StyleTypesAsString: TfpgString; end; @@ -203,6 +205,19 @@ begin AStrings.Add(TfpgStyleClassMapping(FList.Items[i]).MappingName); end; +function TfpgStyleManager.StyleTypesAsString: TfpgString; +var + i: integer; + s: string; +begin + for i := 0 to FList.Count - 1 do + begin + if i > 0 then + s := ', '; + Result := Result + s + '"' + TfpgStyleClassMapping(FList.Items[i]).MappingName + '"'; + end; +end; + finalization uStyleManager.Free; diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas index 5ef82248..29addb12 100644 --- a/src/gui/fpg_tab.pas +++ b/src/gui/fpg_tab.pas @@ -183,6 +183,10 @@ implementation uses fpg_stringutils; + +const + DFL_TAB_HEIGHT = 21; + DFL_TAB_WIDTH = 0; // compare function used by FPages.Sort @@ -532,7 +536,7 @@ procedure TfpgPageControl.SetFixedTabWidth(const AValue: integer); begin if FFixedTabWidth = AValue then Exit; //==> - if AValue > 5 then + if AValue >= 5 then begin FFixedTabWidth := AValue; RePaint; @@ -543,7 +547,7 @@ procedure TfpgPageControl.SetFixedTabHeight(const AValue: integer); begin if FFixedTabHeight = AValue then Exit; //==> - if AValue > 5 then + if AValue >= 5 then begin FFixedTabHeight := AValue; RePaint; @@ -630,6 +634,11 @@ begin if FTabPosition = AValue then Exit; //==> FTabPosition := AValue; + if FTabPosition = tpNone then + begin + FLeftButton.Visible := False; + FRightButton.Visible := False; + end; RePaint; end; @@ -669,6 +678,8 @@ begin if Mode = 2 then begin r.Height -= 1; + if TabPosition = tpBottom then + r.Top += 1; Canvas.SetColor(ActiveTabColor); end else @@ -691,22 +702,27 @@ begin tpBottom: begin - Canvas.FillRectangle(r.Left, r.Top+1, r.Width-2, r.Height-3); // fill tab background + Canvas.FillRectangle(r.Left, r.Top, r.Width-1, r.Height-2); // fill tab background Canvas.SetColor(clHilite2); Canvas.DrawLine(r.Left, r.Top, r.Left, r.Bottom-1); // left edge Canvas.SetColor(clShadow2); Canvas.DrawLine(r.Left+2, r.Bottom, r.Right-1, r.Bottom); // bottom outer edge Canvas.SetColor(clShadow1); - Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right-1, r.Top+1); // right inner edge + Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right-1, r.Top-1); // right inner edge Canvas.DrawLine(r.Left+1, r.Bottom-1, r.Right-1, r.Bottom-1);// bottom inner edge Canvas.SetColor(clShadow2); Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right, r.Bottom-2); // right rounded edge (1px) - Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top+1); // right outer edge + 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); + Canvas.DrawLine(r.Left+1, r.Top-1, r.Right-1, r.Top-1); + end; end; tpLeft: begin - if Mode = 2 then + if Mode = 2 then { selected tab } begin r.Width := r.Width - 1; r.Height := r.Height + 2; @@ -797,7 +813,7 @@ end; procedure TfpgPageControl.RePaintTitles; const - TabHeight = 21; + TAB_HEIGHT = 21; var TabW, TabH: Integer; r2: TfpgRect; @@ -820,7 +836,7 @@ begin TabH:=FixedTabHeight; ActivePageVisible := false; If TabH = 0 then - TabH := TabHeight; + TabH := TAB_HEIGHT; h := TfpgTabSheet(FPages.First); if h = nil then Exit; //==> @@ -913,27 +929,27 @@ begin begin lTxtFlags += TextFlagsDflt; lp := 0; - r2.SetRect(2, Height - ButtonHeight-3, 50, 21); + r2.SetRect(2, Height - ButtonHeight, 50, TabH-2); while h <> nil do begin if h <> ActivePage then begin - toffset := 2; + toffset := 1; h.Visible := False; end else begin - toffset := 4; + toffset := 2; h.Visible := True; - h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - r2.Height - (FMargin+2)*2); + h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - TabH - (FMargin+2)*2); end; // paint tab button r2.Width := ButtonWidth(h.Text); r3 := DrawTab(r2, h = ActivePage); // paint text on non-active tabs if h <> ActivePage then - Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, - Height-r2.Height-toffset, GetTabText(h.Text), lTxtFlags); + Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, + Height-TabH+toffset, GetTabText(h.Text), lTxtFlags); r2.Left := r2.Left + r2.Width; lp := lp + ButtonWidth(h.Text); @@ -946,7 +962,7 @@ begin r2.Left := 0; r2.Top := 0; r2.Width := Width; - r2.Height := Height - r2.Height; + r2.Height := Height - TabH; Canvas.DrawButtonFace(r2, []); // Draw text of ActivePage, because we didn't before. DrawTab(r3, false, 2); @@ -957,7 +973,7 @@ begin begin lTxtFlags += TextFlagsDflt; lp := 0; - r2.SetRect(2, 2, 50, 21); + r2.SetRect(2, 2, 50, TabH); while h <> nil do begin if h <> ActivePage then @@ -974,7 +990,6 @@ begin // paint tab button r2.Width := ButtonWidth(h.Text); r3 := DrawTab(r2, h = ActivePage); - // paint text on non-active tabs if h <> ActivePage then Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, @@ -1003,7 +1018,7 @@ begin lTxtFlags += [txtVCenter, txtLeft]; lp := 0; TabW := MaxButtonWidth; - r2.SetRect(Width - 2 - TabW, 2, TabW, 21); + r2.SetRect(Width - 2 - TabW, 2, TabW, TabH); while h <> nil do begin if h <> ActivePage then @@ -1048,7 +1063,7 @@ begin lTxtFlags += [txtVCenter, txtLeft]; lp := 0; TabW := MaxButtonWidth; - r2.SetRect(2, 2, TabW, 21); + r2.SetRect(2, 2, TabW, TabH); while h <> nil do begin if h <> ActivePage then diff --git a/src/gui/fpg_trackbar.pas b/src/gui/fpg_trackbar.pas index ad997817..32da0b99 100644 --- a/src/gui/fpg_trackbar.pas +++ b/src/gui/fpg_trackbar.pas @@ -138,6 +138,12 @@ type property OnChange; property OnEnter; property OnExit; + property OnKeyPress; + property OnMouseDown; + property OnMouseEnter; + property OnMouseExit; + property OnMouseMove; + property OnMouseUp; property OnShowHint; end; @@ -439,7 +445,7 @@ begin if Orientation = orVertical then begin - if (y >= Width + FSliderPos) and (y <= Width + FSliderPos + FSliderLength) then + if (y >= FSliderPos) and (y <= FSliderPos + FSliderLength) then begin FSliderDragging := True; FSliderDragPos := y; @@ -516,8 +522,6 @@ begin if newp <> FPosition then begin Position := newp; - RePaint; - DoChange; end; end; @@ -571,12 +575,20 @@ begin if Orientation = orVertical then begin - Canvas.DrawButtonFace(0, Width + FSliderPos, Width, FSliderLength, [btfIsEmbedded]); + r.SetRect((Width-4) div 2, 1, 4, Height {- tw} - 4); + fpgStyle.DrawControlFrame(Canvas, r); + r.SetRect((Width-20) div 2, FSliderPos, 21, FSliderLength); + Canvas.DrawButtonFace(r, []); + //if FShowPosition then + //begin + // Canvas.SetTextColor(TextColor); + // fpgStyle.DrawString(Canvas, Width - tw, (Height - FFont.Height) div 2, IntToStr(Position), Enabled); + //end; end else begin r.SetRect(1, (Height-4) div 2, Width - tw - 4, 4); - Canvas.DrawControlFrame(r); + fpgStyle.DrawControlFrame(Canvas, r); r.SetRect(FSliderPos, (Height-20) div 2, FSliderLength, 21); Canvas.DrawButtonFace(r, []); if FShowPosition then diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index 8935ec36..7da5205c 100644 --- a/src/gui/fpg_tree.pas +++ b/src/gui/fpg_tree.pas @@ -84,7 +84,6 @@ type FText: TfpgString; FTextColor: TfpgColor; FHasChildren: Boolean; - FTree: TfpgTreeView; procedure SetCollapsed(const AValue: boolean); procedure SetInactSelColor(const AValue: TfpgColor); procedure SetInactSelTextColor(const AValue: TfpgColor); @@ -97,8 +96,11 @@ type procedure SetHasChildren(const AValue: Boolean); procedure DoTreeCheck(ANode: TfpgTreeNode); procedure SetStateImageIndex(const AValue: integer); + protected + FTree: TfpgTreeView; public - constructor Create; + constructor Create; overload; + constructor Create(ATreeView: TfpgTreeView; AText: TfpgString); overload; destructor Destroy; override; // node related function AppendText(AText: TfpgString): TfpgTreeNode; @@ -133,6 +135,7 @@ type property Parent: TfpgTreeNode read FParent write SetParent; property Prev: TfpgTreeNode read FPrev write FPrev; property Text: TfpgString read FText write SetText; + property TreeView: TfpgTreeView read FTree; { determines the + or - image in the treeview } property HasChildren: Boolean read FHasChildren write SetHasChildren; // color settings @@ -273,10 +276,10 @@ type implementation -{.$IFDEF DEBUG} +{$IFDEF DEBUG} uses - dbugintf; -{.$ENDIF} + fpg_dbugintf; +{$ENDIF} type PColumnLeft = ^integer; @@ -394,7 +397,8 @@ begin FData := nil; FFirstSubNode := nil; FLastSubNode := nil; - FText := ''; + FText := ''; + FTree := nil; FImageIndex := -1; FStateImageIndex := -1; FCollapsed := True; @@ -411,6 +415,13 @@ begin FInactSelTextColor := clUnset; end; +constructor TfpgTreeNode.Create(ATreeView: TfpgTreeView; AText: TfpgString); +begin + Create; + FText := AText; + FTree := ATreeView; +end; + destructor TfpgTreeNode.Destroy; begin if FParent <> nil then diff --git a/src/gui/inputintegerdialog.inc b/src/gui/inputintegerdialog.inc new file mode 100644 index 00000000..237fb549 --- /dev/null +++ b/src/gui/inputintegerdialog.inc @@ -0,0 +1,157 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit contains the Input Query dialogs. +} + +{%mainunit fpg_dialogs.pas} + +{$IFDEF read_interface} + +type + + TfpgIntegerDialog = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: fpgIntegerDialog} + lblText: TfpgLabel; + edtInteger: TfpgEditInteger; + btnOK: TfpgButton; + btnCancel: TfpgButton; + {@VFD_HEAD_END: fpgIntegerDialog} + procedure SetupCaptions; + procedure edtIntegerKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + protected + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + public + procedure AfterCreate; override; + end; + + +{$ENDIF read_interface} + +{$IFDEF read_implementation} + +function fpgIntegerQuery(const ACaption, APrompt: TfpgString; var Value: Integer; const MaxValue: Integer; const MinValue: Integer): Boolean; +var + dlg: TfpgIntegerDialog; +begin + dlg := TfpgIntegerDialog.Create(nil); + try + dlg.WindowTitle := ACaption; + dlg.lblText.Text := APrompt; + dlg.edtInteger.MaxValue:= MaxValue; + dlg.edtinteger.MinValue:= MinValue; + dlg.edtInteger.Value := Value; + Result := dlg.ShowModal = mrOK; + if Result then + Value := dlg.edtInteger.Value; + finally + dlg.Free; + end; +end; + +{ TfpgIntegerDialog } + +procedure TfpgIntegerDialog.SetupCaptions; +begin + btnOK.Text := rsOK; + btnCancel.Text := rsCancel; +end; + +procedure TfpgIntegerDialog.edtIntegerKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); +begin + if KeyCode = keyEnter then + btnOK.Click; +end; + +procedure TfpgIntegerDialog.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +begin + if KeyCode = keyEscape then + begin + consumed := True; + ModalResult := mrCancel; + end; +end; + +procedure TfpgIntegerDialog.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: fpgIntegerDialog} + Name := 'fpgIntegerDialog'; + SetPosition(100, 150, 208, 97); + WindowTitle := 'IntegerDialog'; + Hint := ''; + WindowPosition := wpOneThirdDown; + + lblText := TfpgLabel.Create(self); + with lblText do + begin + Name := 'lblText'; + SetPosition(8, 8, 208, 16); + Anchors := [anLeft,anRight,anTop]; + FontDesc := '#Label1'; + Hint := ''; + Text := 'lblText'; + end; + + edtInteger := TfpgEditInteger.Create(self); + with edtInteger do + begin + Name := 'edtInteger'; + SetPosition(8, 26, 100, 24); + Anchors := [anLeft,anRight,anTop]; + Hint := ''; + TabOrder := 2; + Text := ''; + FontDesc := '#Edit1'; + Value := 0; + OnKeyPress := @edtIntegerKeyPressed; + end; + + btnOK := TfpgButton.Create(self); + with btnOK do + begin + Name := 'btnOK'; + SetPosition(8, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'OK'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrOK; + TabOrder := 3; + end; + + btnCancel := TfpgButton.Create(self); + with btnCancel do + begin + Name := 'btnCancel'; + SetPosition(108, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'Cancel'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrCancel; + TabOrder := 4; + end; + + {@VFD_BODY_END: fpgIntegerDialog} + {%endregion} + + SetupCaptions; +end; + +{$ENDIF read_implementation} + diff --git a/src/gui/inputquerydialog.inc b/src/gui/inputquerydialog.inc index 6330d02c..b41af217 100644 --- a/src/gui/inputquerydialog.inc +++ b/src/gui/inputquerydialog.inc @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 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/gui/messagedialog.inc b/src/gui/messagedialog.inc index 0e04541d..db894f6d 100644 --- a/src/gui/messagedialog.inc +++ b/src/gui/messagedialog.inc @@ -262,7 +262,6 @@ var y: integer; tw: integer; begin - Canvas.BeginDraw; inherited HandlePaint; case FDialogType of mtAbout: @@ -312,7 +311,6 @@ begin Inc(y, FLineHeight); end; end; - Canvas.EndDraw; end; procedure TfpgMessageDialog.HandleShow; diff --git a/tools/imageconvert/extrafpc.cfg b/tools/imageconvert/extrafpc.cfg new file mode 100644 index 00000000..7e5a5fd8 --- /dev/null +++ b/tools/imageconvert/extrafpc.cfg @@ -0,0 +1,9 @@ +-FUunits +-Fu../../lib/$fpctarget +-Xs +-XX +-CX +#ifdef mswindows +-WG +#endif + diff --git a/tools/makefont/makefonts.lpi b/tools/makefont/makefonts.lpi new file mode 100644 index 00000000..1e365c4d --- /dev/null +++ b/tools/makefont/makefonts.lpi @@ -0,0 +1,70 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="makefonts"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="makefonts.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="."/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <AllowLabel Value="False"/> + </SyntaxOptions> + </Parsing> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/tools/makefont/makefonts.lpr b/tools/makefont/makefonts.lpr new file mode 100644 index 00000000..c54918ea --- /dev/null +++ b/tools/makefont/makefonts.lpr @@ -0,0 +1,26 @@ +program makefonts; + +{$mode objfpc}{$H+} + +uses + Classes, + fpg_main, u_main, u_parsettf, u_data ; + +{.$R *.res} + +procedure MainProc; +begin +fpgApplication.Initialize; +F_MainForm:= TF_MainForm.Create(nil); +try + F_MainForm.Show; + fpgApplication.Run; +finally + F_MainForm.Free; + end; +end; + +begin +MainProc; +end. + diff --git a/tools/makefont/readme.txt b/tools/makefont/readme.txt new file mode 100644 index 00000000..ccb25d4e --- /dev/null +++ b/tools/makefont/readme.txt @@ -0,0 +1,43 @@ +------[Forwarded message from Jean-Marc Levecque]------ + +Hi, + +Here is a first step in embedding true type fonts in the report tool. + +Attached is a set of patches for u_pdf and u_demo to show how it works. + +In addition, I wrote a utility to create the definition file for any ttf +file, called makefonts. I gave the *.fnt extension to the generated font +definition file. + +A major problem is to compress the ttf file. +From the site fpdf.org, I found a way to get this compressed file done +by use of the zlib library. +If anybody knows how to do the equivalent compression using fpc, that +would be really great. +For now, on this site, going to Tutorials>Tutorial 7, then down to see +the link to "on line", one can select a ttf file, choose the encoding +and download the *.z file which is the compressed embeddable file for pdf. + +To simplify the tests, I have attached the *.fnt and *.z files for all +DejaVu and Liberation fonts I have on my distribution. These files can +be put anywhere, as the demo requires to select the directoy containing +them. +They are all encoded with cp1252 which is a Microsoft extension of +ISO-8859-1, and it would be easy to get any other encoding. + +I also tried to use Microsoft Comic font, but despite they are installed +on my PC, they do not show up correctly in the preview, while due to the +embedding, they display correctly in pdf. + +Trying to embed uncompressed ttf files does not seem to work, but as per +pdf specification, it should. I must have missed something :( + +Another tool may be used if one wants to use a font from a different +format: from the site freeconverter.com, it is possible to convert a +font file from a format to another one, with a large choice of formats. + +Remember that font licence may not allow embedding. + +Best regards +Jean-Marc diff --git a/tools/makefont/u_data.pas b/tools/makefont/u_data.pas new file mode 100644 index 00000000..bb2ae980 --- /dev/null +++ b/tools/makefont/u_data.pas @@ -0,0 +1,2053 @@ +unit u_data; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils; + +const + cp874_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', 'ellipsis', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'kokaithai', 'khokhaithai', 'khokhuatthai', // A0 to A3 + 'khokhwaithai', 'khokhonthai', 'khorakhangthai', 'ngonguthai', // A4 to A7 + 'chochanthai', 'chochingthai', 'chochangthai', 'sosothai', // A8 to AB + 'chochoethai', 'yoyingthai', 'dochadathai', 'topatakthai', // AC to AF + 'thothanthai', 'thonangmonthothai','thophuthaothai', 'nonenthai', // B0 to B3 + 'dodekthai', 'totaothai', 'thothungthai', 'thothahanthai', // B4 to B7 + 'thothongthai', 'nonuthai', 'bobaimaithai', 'poplathai', // B8 to BB + 'phophungthai', 'fofathai', 'phophanthai', 'fofanthai', // BC to BF + 'phosamphaothai', 'momathai', 'yoyakthai', 'roruathai', // C0 to C3 + 'ruthai', 'lolingthai', 'luthai', 'wowaenthai', // C4 to C7 + 'sosalathai', 'sorusithai', 'sosuathai', 'hohipthai', // C8 to CB + 'lochulathai', 'oangthai', 'honokhukthai', 'paiyannoithai', // CC to CF + 'saraathai', 'maihanakatthai', 'saraaathai', 'saraamthai', // D0 to D3 + 'saraithai', 'saraiithai', 'sarauethai', 'saraueethai', // D4 to D7 + 'sarauthai', 'sarauuthai', 'phinthuthai', '.notdef', // D8 to DB + '.notdef', '.notdef', '.notdef', 'bahtthai', // DC to DF + 'saraethai', 'saraaethai', 'saraothai', 'saraaimaimuanthai', // E0 to E3 + 'saraaimaimalaithai','lakkhangyaothai', 'maiyamokthai', 'maitaikhuthai', // E4 to E7 + 'maiekthai', 'maithothai', 'maitrithai', 'maichattawathai', // E8 to EB + 'thanthakhatthai', 'nikhahitthai', 'yamakkanthai', 'fongmanthai', // EC to EF + 'zerothai', 'onethai', 'twothai', 'threethai', // F0 to F3 + 'fourthai', 'fivethai', 'sixthai', 'seventhai', // F4 to F7 + 'eightthai', 'ninethai', 'angkhankhuthai', 'khomutthai', // F8 to FB + '.notdef', '.notdef', '.notdef', '.notdef'); // FC to FF + +const + cp874_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, -1, -1, -1, 8230, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 3585, 3586, 3587, 3588, 3589, 3590, 3591, // A0 to A7 + 3592, 3593, 3594, 3595, 3596, 3597, 3598, 3599, // A8 to AF + 3600, 3601, 3602, 3603, 3604, 3605, 3606, 3607, // B0 to B7 + 3608, 3609, 3610, 3611, 3612, 3613, 3614, 3615, // B8 to BF + 3616, 3617, 3618, 3619, 3620, 3621, 3622, 3623, // C0 to C7 + 3624, 3625, 3626, 3627, 3628, 3629, 3630, 3631, // C8 to CF + 3632, 3633, 3634, 3635, 3636, 3637, 3638, 3639, // D0 to D7 + 3640, 3641, 3642, -1, -1, -1, -1, 3647, // D8 to DF + 3648, 3649, 3650, 3651, 3652, 3653, 3654, 3655, // E0 to E7 + 3656, 3657, 3658, 3659, 3660, 3661, 3662, 3663, // E8 to EF + 3664, 3665, 3666, 3667, 3668, 3669, 3670, 3671, // F0 to F7 + 3672, 3673, 3674, 3675, -1, -1, -1, -1); // F8 to FF + +const + cp1250_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', '.notdef', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + '.notdef', 'perthousand', 'Scaron', 'guilsinglleft', // 88 to 8B + 'Sacute', 'Tcaron', 'Zcaron', 'Zacute', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + '.notdef', 'trademark', 'scaron', 'guilsinglright', // 98 to 9B + 'sacute', 'tcaron', 'zcaron', 'zacute', // 9C to 9F + 'space', 'caron', 'breve', 'Lslash', // A0 to A3 + 'currency', 'Aogonek', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'Scedilla', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'Zdotaccent', // AC to AF + 'degree', 'plusminus', 'ogonek', 'lslash', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'aogonek', 'scedilla', 'guillemotright', // B8 to BB + 'Lcaron', 'hungarumlaut', 'lcaron', 'zdotaccent', // BC to BF + 'Racute', 'Aacute', 'Acircumflex', 'Abreve', // C0 to C3 + 'Adieresis', 'Lacute', 'Cacute', 'Ccedilla', // C4 to C7 + 'Ccaron', 'Eacute', 'Eogonek', 'Edieresis', // C8 to CB + 'Ecaron', 'Iacute', 'Icircumflex', 'Dcaron', // CC to CF + 'Dcroat', 'Nacute', 'Ncaron', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Ohungarumlaut','Odieresis', 'multiply', // D4 to D7 + 'Rcaron', 'Uring', 'Uacute', 'Uhungarumlaut', // D8 to DB + 'Udieresis', 'Yacute', 'Tcommaaccent', 'germandbls', // DC to DF + 'racute', 'aacute', 'acircumflex', 'abreve', // E0 to E3 + 'adieresis', 'lacute', 'cacute', 'ccedilla', // E4 to E7 + 'ccaron', 'eacute', 'eogonek', 'edieresis', // E8 to EB + 'ecaron', 'iacute', 'icircumflex', 'dcaron', // EC to EF + 'dcroat', 'nacute', 'ncaron', 'oacute', // F0 to F3 + 'ocircumflex', 'ohungarumlaut','odieresis', 'divide', // F4 to F7 + 'rcaron', 'uring', 'uacute', 'uhungarumlaut', // F8 to FB + 'udieresis', 'yacute', 'tcommaaccent', 'dotaccent'); // FC to FF + +const + cp1250_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, -1, 8222, 8230, 8224, 8225, // 80 to 87 + -1, 8240, 352, 8249, 346, 356, 381, 377, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + -1, 8482, 353, 8250, 347, 357, 382, 378, // 98 to 9F + 160, 711, 728, 321, 164, 260, 166, 167, // A0 to A7 + 168, 169, 350, 171, 172, 173, 174, 379, // A8 to AF + 176, 177, 731, 322, 180, 181, 182, 183, // B0 to B7 + 184, 261, 351, 187, 317, 733, 318, 380, // B8 to BF + 340, 193, 194, 258, 196, 313, 262, 199, // C0 to C7 + 268, 201, 280, 203, 282, 205, 206, 270, // C8 to CF + 272, 323, 327, 211, 212, 336, 214, 215, // D0 to D7 + 344, 366, 218, 368, 220, 221, 354, 354, // D8 to DF + 341, 225, 226, 259, 228, 314, 263, 231, // E0 to E7 + 269, 233, 281, 235, 283, 237, 238, 271, // E8 to EF + 273, 324, 328, 243, 244, 337, 246, 247, // F0 to F7 + 345, 367, 250, 369, 252, 253, 355, 729); // F8 to FF + +const + cp1251_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'afii10051', 'afii10052', 'quotesinglbase', 'afii10100', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + 'Euro', 'perthousand', 'afii10058', 'guilsinglleft', // 88 to 8B + 'afii10059', 'afii10061', 'afii10060', 'afii10145', // 8C to 8F + 'afii10099', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + '.notdef', 'trademark', 'afii10106', 'guilsinglright', // 98 to 9B + 'afii10107', 'afii10109', 'afii10108', 'afii10193', // 9C to 9F + 'space', 'afii10062', 'afii10110', 'afii10057', // A0 to A3 + 'currency', 'afii10050', 'brokenbar', 'section', // A4 to A7 + 'afii10023', 'copyright', 'afii10053', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'afii10056', // AC to AF + 'degree', 'plusminus', 'afii10055', 'afii10103', // B0 to B3 + 'afii10098', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'afii10071', 'afii61352', 'afii10101', 'guillemotright', // B8 to BB + 'afii10105', 'afii10054', 'afii10102', 'afii10104', // BC to BF + 'afii10017', 'afii10018', 'afii10019', 'afii10020', // C0 to C3 + 'afii10021', 'afii10022', 'afii10024', 'afii10025', // C4 to C7 + 'afii10026', 'afii10027', 'afii10028', 'afii10029', // C8 to CB + 'afii10030', 'afii10031', 'afii10032', 'afii10033', // CC to CF + 'afii10034', 'afii10035', 'afii10036', 'afii10037', // D0 to D3 + 'afii10038', 'afii10039', 'afii10040', 'afii10041', // D4 to D7 + 'afii10042', 'afii10043', 'afii10044', 'afii10045', // D8 to DB + 'afii10046', 'afii10047', 'afii10048', 'afii10049', // DC to DF + 'afii10065', 'afii10066', 'afii10067', 'afii10068', // E0 to E3 + 'afii10069', 'afii10070', 'afii10072', 'afii10073', // E4 to E7 + 'afii10074', 'afii10075', 'afii10076', 'afii10077', // E8 to EB + 'afii10078', 'afii10079', 'afii10080', 'afii10081', // EC to EF + 'afii10082', 'afii10083', 'afii10084', 'afii10085', // F0 to F3 + 'afii10086', 'afii10087', 'afii10088', 'afii10089', // F4 to F7 + 'afii10090', 'afii10091', 'afii10092', 'afii10093', // F8 to FB + 'afii10094', 'afii10095', 'afii10095', 'afii10097'); // FC to FF + +const + cp1251_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 1026, 1027, 8218, 1107, 8222, 8230, 8224, 8225, // 80 to 87 + 8364, 8240, 1033, 8249, 1034, 1036, 1035, 1039, // 88 to 8F + 1106, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + -1, 8482, 1113, 8250, 1114, 1116, 1115, 1119, // 98 to 9F + 160, 1038, 1118, 1032, 164, 1168, 166, 167, // A0 to A7 + 1025, 169, 1028, 171, 172, 173, 174, 1031, // A8 to AF + 176, 177, 1030, 1110, 1169, 181, 182, 183, // B0 to B7 + 1105, 8470, 1108, 187, 1112, 1029, 1109, 1111, // B8 to BF + 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, // C0 to C7 + 1048, 1049, 1050, 1051, 1052, 1053, 1054, 1055, // C8 to CF + 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1063, // D8 to D7 + 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, // D8 to DF + 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, // E0 to E7 + 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, // E8 to EF + 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, // F0 to F7 + 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103); // F8 to FF + +const + cp1252_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', 'florin', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + 'circumflex', 'perthousand', 'Scaron', 'guilsinglleft', // 88 to 8B + 'OE', '.notdef', 'Zcaron', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + 'tilde', 'trademark', 'scaron', 'guilsinglright', // 98 to 9B + 'oe', '.notdef', 'zcaron', 'Ydieresis', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'onesuperior', 'ordmasculine', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters', 'questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Eth', 'Ntilde', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Yacute', 'Thorn', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'eth', 'ntilde', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'yacute', 'thorn', 'ydieresis'); // FC to FF + +const + cp1252_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, 402, 8222, 8230, 8224, 8225, // 80 to 87 + 710, 8240, 352, 8249, 338, -1, 381, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + 732, 8482, 353, 8250, 339, -1, 382, 376, // 98 to 9F + 160, 161, 162, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 186, 187, 188, 189, 190, 191, // B8 to BF + 192, 193, 194, 195, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 208, 209, 210, 211, 212, 213, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 221, 222, 223, // D8 to DF + 224, 225, 226, 227, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 240, 241, 242, 243, 244, 245, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 253, 254, 255); // F8 to FF + +const + cp1253_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', 'florin', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + '.notdef', 'perthousand', '.notdef', 'guilsinglleft', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + '.notdef', 'trademark', '.notdef', 'guilsinglright', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'dieresistonos','Alphatonos', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', '.notdef', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'afii00208', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'tonos', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'Epsilontonos', 'Etatonos', 'Iotatonos', 'guillemotright', // B8 to BB + 'Omicrontonos', 'onehalf', 'Upsilontonos', 'Omegatonos', // BC to BF + 'iotadieresistonos', 'Alpha', 'Beta', 'Gamma', // C0 to C3 + 'Delta', 'Epsilon', 'Zeta', 'Eta', // C4 to C7 + 'Theta', 'Iota', 'Kappa', 'Lambda', // C8 to CB + 'Mu', 'Nu', 'Xi', 'Omicron', // CC to CF + 'Pi', 'Rho', '.notdef', 'Sigma', // D0 to D3 + 'Tau', 'Upsilon', 'Phi', 'Chi', // D4 to D7 + 'Psi', 'Omega', 'Iotadieresis', 'Upsilondieresis', // D8 to DB + 'alphatonos', 'epsilontonos', 'etatonos', 'iotatonos', // DC to DF + 'upsilondieresistonos','alpha', 'beta', 'gamma', // E0 to E3 + 'delta', 'epsilon', 'zeta', 'eta', // E4 to E7 + 'theta', 'iota', 'kappa', 'lambda', // E8 to EB + 'mu', 'nu', 'xi', 'omicron', // EC to EF + 'pi', 'rho', 'sigma1', 'sigma', // F0 to F3 + 'tau', 'upsilon', 'phi', 'chi', // F4 to F7 + 'psi', 'omega', 'iotadieresis', 'upsilondieresis', // F8 to FB + 'omicrontonos', 'upsilontonos', 'omegatonos', '.notdef'); // FC to FF + +const + cp1253_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, 402, 8222, 8230, 8224, 8225, // 80 to 87 + -1, 8240, -1, 8249, -1, -1, -1, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + -1, 8482, -1, 8250, -1, -1, -1, -1, // 98 to 9F + 160, 901, 902, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, -1, 171, 172, 173, 174, 8213, // A8 to AF + 176, 177, 178, 179, 900, 181, 182, 183, // B0 to B7 + 904, 905, 906, 187, 908, 189, 910, 911, // B8 to BF + 912, 913, 914, 915, 916, 917, 918, 919, // C0 to C7 + 920, 921, 922, 923, 924, 925, 926, 927, // C8 to CF + 928, 929, -1, 931, 932, 933, 934, 935, // D0 to D7 + 936, 937, 938, 939, 940, 941, 942, 943, // D8 to DF + 944, 945, 946, 947, 948, 949, 950, 951, // E0 to E7 + 952, 953, 954, 955, 956, 957, 958, 959, // E8 to EF + 960, 961, 962, 963, 964, 965, 966, 967, // F0 to F7 + 968, 969, 970, 971, 972, 973, 974, -1); // F8 to FF + +const + cp1254_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', 'florin', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + 'circumflex', 'perthousand', 'Scaron', 'guilsinglleft', // 88 to 8B + 'OE', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + 'tilde', 'trademark', 'scaron', 'guilsinglright', // 98 to 9B + 'oe', '.notdef', '.notdef', 'Ydieresis', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'onesuperior','ordmasculine', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters', 'questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Gbreve', 'Ntilde', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Idotaccent', 'Scedilla', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'gbreve', 'ntilde', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'dotlessi', 'scedilla', 'ydieresis'); // FC to FF + +const + cp1254_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, 402, 8222, 8230, 8224, 8225, // 80 to 87 + 710, 8240, 352, 8249, 338, -1, -1, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + 732, 8482, 353, 8250, 339, -1, -1, 376, // 98 to 9F + 160, 161, 162, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 186, 187, 188, 189, 190, 191, // B8 to BF + 192, 193, 194, 195, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 286, 209, 210, 211, 212, 213, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 304, 350, 223, // D8 to DF + 224, 225, 226, 227, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 287, 241, 242, 243, 244, 245, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 305, 351, 255); // F8 to FF + +const + cp1255_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', 'florin', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + 'circumflex', 'perthousand', '.notdef', 'guilsinglleft', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + 'tilde', 'trademark', '.notdef', 'guilsinglright', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'afii57636', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'multiply', 'guillemotleft', // A8 to AB + 'logicalnot', 'sfthyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'middot', // B4 to B7 + 'cedilla', 'onesuperior', 'divide', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters', 'questiondown', // BC to BF + 'afii57799', 'afii57801', 'afii57800', 'afii57802', // C0 to C3 + 'afii57793', 'afii57794', 'afii57795', 'afii57798', // C4 to C7 + 'afii57797', 'afii57806', '.notdef', 'afii57796', // C8 to CB + 'afii57807', 'afii57839', 'afii57645', 'afii57841', // CC to CF + 'afii57842', 'afii57804', 'afii57803', 'afii57658', // D0 to D3 + 'afii57716', 'afii57717', 'afii57718', 'gereshhebrew', // D4 to D7 + 'gershayimhebrew', '.notdef', '.notdef', '.notdef', // D8 to DB + '.notdef', '.notdef', '.notdef', '.notdef', // DC to DF + 'afii57664', 'afii57665', 'afii57666', 'afii57667', // E0 to E3 + 'afii57668', 'afii57669', 'afii57670', 'afii57671', // E4 to E7 + 'afii57672', 'afii57673', 'afii57674', 'afii57675', // E8 to EB + 'afii57676', 'afii57677', 'afii57678', 'afii57679', // EC to EF + 'afii57680', 'afii57681', 'afii57682', 'afii57683', // F0 to F3 + 'afii57684', 'afii57685', 'afii57686', 'afii57687', // F4 to F7 + 'afii57688', 'afii57689', 'afii57690', '.notdef', // F8 to FB + '.notdef', 'afii299', 'afii300', '.notdef'); // FC to FF + +const + cp1255_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, 402, 8222, 8230, 8224, 8225, // 80 to 87 + 710, 8240, -1, 8249, -1, -1, -1, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + 732, 8482, -1, 8250, -1, -1, -1, -1, // 98 to 9F + 160, 161, 162, 163, 8362, 165, 166, 167, // A0 to A7 + 168, 169, 215, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 247, 187, 188, 189, 190, 191, // B8 to BF + 1456, 1457, 1458, 1459, 1460, 1461, 1462, 1463, // C0 to C7 + 1464, 1465, -1, 1467, 1468, 1469, 1470, 1471, // C8 to CF + 1472, 1473, 1474, 1475, 1520, 1521, 1522, 1523, // D0 to D7 + 1524, -1, -1, -1, -1, -1, -1, -1, // D8 to DF + 1488, 1489, 1490, 1491, 1492, 1493, 1494, 1495, // E0 to E7 + 1496, 1497, 1498, 1499, 1500, 1501, 1502, 1503, // E8 to EF + 1504, 1505, 1506, 1507, 1508, 1509, 1510, 1511, // F0 to F7 + 1512, 1513, 1514, -1, -1, 8206, 8207, -1); // F8 to FF + +const + cp1257_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', '.notdef', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + '.notdef', 'perthousand', '.notdef', 'guilsinglleft', // 88 to 8B + '.notdef', 'dieresis', 'caron', 'cedilla', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + '.notdef', 'trademark', '.notdef', 'guilsinglright', // 98 to 9B + '.notdef', 'macron', 'ogonek', '.notdef', // 9C to 9F + 'space', '.notdef', 'cent', 'sterling', // A0 to A3 + 'currency', '.notdef', 'brokenbar', 'section', // A4 to A7 + 'Oslash', 'copyright', 'Rcommaaccent', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'AE', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'oslash', 'onesuperior', 'rcommaaccent', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters', 'ae', // BC to BF + 'Aogonek', 'Iogonek', 'Amacron', 'Cacute', // C0 to C3 + 'Adieresis', 'Aring', 'Eogonek', 'Emacron', // C4 to C7 + 'Ccaron', 'Eacute', 'Zacute', 'Edotaccent', // C8 to CB + 'Gcommaaccent', 'Kcommaaccent', 'Imacron', 'Lcommaaccent', // CC to CF + 'Scaron', 'Nacute', 'Ncommaaccent', 'Oacute', // D0 to D3 + 'Omacron', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Uogonek', 'Lslash', 'Sacute', 'Umacron', // D8 to DB + 'Udieresis', 'Zdotaccent', 'Zcaron', 'germandbls', // DC to DF + 'aogonek', 'iogonek', 'amacron', 'cacute', // E0 to E3 + 'adieresis', 'aring', 'eogonek', 'emacron', // E4 to E7 + 'ccaron', 'eacute', 'zacute', 'edotaccent', // E8 to EB + 'gcommaaccent', 'kcommaaccent', 'imacron', 'lcommaaccent', // EC to EF + 'scaron', 'nacute', 'ncommaaccent', 'oacute', // F0 to F3 + 'omacron', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'uogonek', 'lslash', 'sacute', 'umacron', // F8 to FB + 'udieresis', 'zdotaccent', 'zcaron', 'dotaccent'); // FC to FF + +const + cp1257_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8364, -1, 8218, -1, 8222, 8230, 8224, 8225, // 80 to 87 + -1, 8240, -1, 8249, -1, 168, 711, 184, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + -1, 8482, -1, 8250, -1, 175, 731, -1, // 98 to 9F + 160, -1, 162, 163, 164, -1, 166, 167, // A0 to A7 + 216, 169, 342, 171, 172, 173, 174, 198, // A0 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 248, 185, 343, 187, 188, 189, 190, 230, // B8 to BF + 260, 302, 256, 262, 196, 197, 280, 274, // C0 to C7 + 268, 201, 377, 278, 290, 310, 298, 315, // C8 to CF + 352, 323, 325, 211, 332, 213, 214, 215, // D0 to D7 + 370, 321, 346, 362, 220, 379, 381, 223, // D8 to DF + 261, 303, 257, 263, 228, 229, 281, 275, // E0 to E7 + 269, 233, 378, 279, 291, 311, 299, 316, // E8 to EF + 353, 324, 326, 243, 333, 245, 246, 247, // F0 to F7 + 371, 322, 347, 363, 252, 380, 382, 729); // F8 to FF + +const + cp1258_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'Euro', '.notdef', 'quotesinglbase', 'florin', // 80 to 83 + 'quotedblbase', 'ellipsis', 'dagger', 'daggerdbl', // 84 to 87 + 'circumflex', 'perthousand', '.notdef', 'guilsinglleft', // 88 to 8B + 'OE', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', 'quoteleft', 'quoteright', 'quotedblleft', // 90 to 93 + 'quotedblright', 'bullet', 'endash', 'emdash', // 94 to 97 + 'tilde', 'trademark', '.notdef', 'guilsinglright', // 98 to 9B + 'oe', '.notdef', '.notdef', 'Ydieresis', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'onesuperior', 'ordmasculine', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters', 'questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Abreve', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'gravecomb', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Dcroat', 'Ntilde', 'hookabovecomb', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Ohorn', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Uhorn', 'tildecomb', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'abreve', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'acutecomb', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'dcroat', 'ntilde', 'dotbelowcomb', 'oacute', // F0 to F3 + 'ocircumflex', 'ohorn', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'uhorn', 'dong', 'ydieresis'); // FC to FF + +const + cp1258_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 8264, -1, 8218, 402, 8222, 8230, 8224, 8225, // 80 to 87 + 710, 8240, -1, 8249, 338, -1, -1, -1, // 88 to 8F + -1, 8216, 8217, 8220, 8221, 8226, 8211, 8212, // 90 to 97 + 732, 8482, -1, 8250, 339, -1, -1, 376, // 98 to 9F + 160, 161, 162, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 186, 187, 188, 189, 190, 191, // B8 to BF + 192, 193, 194, 258, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 768, 205, 206, 207, // C8 to CF + 272, 209, 777, 211, 212, 416, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 431, 771, 223, // D8 to DF + 224, 225, 226, 259, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 769, 237, 238, 239, // E8 to EF + 273, 241, 803, 243, 244, 417, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 432, 8363, 255); // F8 to FF + +const + iso_8859_1_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'onesuperior', 'ordmasculine', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters','questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Eth', 'Ntilde', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Yacute', 'Thorn', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'eth', 'ntilde', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'yacute', 'thorn', 'ydieresis'); // FC to FF + +const + iso_8859_1_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 161, 162, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 186, 187, 188, 189, 190, 191, // B8 to BF + 192, 193, 194, 195, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 208, 209, 210, 211, 212, 213, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 221, 222, 223, // D8 to DF + 224, 225, 226, 227, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 240, 241, 242, 243, 244, 245, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 253, 254, 255); // F8 to FF + +const + iso_8859_2_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'Aogonek', 'breve', 'Lslash', // A0 to A3 + 'currency', 'Lcaron', 'Sacute', 'section', // A4 to A7 + 'dieresis', 'Scaron', 'Scedilla', 'Tcaron', // A8 to AB + 'Zacute', 'hyphen', 'Zcaron', 'Zdotaccent', // AC to AF + 'degree', 'aogonek', 'ogonek', 'lslash', // B0 to B3 + 'acute', 'lcaron', 'sacute', 'caron', // B4 to B7 + 'cedilla', 'scaron', 'scedilla', 'tcaron', // B8 to BB + 'zacute', 'hungarumlaut', 'zcaron', 'zdotaccent', // BC to BF + 'Racute', 'Aacute', 'Acircumflex', 'Abreve', // C0 to C3 + 'Adieresis', 'Lacute', 'Cacute', 'Ccedilla', // C4 to C7 + 'Ccaron', 'Eacute', 'Eogonek', 'Edieresis', // C8 to CB + 'Ecaron', 'Iacute', 'Icircumflex', 'Dcaron', // CC to CF + 'Dcroat', 'Nacute', 'Ncaron', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Ohungarumlaut','Odieresis', 'multiply', // D4 to D7 + 'Rcaron', 'Uring', 'Uacute', 'Uhungarumlaut', // D8 to DB + 'Udieresis', 'Yacute', 'Tcommaaccent', 'germandbls', // DC to DF + 'racute', 'aacute', 'acircumflex', 'abreve', // E0 to E3 + 'adieresis', 'lacute', 'cacute', 'ccedilla', // E4 to E7 + 'ccaron', 'eacute', 'eogonek', 'edieresis', // E8 to EB + 'ecaron', 'iacute', 'icircumflex', 'dcaron', // EC to EF + 'dcroat', 'nacute', 'ncaron', 'oacute', // F0 to F3 + 'ocircumflex', 'ohungarumlaut','odieresis', 'divide', // F4 to F7 + 'rcaron', 'uring', 'uacute', 'uhungarumlaut', // F8 to FB + 'udieresis', 'yacute', 'tcommaaccent', 'dotaccent'); // FC to FF + +const + iso_8859_2_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 260, 728, 321, 164, 317, 346, 167, // A0 to A7 + 168, 352, 350, 356, 377, 173, 381, 379, // A8 to AF + 176, 261, 731, 322, 180, 318, 347, 711, // B0 to B7 + 184, 353, 351, 357, 378, 733, 382, 380, // B8 to BF + 340, 193, 194, 258, 196, 313, 262, 199, // C0 to C7 + 268, 201, 280, 203, 282, 205, 206, 270, // C8 to CF + 272, 323, 327, 211, 212, 336, 214, 215, // D0 to D7 + 344, 366, 218, 368, 220, 221, 354, 223, // D8 to DF + 341, 225, 226, 259, 228, 314, 263, 231, // E0 to E7 + 269, 233, 281, 235, 283, 237, 238, 271, // E8 to EF + 273, 324, 328, 243, 244, 337, 246, 247, // F0 to F7 + 345, 367, 250, 369, 252, 253, 355, 729); // F8 to FF + +const + iso_8859_4_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'Aogonek', 'kgreenlandic', 'Rcommaaccent', // A0 to A3 + 'currency', 'Itilde', 'Lcommaaccent', 'section', // A4 to A7 + 'dieresis', 'Scaron', 'Emacron', 'Gcommaaccent', // A8 to AB + 'Tbar', 'hyphen', 'Zcaron', 'macron', // AC to AF + 'degree', 'aogonek', 'ogonek', 'rcommaaccent', // B0 to B3 + 'acute', 'itilde', 'lcommaaccent', 'caron', // B4 to B7 + 'cedilla', 'scaron', 'emacron', 'gcommaaccent', // B8 to BB + 'tbar', 'Eng', 'zcaron', 'eng', // BC to BF + 'Amacron', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Iogonek', // C4 to C7 + 'Ccaron', 'Eacute', 'Eogonek', 'Edieresis', // C8 to CB + 'Edotaccent', 'Iacute', 'Icircumflex', 'Imacron', // CC to CF + 'Dcroat', 'Ncommaaccent', 'Omacron', 'Kcommaaccent', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Uogonek', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Utilde', 'Umacron', 'germandbls', // DC to DF + 'amacron', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'iogonek', // E4 to E7 + 'ccaron', 'eacute', 'eogonek', 'edieresis', // E8 to EB + 'edotaccent', 'iacute', 'icircumflex', 'imacron', // EC to EF + 'dcroat', 'ncommaaccent', 'omacron', 'kcommaaccent', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'uogonek', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'utilde', 'umacron', 'dotaccent'); // FC to FF + +const + iso_8859_4_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 260, 312, 342, 164, 296, 315, 167, // A4 to A7 + 168, 352, 274, 290, 358, 173, 381, 175, // AC to AF + 176, 261, 731, 343, 180, 297, 316, 711, // B4 to B7 + 184, 353, 275, 291, 359, 330, 382, 331, // BC to BF + 256, 193, 194, 195, 196, 197, 198, 302, // C4 to C7 + 268, 201, 280, 203, 278, 205, 206, 298, // CC to CF + 272, 325, 332, 310, 212, 213, 214, 215, // D4 to D7 + 216, 370, 218, 219, 220, 360, 362, 223, // DC to DF + 257, 225, 226, 227, 228, 229, 230, 303, // E4 to E7 + 269, 233, 281, 235, 279, 237, 238, 299, // EC to EF + 273, 326, 333, 311, 244, 245, 246, 247, // F4 to F7 + 248, 371, 250, 251, 252, 361, 363, 729); // FC to FF + +const + iso_8859_5_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum','underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'afii10023', 'afii10051', 'afii10052', // A0 to A3 + 'afii10053', 'afii10054', 'afii10055', 'afii10056', // A4 to A7 + 'afii10057', 'afii10058', 'afii10059', 'afii10060', // A8 to AB + 'afii10061', 'hyphen', 'afii10062', 'afii10145', // AC to AF + 'afii10017', 'afii10018', 'afii10019', 'afii10020', // B0 to B3 + 'afii10021', 'afii10022', 'afii10024', 'afii10025', // B4 to B7 + 'afii10026', 'afii10027', 'afii10028', 'afii10029', // B8 to BB + 'afii10030', 'afii10031', 'afii10032', 'afii10033', // BC to BF + 'afii10034', 'afii10035', 'afii10036', 'afii10037', // C0 to C3 + 'afii10038', 'afii10039', 'afii10040', 'afii10041', // C4 to C7 + 'afii10042', 'afii10043', 'afii10044', 'afii10045', // C8 to CB + 'afii10046', 'afii10047', 'afii10048', 'afii10049', // CC to CF + 'afii10065', 'afii10065', 'afii10067', 'afii10068', // D0 to D3 + 'afii10069', 'afii10070', 'afii10072', 'afii10073', // D4 to D7 + 'afii10074', 'afii10075', 'afii10076', 'afii10077', // D8 to DB + 'afii10078', 'afii10079', 'afii10080', 'afii10081', // DC to DF + 'afii10082', 'afii10083', 'afii10084', 'afii10085', // E0 to E3 + 'afii10086', 'afii10087', 'afii10088', 'afii10089', // E4 to E7 + 'afii10090', 'afii10091', 'afii10092', 'afii10093', // E8 to EB + 'afii10094', 'afii10095', 'afii10096', 'afii10097', // EC to EF + 'afii61352', 'afii10071', 'afii10099', 'afii10100', // F0 to F3 + 'afii10101', 'afii10102', 'afii10103', 'afii10104', // F4 to F7 + 'afii10105', 'afii10106', 'afii10107', 'afii10108', // F8 to FB + 'afii10109', 'section', 'afii10110', 'afii10193'); // FC to FF + +const + iso_8859_5_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 1025, 1026, 1027, 1028, 1029, 1030, 1031, // A0 to A7 + 1032, 1033, 1034, 1035, 1036, 173, 1038, 1039, // A8 to AF + 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, // B0 to B7 + 1048, 1049, 1050, 1051, 1052, 1053, 1054, 1055, // B8 to BF + 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1063, // C0 to C7 + 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, // C8 to CF + 1072, 1073, 1074, 1075, 1076, 1077, 1078, 1079, // D0 to D7 + 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, // D8 to DF + 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, // E0 to E7 + 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, // E8 to EF + 8470, 1105, 1106, 1107, 1108, 1109, 1110, 1111, // F0 to F7 + 1112, 1113, 1114, 1115, 1116, 167, 1118, 1119); // F8 to FF + +const + iso_8859_7_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'quoteleft', 'quoteright', 'sterling', // A0 to A3 + 'brokenbar', 'section', 'dieresis', 'copyright', // A4 to A7 + 'guillemotleft', 'logicalnot', 'hyphen', 'afii00208', // A8 to AB + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // AC to AF + 'tonos', 'dieresistonos','Alphatonos', 'periodcentered', // B0 to B3 + 'Epsilontonos', 'Etatonos', 'Iotatonos', 'guillemotright', // B4 to B7 + 'Omicrontonos', 'onehalf', 'Upsilontonos', 'Omegatonos', // B8 to BB + 'iotadieresistonos', 'Alpha', 'Beta', 'Gamma', // BC to BF + 'Delta', 'Epsilon', 'Zeta', 'Eta', // C0 to C3 + 'Theta', 'Iota', 'Kappa', 'Lambda', // C4 to C7 + 'Mu', 'Nu', 'Xi', 'Omicron', // C8 to CB + 'Pi', 'Rho', 'Sigma', 'Tau', // CC to CF + 'Upsilon', 'Phi', 'Chi', 'Psi', // D0 to D3 + 'Omega', 'Iotadieresis', 'Upsilondieresis','alphatonos', // D4 to D7 + 'epsilontonos', 'etatonos', 'iotatonos', 'upsilondieresistonos', // D8 to DB + 'alpha', 'beta', 'gamma', 'delta', // DC to DF + 'epsilon', 'zeta', 'eta', 'theta', // E0 to E3 + 'iota', 'kappa', 'lambda', 'mu', // E4 to E7 + 'nu', 'xi', 'omicron', 'pi', // E8 to EB + 'rho', 'sigma1', 'sigma', 'tau', // EC to EF + 'upsilon', 'phi', 'chi', 'psi', // F0 to F3 + 'omega', 'iotadieresis', 'upsilondieresis','omicrontonos', // F4 to F7 + 'upsilontonos', 'omegatonos', '.notdef', '.notdef', // F8 to FB + '.notdef', '.notdef', '.notdef', '.notdef'); // FC to FF + +const + iso_8859_7_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 8216, 8217, 163, 166, 167, 168, 169, // A0 to A7 + 171, 172, 173, 8213, 176, 177, 178, 179, // A8 to AF + 900, 901, 902, 183, 904, 905, 906, 187, // B0 to B7 + 908, 189, 910, 911, 912, 913, 914, 915, // B8 to BF + 916, 917, 918, 919, 920, 921, 922, 923, // C0 to C7 + 924, 925, 926, 927, 928, 929, 931, 932, // C8 to CF + 933, 934, 935, 936, 937, 938, 939, 940, // D0 to D7 + 941, 942, 943, 944, 945, 946, 947, 948, // D8 to DF + 949, 950, 951, 952, 953, 954, 955, 956, // E0 to E7 + 957, 958, 959, 960, 961, 962, 963, 964, // E8 to EF + 965, 966, 967, 968, 969, 970, 971, 972, // F0 to F7 + 973, 974, -1, -1, -1, -1, -1, -1); // F8 to FF + +const + iso_8859_9_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'currency', 'yen', 'brokenbar', 'section', // A4 to A7 + 'dieresis', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'acute', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'cedilla', 'onesuperior', 'ordmasculine', 'guillemotright', // B8 to BB + 'onequarter', 'onehalf', 'threequarters','questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Gbreve', 'Ntilde', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Idotaccent', 'Scedilla', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'gbreve', 'ntilde', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'dotlessi', 'scedilla', 'ydieresis'); // FC to FF + +const + iso_8859_9_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 161, 162, 163, 164, 165, 166, 167, // A0 to A7 + 168, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 180, 181, 182, 183, // B0 to B7 + 184, 185, 186, 187, 188, 189, 190, 191, // B8 to BF + 192, 193, 194, 195, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 286, 209, 210, 211, 212, 213, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 304, 350, 223, // D8 to DF + 224, 225, 226, 227, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 287, 241, 242, 243, 244, 245, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 305, 351, 255); // F8 to FF + +const + iso_8859_11_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'kokaithai', 'khokhaithai', 'khokhuatthai', // A0 to A3 + 'khokhwaithai', 'khokhonthai', 'khorakhangthai', 'ngonguthai', // A4 to A7 + 'chochanthai', 'chochingthai', 'chochangthai', 'sosothai', // A8 to AB + 'chochoethai', 'yoyingthai', 'dochadathai', 'topatakthai', // AC to AF + 'thothanthai', 'thonangmonthothai','thophuthaothai', 'nonenthai', // B0 to B3 + 'dodekthai', 'totaothai', 'thothungthai', 'thothahanthai', // B4 to B7 + 'thothongthai', 'nonuthai', 'bobaimaithai', 'poplathai', // B8 to BB + 'phophungthai', 'fofathai', 'phophanthai', 'fofanthai', // BC to BF + 'phosamphaothai', 'momathai', 'yoyakthai', 'roruathai', // C0 to C3 + 'ruthai', 'lolingthai', 'luthai', 'wowaenthai', // C4 to C7 + 'sosalathai', 'sorusithai', 'sosuathai', 'hohipthai', // C8 to CB + 'lochulathai', 'oangthai', 'honokhukthai', 'paiyannoithai', // CC to CF + 'saraathai', 'maihanakatthai', 'saraaathai', 'saraamthai', // D0 to D3 + 'saraithai', 'saraiithai', 'sarauethai', 'saraueethai', // D4 to D7 + 'sarauthai', 'sarauuthai', 'phinthuthai', '.notdef', // D8 to DB + '.notdef', '.notdef', '.notdef', 'bahtthai', // DC to DF + 'saraethai', 'saraaethai', 'saraothai', 'saraaimaimuanthai', // E0 to E3 + 'saraaimaimalaithai','lakkhangyaothai', 'maiyamokthai', 'maitaikhuthai', // E4 to E7 + 'maiekthai', 'maithothai', 'maitrithai', 'maichattawathai', // E8 to EB + 'thanthakhatthai', 'nikhahitthai', 'yamakkanthai', 'fongmanthai', // EC to EF + 'zerothai', 'onethai', 'twothai', 'threethai', // F0 to F3 + 'fourthai', 'fivethai', 'sixthai', 'seventhai', // F4 to F7 + 'eightthai', 'ninethai', 'angkhankhuthai', 'khomutthai', // F8 to FB + '.notdef', '.notdef', '.notdef', '.notdef'); // FC to FF + +const + iso_8859_11_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 3585, 3586, 3587, 3588, 3589, 3590, 3591, // A0 to A7 + 3592, 3593, 3594, 3595, 3596, 3597, 3598, 3599, // A8 to AF + 3600, 3601, 3602, 3603, 3604, 3605, 3606, 3607, // B0 to B7 + 3608, 3609, 3610, 3611, 3612, 3613, 3614, 3615, // B8 to BF + 3616, 3617, 3618, 3619, 3620, 3621, 3622, 3623, // C0 to C7 + 3624, 3625, 3626, 3627, 3628, 3629, 3630, 3631, // C8 to CF + 3632, 3633, 3634, 3635, 3636, 3637, 3638, 3639, // D0 to D7 + 3640, 3641, 3642, -1, -1, -1, -1, 3647, // D8 to DF + 3648, 3649, 3650, 3651, 3652, 3653, 3654, 3655, // E0 to E7 + 3656, 3657, 3658, 3659, 3660, 3661, 3662, 3663, // E8 to EF + 3664, 3665, 3666, 3667, 3668, 3669, 3670, 3671, // F0 to F7 + 3672, 3673, 3674, 3675, -1, -1, -1, -1); // F8 to FF + +const + iso_8859_15_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'exclamdown', 'cent', 'sterling', // A0 to A3 + 'Euro', 'yen', 'Scaron', 'section', // A4 to A7 + 'scaron', 'copyright', 'ordfeminine', 'guillemotleft', // A8 to AB + 'logicalnot', 'hyphen', 'registered', 'macron', // AC to AF + 'degree', 'plusminus', 'twosuperior', 'threesuperior', // B0 to B3 + 'Zcaron', 'mu', 'paragraph', 'periodcentered', // B4 to B7 + 'zcaron', 'onesuperior', 'ordmasculine', 'guillemotright', // B8 to BB + 'OE', 'oe', 'Ydieresis', 'questiondown', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Atilde', // C0 to C3 + 'Adieresis', 'Aring', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Eth', 'Ntilde', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Otilde', 'Odieresis', 'multiply', // D4 to D7 + 'Oslash', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Yacute', 'Thorn', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'atilde', // E0 to E3 + 'adieresis', 'aring', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'eth', 'ntilde', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'otilde', 'odieresis', 'divide', // F4 to F7 + 'oslash', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'yacute', 'thorn', 'ydieresis'); // FC to FF + +const + iso_8859_15_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 161, 162, 163, 8364, 165, 352, 167, // A0 to A7 + 353, 169, 170, 171, 172, 173, 174, 175, // A8 to AF + 176, 177, 178, 179, 381, 181, 182, 183, // B0 to B7 + 382, 185, 186, 187, 338, 339, 376, 191, // B8 to BF + 192, 193, 194, 195, 196, 197, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 208, 209, 210, 211, 212, 213, 214, 215, // D0 to D7 + 216, 217, 218, 219, 220, 221, 222, 223, // D8 to DF + 224, 225, 226, 227, 228, 229, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 240, 241, 242, 243, 244, 245, 246, 247, // F0 to F7 + 248, 249, 250, 251, 252, 253, 254, 255); // F8 to FF + +const + iso_8859_16_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + '.notdef', '.notdef', '.notdef', '.notdef', // 80 to 83 + '.notdef', '.notdef', '.notdef', '.notdef', // 84 to 87 + '.notdef', '.notdef', '.notdef', '.notdef', // 88 to 8B + '.notdef', '.notdef', '.notdef', '.notdef', // 8C to 8F + '.notdef', '.notdef', '.notdef', '.notdef', // 90 to 93 + '.notdef', '.notdef', '.notdef', '.notdef', // 94 to 97 + '.notdef', '.notdef', '.notdef', '.notdef', // 98 to 9B + '.notdef', '.notdef', '.notdef', '.notdef', // 9C to 9F + 'space', 'Aogonek', 'aogonek', 'Lslash', // A0 to A3 + 'Euro', 'quotedblbase', 'Scaron', 'section', // A4 to A7 + 'scaron', 'copyright', 'Scommaaccent', 'guillemotleft', // A8 to AB + 'Zacute', 'hyphen', 'zacute', 'Zdotaccent', // AC to AF + 'degree', 'plusminus', 'Ccaron', 'lslash', // B0 to B3 + 'Zcaron', 'quotedblright','paragraph', 'periodcentered', // B4 to B7 + 'zcaron', 'ccaron', 'scommaaccent', 'guillemotright', // B8 to BB + 'OE', 'oe', 'Ydieresis', 'zdotaccent', // BC to BF + 'Agrave', 'Aacute', 'Acircumflex', 'Abreve', // C0 to C3 + 'Adieresis', 'Cacute', 'AE', 'Ccedilla', // C4 to C7 + 'Egrave', 'Eacute', 'Ecircumflex', 'Edieresis', // C8 to CB + 'Igrave', 'Iacute', 'Icircumflex', 'Idieresis', // CC to CF + 'Dcroat', 'Nacute', 'Ograve', 'Oacute', // D0 to D3 + 'Ocircumflex', 'Ohungarumlaut','Odieresis', 'Sacute', // D4 to D7 + 'Uhungarumlaut', 'Ugrave', 'Uacute', 'Ucircumflex', // D8 to DB + 'Udieresis', 'Eogonek', 'Tcommaaccent', 'germandbls', // DC to DF + 'agrave', 'aacute', 'acircumflex', 'abreve', // E0 to E3 + 'adieresis', 'cacute', 'ae', 'ccedilla', // E4 to E7 + 'egrave', 'eacute', 'ecircumflex', 'edieresis', // E8 to EB + 'igrave', 'iacute', 'icircumflex', 'idieresis', // EC to EF + 'dcroat', 'nacute', 'ograve', 'oacute', // F0 to F3 + 'ocircumflex', 'ohungarumlaut','odieresis', 'sacute', // F4 to F7 + 'uhungarumlaut', 'ugrave', 'uacute', 'ucircumflex', // F8 to FB + 'udieresis', 'eogonek', 'tcommaaccent', 'ydieresis'); // FC to FF + +const + iso_8859_16_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + -1, -1, -1, -1, -1, -1, -1, -1, // 80 to 87 + -1, -1, -1, -1, -1, -1, -1, -1, // 88 to 8F + -1, -1, -1, -1, -1, -1, -1, -1, // 90 to 97 + -1, -1, -1, -1, -1, -1, -1, -1, // 98 to 9F + 160, 260, 261, 321, 8364, 8222, 352, 167, // A0 to A7 + 353, 169, 536, 171, 377, 173, 378, 379, // A8 to AF + 176, 177, 268, 322, 381, 8221, 182, 183, // B0 to B7 + 382, 269, 537, 187, 338, 339, 376, 380, // B8 to BF + 192, 193, 194, 258, 196, 262, 198, 199, // C0 to C7 + 200, 201, 202, 203, 204, 205, 206, 207, // C8 to CF + 272, 323, 210, 211, 212, 336, 214, 346, // D0 to D7 + 368, 217, 218, 219, 220, 280, 538, 223, // D8 to DF + 224, 225, 226, 259, 228, 263, 230, 231, // E0 to E7 + 232, 233, 234, 235, 236, 237, 238, 239, // E8 to EF + 273, 324, 242, 243, 244, 337, 246, 347, // F0 to F7 + 369, 249, 250, 251, 252, 281, 539, 255); // F8 to FF + +const + koi8_r_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'SF100000', 'SF110000', 'SF010000', 'SF030000', // 80 to 83 + 'SF020000', 'SF040000', 'SF080000', 'SF090000', // 84 to 87 + 'SF060000', 'SF070000', 'SF050000', 'upblock', // 88 to 8B + 'dnblock', 'block', 'lfblock', 'rtblock', // 8C to 8F + 'ltshade', 'shade', 'dkshade', 'integraltp', // 90 to 93 + 'filledbox', 'periodcentered', 'radical', 'approxequal', // 94 to 97 + 'lessequal', 'greaterequal', 'space', 'integralbt', // 98 to 9B + 'degree', 'twosuperior', 'periodcentered', 'divide', // 9C to 9F + 'SF430000', 'SF240000', 'SF510000', 'afii10071', // A0 to A3 + 'SF520000', 'SF390000', 'SF220000', 'SF210000', // A4 to A7 + 'SF250000', 'SF500000', 'SF490000', 'SF380000', // A8 to AB + 'SF280000', 'SF270000', 'SF260000', 'SF360000', // AC to AF + 'SF370000', 'SF420000', 'SF190000', 'afii10023', // B0 to B3 + 'SF200000', 'SF230000', 'SF470000', 'SF480000', // B4 to B7 + 'SF410000', 'SF450000', 'SF460000', 'SF400000', // B8 to BB + 'SF540000', 'SF530000', 'SF440000', 'copyright', // BC to BF + 'afii10096', 'afii10065', 'afii10066', 'afii10088', // C0 to C3 + 'afii10069', 'afii10070', 'afii10086', 'afii10068', // C4 to C7 + 'afii10087', 'afii10074', 'afii10075', 'afii10076', // C8 to CB + 'afii10077', 'afii10078', 'afii10079', 'afii10080', // CC to CF + 'afii10081', 'afii10097', 'afii10082', 'afii10083', // D0 to D3 + 'afii10084', 'afii10085', 'afii10072', 'afii10067', // D4 to D7 + 'afii10094', 'afii10093', 'afii10073', 'afii10090', // D8 to DB + 'afii10095', 'afii10091', 'afii10089', 'afii10092', // DC to DF + 'afii10048', 'afii10017', 'afii10018', 'afii10040', // E0 to E3 + 'afii10021', 'afii10022', 'afii10038', 'afii10020', // E4 to E7 + 'afii10039', 'afii10026', 'afii10027', 'afii10028', // E8 to EB + 'afii10029', 'afii10030', 'afii10031', 'afii10032', // EC to EF + 'afii10033', 'afii10049', 'afii10034', 'afii10035', // F0 to F3 + 'afii10036', 'afii10037', 'afii10024', 'afii10019', // F4 to F7 + 'afii10046', 'afii10045', 'afii10025', 'afii10042', // F8 to FB + 'afii10047', 'afii10043', 'afii10041', 'afii10044'); // FC to FF + +const + koi8_r_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 9472, 9474, 9484, 9488, 9492, 9496, 9500, 9508, // 80 to 87 + 9516, 9524, 9532, 9600, 9604, 9608, 9612, 9616, // 88 to 8F + 9617, 9618, 9619, 8992, 9632, 8729, 8730, 8776, // 90 to 97 + 8804, 8805, 160, 8993, 176, 178, 183, 247, // 98 to 9F + 9552, 9553, 9554, 1105, 9555, 9556, 9557, 9558, // A0 to A7 + 9559, 9560, 9561, 9562, 9563, 9564, 9565, 9566, // A8 to AF + 9567, 9568, 9569, 1025, 9570, 9571, 9572, 9573, // B0 to B7 + 9574, 9575, 9576, 9577, 9578, 9579, 9580, 169, // B8 to BF + 1102, 1072, 1073, 1094, 1076, 1077, 1092, 1075, // C0 to C7 + 1093, 1080, 1081, 1082, 1083, 1084, 1085, 1086, // C8 to CF + 1087, 1103, 1088, 1089, 1090, 1091, 1078, 1074, // D0 to D7 + 100, 1099, 1079, 1096, 1101, 1097, 1095, 1098, // D8 to DF + 1070, 1040, 1041, 1062, 1044, 1045, 1060, 1043, // E0 to E7 + 1061, 1048, 1049, 1050, 1051, 1052, 1053, 1054, // E8 to EF + 1055, 1071, 1056, 1057, 1058, 1059, 1046, 1042, // F0 to F7 + 1068, 1067, 1047, 1064, 1069, 1065, 1063, 1066); // F8 to FF + +const + koi8_u_n: array[0..255] of string = + ('.notdef', '.notdef', '.notdef', '.notdef', // 00 to 03 + '.notdef', '.notdef', '.notdef', '.notdef', // 04 to 07 + '.notdef', '.notdef', '.notdef', '.notdef', // 08 to 0B + '.notdef', '.notdef', '.notdef', '.notdef', // 0C to 0F + '.notdef', '.notdef', '.notdef', '.notdef', // 10 to 13 + '.notdef', '.notdef', '.notdef', '.notdef', // 14 to 17 + '.notdef', '.notdef', '.notdef', '.notdef', // 18 to 1B + '.notdef', '.notdef', '.notdef', '.notdef', // 1C to 1F + 'space', 'exclam', 'quotedbl', 'numbersign', // 20 to 23 + 'dollar', 'percent', 'ampersand', 'quotesingle', // 24 to 27 + 'parenleft', 'parenright', 'asterisk', 'plus', // 28 to 2B + 'comma', 'hyphen', 'period', 'slash', // 2C to 2F + 'zero', 'one', 'two', 'three', // 30 to 33 + 'four', 'five', 'six', 'seven', // 34 to 37 + 'eight', 'nine', 'colon', 'semicolon', // 38 to 3B + 'less', 'equal', 'greater', 'question', // 3C to 3F + 'at', 'A', 'B', 'C', // 40 to 43 + 'D', 'E', 'F', 'G', // 44 to 47 + 'H', 'I', 'J', 'K', // 48 to 4B + 'L', 'M', 'N', 'O', // 4C to 4F + 'P', 'Q', 'R', 'S', // 50 to 53 + 'T', 'U', 'V', 'W', // 54 to 57 + 'X', 'Y', 'Z', 'bracketleft', // 58 to 5B + 'backslash', 'bracketright', 'asciicircum', 'underscore', // 5C to 5F + 'grave', 'a', 'b', 'c', // 60 to 63 + 'd', 'e', 'f', 'g', // 64 to 67 + 'h', 'i', 'j', 'k', // 68 to 6B + 'l', 'm', 'n', 'o', // 6C to 6F + 'p', 'q', 'r', 's', // 70 to 73 + 't', 'u', 'v', 'w', // 74 to 77 + 'x', 'y', 'z', 'braceleft', // 78 to 7B + 'bar', 'braceright', 'asciitilde', '.notdef', // 7C to 7F + 'SF100000', 'SF110000', 'SF010000', 'SF030000', // 80 to 83 + 'SF020000', 'SF040000', 'SF080000', 'SF090000', // 84 to 87 + 'SF060000', 'SF070000', 'SF050000', 'upblock', // 88 to 8B + 'dnblock', 'block', 'lfblock', 'rtblock', // 8C to 8F + 'ltshade', 'shade', 'dkshade', 'integraltp', // 90 to 93 + 'filledbox', 'bullet', 'radical', 'approxequal', // 94 to 97 + 'lessequal', 'greaterequal', 'space', 'integralbt', // 98 to 9B + 'degree', 'twosuperior', 'periodcentered', 'divide', // 9C to 9F + 'SF430000', 'SF240000', 'SF510000', 'afii10071', // A0 to A3 + 'afii10101', 'SF390000', 'afii10103', 'afii10104', // A4 to A7 + 'SF250000', 'SF500000', 'SF490000', 'SF380000', // A8 to AB + 'SF280000', 'afii10098', 'SF260000', 'SF360000', // AC to AF + 'SF370000', 'SF420000', 'SF190000', 'afii10023', // B0 to B3 + 'afii10053', 'SF230000', 'afii10055', 'afii10056', // B4 to B7 + 'SF410000', 'SF450000', 'SF460000', 'SF400000', // B8 to BB + 'SF540000', 'afii10050', 'SF440000', 'copyright', // BC to BF + 'afii10096', 'afii10065', 'afii10066', 'afii10088', // C0 to C3 + 'afii10069', 'afii10070', 'afii10086', 'afii10068', // C4 to C7 + 'afii10087', 'afii10074', 'afii10075', 'afii10076', // C8 to CB + 'afii10077', 'afii10078', 'afii10079', 'afii10080', // CC to CF + 'afii10081', 'afii10097', 'afii10082', 'afii10083', // D0 to D3 + 'afii10084', 'afii10085', 'afii10072', 'afii10067', // D4 to D7 + 'afii10094', 'afii10093', 'afii10073', 'afii10090', // D8 to DB + 'afii10095', 'afii10091', 'afii10089', 'afii10092', // DC to DF + 'afii10048', 'afii10017', 'afii10018', 'afii10040', // E0 to E3 + 'afii10021', 'afii10022', 'afii10038', 'afii10020', // E4 to E7 + 'afii10039', 'afii10026', 'afii10027', 'afii10028', // E8 to EB + 'afii10029', 'afii10030', 'afii10031', 'afii10032', // EC to EF + 'afii10033', 'afii10049', 'afii10034', 'afii10035', // F0 to F3 + 'afii10036', 'afii10037', 'afii10024', 'afii10019', // F4 to F7 + 'afii10046', 'afii10045', 'afii10025', 'afii10042', // F8 to FB + 'afii10047', 'afii10043', 'afii10041', 'afii10044'); // FC to FF + +const + koi8_u_v: array[0..255] of Word = + (0, 1, 2, 3, 4, 5, 6, 7, // 00 to 07 + 8, 9, 10, 11, 12, 13, 14, 15, // 08 to 0F + 16, 17, 18, 19, 20, 21, 22, 23, // 10 to 17 + 24, 25, 26, 27, 28, 29, 30, 31, // 18 to 1F + 32, 33, 34, 35, 36, 37, 38, 39, // 20 to 27 + 40, 41, 42, 43, 44, 45, 46, 47, // 28 to 2F + 48, 49, 50, 51, 52, 53, 54, 55, // 30 to 37 + 56, 57, 58, 59, 60, 61, 62, 63, // 38 to 3F + 64, 65, 66, 67, 68, 69, 70, 71, // 40 to 47 + 72, 73, 74, 75, 76, 77, 78, 79, // 48 to 4F + 80, 81, 82, 83, 84, 85, 86, 87, // 50 to 57 + 88, 89, 90, 91, 92, 93, 94, 95, // 58 to 5F + 96, 97, 98, 99, 100, 101, 102, 103, // 60 to 67 + 104, 105, 106, 107, 108, 109, 110, 111, // 68 to 6F + 112, 113, 114, 115, 116, 117, 118, 119, // 70 to 77 + 120, 121, 122, 123, 124, 125, 126, 127, // 78 to 7F + 9472, 9474, 9484, 9488, 9492, 9496, 9500, 9508, // 80 to 87 + 9516, 9524, 9532, 9600, 9604, 9608, 9612, 9616, // 88 to 8F + 9617, 9618, 9619, 8992, 9632, 8226, 8730, 8776, // 90 to 97 + 8804, 8805, 160, 8993, 176, 178, 183, 247, // 98 to 9F + 9552, 9553, 9554, 1105, 1108, 9556, 1110, 1111, // A0 to A7 + 9559, 9560, 9561, 9562, 9563, 1169, 9565, 9566, // A8 to AF + 9567, 9568, 9569, 1025, 1028, 9571, 1030, 1031, // B0 to B7 + 9574, 9575, 9576, 9577, 9578, 1168, 9580, 169, // B8 to BF + 1102, 1072, 1073, 1094, 1076, 1077, 1092, 1075, // C0 to C7 + 1093, 1080, 1081, 1082, 1083, 1084, 1085, 1086, // C8 to CF + 1087, 1103, 1088, 1089, 1090, 1091, 1078, 1074, // D0 to D7 + 1100, 1099, 1079, 1096, 1101, 1097, 1095, 1098, // D8 to DF + 1070, 1040, 1041, 1062, 1044, 1045, 1060, 1043, // E0 to E7 + 1061, 1048, 1049, 1050, 1051, 1052, 1053, 1054, // E8 to EF + 1055, 1071, 1056, 1057, 1058, 1059, 1046, 1042, // F0 to F7 + 1068, 1067, 1047, 1064, 1069, 1065, 1063, 1066); // F8 to FF + +implementation + +end. + diff --git a/tools/makefont/u_main.pas b/tools/makefont/u_main.pas new file mode 100644 index 00000000..677173e1 --- /dev/null +++ b/tools/makefont/u_main.pas @@ -0,0 +1,120 @@ +unit u_main; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, Dos, + fpg_main, fpg_base, + fpg_form, fpg_button, fpg_label, fpg_dialogs, fpg_combobox; + +type + TF_MainForm= class(TfpgForm) + private + L_SelectMap: Tfpglabel; + Cb_SelectMap: TfpgComboBox; + Bt_SelectFile: TfpgButton; + Bt_Exit: TfpgButton; + procedure Bt_SelectFileClick(Sender: TObject); + procedure Bt_ExitClick(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + end; + +var + F_MainForm: TF_MainForm; + +implementation + +uses + u_Parsettf; + +var + MapList: TStringList; + +procedure TF_MainForm.Bt_SelectFileClick(Sender: TObject); +var + FileDlg: TfpgFileDialog; + Fichier,Extension,FontType: string; +begin +FileDlg:= TfpgFileDialog.Create(nil); +//FileDlg.Filter:= 'True type fonts (*.ttf;*.otf)|*.ttf;*.otf|Type1 fonts (*.pfa;*.pfb)|*.pfa;*.pfb'; +FileDlg.Filter:= 'True type fonts (*.ttf;*.otf)|*.ttf;*.otf'; +FileDlg.FontDesc:= 'bitstream vera sans-9'; +{$ifdef linux} +FileDlg.InitialDir:= GetEnv('GS_LIB'); +{$endif} +{$ifdef win32} +//FileDlg.InitialDir:= '/WINDOWS/Fonts'; +{$endif} +try + if FileDlg.RunOpenFile + then + begin + Fichier:= ExtractFileName(FileDlg.FileName); + //Extension:= Lowercase(Copy(Fichier,Length(Fichier)-3,3)); + //if (Extension= 'ttf') or (Extension= 'otf') + //then + // FontType:= 'TrueType' + //else + // if Extension= 'pfb' + // then + // FontType:= 'Type1'; + Parser:= T_Parser.Create(nil); + Parser.MakeFont(Fichier,Cb_SelectMap.Text,True); + end; +finally + FileDlg.Free; + end; +end; + +procedure TF_MainForm.Bt_ExitClick(Sender: TObject); +begin +Parser.Free; +MapList.Free; +Close; +end; + +constructor TF_MainForm.Create(AOwner: TComponent); +begin +inherited Create(AOwner); +Name := 'F_MainForm'; +WindowTitle:= 'TTF parser'; +SetPosition(0, 0, 400, 300); +WindowPosition:= wpScreenCenter; +Sizeable:= False; +MapList:= TStringList.Create; +with MapList do + begin + Add('cp874'); + Add('cp1250'); + Add('cp1251'); + Add('cp1252'); + Add('cp1253'); + Add('cp1254'); + Add('cp1255'); + Add('cp1257'); + Add('cp1258'); + Add('iso-8859-1'); + Add('iso-8859-2'); + Add('iso-8859-4'); + Add('iso-8859-5'); + Add('iso-8859-7'); + Add('iso-8859-9'); + Add('iso-8859-11'); + Add('iso-8859-15'); + Add('iso-8859-16'); + Add('koi8-r'); + Add('koi8-u'); + end; +L_SelectMap:= CreateLabel(Self,150,30,'Select mapping',100,20,taCenter); +Cb_SelectMap:= CreateComboBox(Self,150,50,100,MapList,20); +Cb_SelectMap.FocusItem:= 3; +Bt_SelectFile:= CreateButton(Self,150,200,100,'Select file',@Bt_SelectFileClick,''); +Bt_Exit:= CreateButton(Self,160,250,80,'Exit',@Bt_ExitClick,''); +RepCourant:= ExtractFilePath(Paramstr(0)); +end; + +end. + diff --git a/tools/makefont/u_parsettf.pas b/tools/makefont/u_parsettf.pas new file mode 100644 index 00000000..e7a1584c --- /dev/null +++ b/tools/makefont/u_parsettf.pas @@ -0,0 +1,708 @@ +unit u_parsettf; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, StrUtils, + fpg_dialogs; + +type + T_Parser= class(TObject) + private + OriginalSize: Longint; + FEncoding: string; + UnitsPerEm: Integer; + Coef: Extended; + BBox: array[0..3] of Smallint; + NumHMetrix: Integer; + NumGlyphs: Integer; + Widths: array of Smallint; + Chars: array of Word; + PostScriptName: string; + Embeddable: Boolean; + Bold: Boolean; + StemV: SmallInt; + Ascender: SmallInt; + Descender: SmallInt; + CapHeight: SmallInt; + ItalicAngle: Smallint; + Flags: Integer; + MissingWidth: SmallInt; + UnderlinePos: Smallint; + UnderlineThick: Smallint; + IsFixedPitch: Boolean; + CharWidth: array[0..255] of SmallInt; + Differences: widestring; + procedure ParseHead; + procedure ParseHhea; + procedure ParseMaxp; + procedure ParseHmtx; + procedure ParseCmap; + procedure ParseName; + procedure ParseOS2; + procedure ParsePost; + procedure ParseTtfFile(const FontFile: string); + procedure PrepareEncoding; + procedure MakedefinitionFile(FontFile: string); + function MakeDifferences: widestring; + public + procedure MakeFont(const FontFile: string; const Encoding: string; Embed: Boolean); + constructor Create(AOwner: TComponent); + end; + +var + Parser: T_Parser; + RepCourant: string; + +implementation + +uses + u_data; + +var + Flux: TFileStream; + CharNames: array[0..255] of string; + CharCodes: array[0..255] of Word; + CharBase: array[0..255] of string; + +function Puissance(Base,Exposant: Integer): Integer; +begin +if Exposant> 1 +then + Puissance:= Base*Puissance(Base,Pred(Exposant)) +else + Puissance:= Exposant; +end; + +function ReadULong(AFlux: TFileStream): Longword; +var + ALong: Longword; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Longword; +begin +AFlux.Read(ALong,SizeOf(ALong)); +Chaine:= IntToHex(ALong,8); +Chaine:= Copy(Chaine,7,2)+Copy(Chaine,5,2)+Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,8); +for Cpt:= 1 to 8 do + begin + Coef:= 9-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 8 do + Result:= Result+Value[Cpt]; +end; + +function ReadUShort(AFlux: TFileStream): Word; +var + AWord: Word; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Word; +begin +AFlux.Read(AWord,SizeOf(AWord)); +Chaine:= IntToHex(AWord,4); +Chaine:= Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,4); +for Cpt:= 1 to 4 do + begin + Coef:= 5-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 4 do + Result:= Result+Value[Cpt]; +end; + +function ReadShort(AFlux: TFileStream): Smallint; +var + AWord: Word; + Chaine: string; + Cpt,Coef: Integer; + Value: array of Word; +begin +AFlux.Read(AWord,SizeOf(AWord)); +Chaine:= IntToHex(AWord,4); +Chaine:= Copy(Chaine,3,2)+Copy(Chaine,1,2); +SetLength(Value,4); +for Cpt:= 1 to 4 do + begin + Coef:= 5-Cpt; + case Chaine[Cpt] of + '0'..'9': + Value[Cpt]:= Puissance(16,Coef)*StrToInt(Chaine[Cpt]); + 'A': + Value[Cpt]:= Puissance(16,Coef)*10; + 'B': + Value[Cpt]:= Puissance(16,Coef)*11; + 'C': + Value[Cpt]:= Puissance(16,Coef)*12; + 'D': + Value[Cpt]:= Puissance(16,Coef)*13; + 'E': + Value[Cpt]:= Puissance(16,Coef)*14; + 'F': + Value[Cpt]:= Puissance(16,Coef)*15; + end; + end; +Result:= 0; +for Cpt:= 1 to 4 do + Result:= Result+Value[Cpt]; +end; + +procedure T_Parser.ParseHead; +var + AWord: Word; + ALong: Longword; + MagicNumber: Longword; + Cpt: Integer; +begin +for Cpt:= 1 to 3 do + Flux.Read(ALong,SizeOf(ALong)); // skip 12 bytes - Version, FontRevision, ChecksumAdjustment +MagicNumber:= ReadULong(Flux); // 4 bytes - MagicNumber +if IntToHex(MagicNumber,4)<> '5F0F3CF5' +then + begin + ShowMessage('Incorrect magic number',True); + Exit; + end; +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Flags +UnitsPerEm:= ReadUShort(Flux); // 2 bytes - UnitsPerEm +Coef:= 1000/UnitsPerEm; +for Cpt:= 1 to 4 do + Flux.Read(ALong,SizeOf(ALong)); // skip 16 bytes - Created, Modified +BBox[0]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[1]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[2]:= Round(Coef*ReadShort(Flux)); // 2 bytes +BBox[3]:= Round(Coef*ReadShort(Flux)); // 2 bytes +end; + +procedure T_Parser.ParseHhea; +var + AWord: Word; + ALong: Longword; + Cpt: Integer; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes +for Cpt:= 1 to 15 do + Flux.Read(AWord,SizeOf(AWord)); // skip 30 bytes +NumHMetrix:= ReadUShort(Flux); // 2 bytes +end; + +procedure T_Parser.ParseMaxp; +var + ALong: Longword; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes +NumGlyphs:= ReadUShort(Flux); // 2 bytes +end; + +procedure T_Parser.ParseHmtx; +var + AWord: Word; + Cpt: Integer; +begin +SetLength(Widths,NumGlyphs); +for Cpt:= 0 to Pred(NumHMetrix) do + begin + Widths[Cpt]:= ReadUShort(Flux); // 2 bytes + Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Lsb + end; +if NumHMetrix< NumGlyphs +then + for Cpt:= NumHMetrix to Pred(NumGlyphs) do + Widths[Cpt]:= 0; +//MissingWidth:= Round(Coef*Widths[0]); +//for Cpt:= 0 to 255 do +// CharWidth[Cpt]:= MissingWidth; +end; + +procedure T_Parser.ParseCmap; +var + AWord: Word; + ALong: Longword; + NumTables: Word; + SubTableFormat: Word; + SegCount: Word; + Gid: Word; + EndCount: array of Word; + StartCount: array of Word; + IDDelta: array of Word; + IDRangeOffset: array of Word; + Cpt,Cpt2: Integer; + PlatformID,EncodingID: Word; + Offset,Offset31,TableStartPos,TablePos: LongWord; +begin +TableStartPos:= Flux.Position; // memorize Table start position +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - version +NumTables:= ReadUShort(Flux); // 2 bytes +Offset31:= 0; +for Cpt:= 1 to NumTables do + begin + PlatformID:= ReadUShort(Flux); // 2 bytes + EncodingID:= ReadUShort(Flux); // 2 bytes + Offset:= ReadULong(Flux); // 4 bytes - Offset of subtable + if (PlatformID= 3) and (EncodingID= 1) + then + Offset31:= Offset; + end; +if Offset31= 0 +then + begin + ShowMessage('No unicode encoding found',True); + Exit; + end; +Flux.Position:= TableStartPos+Offset31; +SubTableFormat:= ReadUShort(Flux); // 2 bytes - Format of subtable +if SubTableFormat<> 4 +then + begin + ShowMessage('Unexpected subtable format',True); + Exit; + end; +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Length, language +SegCount:= Round(ReadUShort(Flux)/2); // 2 bytes - Segments count +for Cpt:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - SearchRange, EntrySelector, RangeShift +SetLength(EndCount,SegCount); +for Cpt:= 0 to Pred(SegCount) do + EndCount[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - ReservedPad +SetLength(StartCount,SegCount); +for Cpt:= 0 to Pred(SegCount) do + StartCount[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +SetLength(IDDelta,SegCount); +for Cpt:= 0 to Pred(SegCount) do + IDDelta[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +TablePos:= Flux.Position; // set position to Table offset +SetLength(IDRangeOffset,SegCount); +for Cpt:= 0 to Pred(SegCount) do + IDRangeOffset[Cpt]:= ReadUShort(Flux); // 2 bytes * SegCount +for Cpt:= 0 to Pred(SegCount) do + begin + if IDRangeOffset[Cpt]> 0 + then + Flux.Position:= TablePos+2*Cpt+IDRangeOffset[Cpt]; // set position + SetLength(Chars,Length(Chars)+EndCount[Cpt]); + for Cpt2:= StartCount[Cpt] to EndCount[Cpt] do + begin + if Cpt2= 65535 + then + Break; + if IDRangeOffset[Cpt]> 0 + then + begin + Gid:= ReadUShort(Flux); + if Gid> 0 + then + Gid:= Gid+IDDelta[Cpt]; + end + else + Gid:= Cpt2+IDDelta[Cpt]; + if Gid>= 65536 + then + Gid:= Gid-65536; + if Gid> 0 + then + Chars[Cpt2]:= Gid; + end; + end; +end; + +procedure T_Parser.ParseName; +var + AWord: Word; + NameID: Word; + Count: Word; + Long: Word; + StringOffset: Word; + Offset: Word; + TableStartPos: LongWord; + Cpt,Cpt2: Integer; + Chaine: string; + CharIdent: Char; +begin +TableStartPos:= Flux.Position; // memorize Table start position +PostScriptName:= ''; +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - Format +Count:= ReadUShort(Flux); // 2 bytes +StringOffset:= ReadUShort(Flux); // 2 bytes +for Cpt:= 0 to Pred(Count) do + begin + for Cpt2:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - PlatformID, encodingID, languageID + NameID:= ReadUShort(Flux); // 2 bytes + Long:= ReadUShort(Flux); // 2 bytes + Offset:= ReadUShort(Flux); // 2 bytes + if NameID= 6 + then + begin + Flux.Position:= TableStartPos+StringOffset+Offset; // set position + Chaine:= ''; + for Cpt2:= 1 to Long do + begin + Flux.Read(CharIdent,SizeOf(CharIdent)); // 1 byte + Chaine:= Chaine+CharIdent; + end; + PostScriptName:= Chaine; + Break; + end; + end; +end; + +procedure T_Parser.ParseOS2; +var + AWord: Word; + ALong: Longword; + Version: Word; + FsType: Word; + Cpt: Integer; +begin +Version:= ReadUShort(Flux); // 2 bytes +for Cpt:= 1 to 3 do + Flux.Read(AWord,SizeOf(AWord)); // skip 6 bytes - xAvgCharWidth, usWeightClass, usWidthClass +FsType:= ReadUShort(Flux); // 2 bytes +Embeddable:= (FsType<> 2) and ((FsType and 512)= 0); +if not Embeddable +then + begin + ShowMessage('Font licence does not allow embedding',True); + Exit; + end; +for Cpt:= 1 to 13 do + Flux.Read(ALong,SizeOf(ALong)); // skip 52 bytes +Bold:= (ReadUShort(Flux) and 32)<> 0 ; // 2 bytes +if Bold +then + StemV:= 120 +else + StemV:= 70; +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - usFirstCharIndex, usLastCharIndex +Ascender:= Round(Coef*ReadShort(Flux)); // 2 bytes +Descender:= Round(Coef*ReadShort(Flux)); // 2 bytes +if Version>= 2 +then + begin + for Cpt:= 1 to 4 do + Flux.Read(ALong,SizeOf(ALong)); // skip 16 bytes + CapHeight:= Round(Coef*ReadShort(Flux)); // 2 bytes + end +else + CapHeight:= Ascender; +end; + +procedure T_Parser.ParsePost; +var + AWord: Word; + ALong: Longint; +begin +Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Version +ItalicAngle:= ReadShort(Flux); // 2 bytes +Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes - decimal part +UnderlinePos:= Round(Coef*ReadShort(Flux)); // 2 bytes +UnderlineThick:= Round(Coef*ReadShort(Flux)); // 2 bytes +IsFixedPitch:= ReadULong(Flux)<> 0; // 4 bytes +Flags:= 32; // non symbolic +if IsFixedPitch +then + Flags:= Flags+1; +if ItalicAngle<> 0 +then + Flags:= Flags+64; +end; + +procedure T_Parser.ParseTtfFile(const FontFile: string); +var + Version: Longint; + NumTables: Word; + AWord: Word; + ALong: Longword; + TableIdent: array of string; + TableOffset: array of Longword; + Cpt,Cpt2: Integer; + CharIdent: Char; +begin +Flux:= TFileStream.Create(FontFile,fmOpenRead); +try + OriginalSize:= Flux.Size; + Flux.Position:= 0; // Affset Table (starts at byte 0 + Flux.Read(Version,SizeOf(Version)); // 4 bytes + NumTables:= ReadUShort(Flux); // 2 bytes - Number of Tables + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes + Flux.Read(AWord,SizeOf(AWord)); // skip 2 bytes + SetLength(TableIdent,NumTables); + SetLength(TableOffset,NumTables); + for Cpt:= 0 to Pred(NumTables) do // Table Directory (start at byte 12) + begin + for Cpt2:= 1 to 4 do + begin + Flux.Read(CharIdent,SizeOf(CharIdent)); // 1 byte + TableIdent[Cpt]:= TableIdent[Cpt]+CharIdent; + end; + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Checksum + TableOffset[Cpt]:= ReadULong(Flux); // 4 bytes - Offset + Flux.Read(ALong,SizeOf(ALong)); // skip 4 bytes - Length + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'head' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHead; // lecture table "Head" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'hhea' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHhea; // lecture table "Hhea" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'maxp' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseMaxp; // lecture table "Maxp" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'hmtx' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseHmtx; // lecture table "Hmtx" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'cmap' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseCmap; // lecture table "Cmap" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'name' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseName; // lecture table "Name" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'OS/2' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParseOS2; // lecture table "OS/2" + Break; + end; + for Cpt:= 0 to Pred(NumTables) do + if TableIdent[Cpt]= 'post' + then + begin + Flux.Position:= TableOffset[Cpt]; + ParsePost; // lecture table "Post" + Break; + end; +finally + Flux.Free; + end; +end; + +procedure T_Parser.PrepareEncoding; +var + Cpt: Integer; +begin +if FEncoding= 'cp874' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp874_n[Cpt]; + CharCodes[Cpt]:= cp874_v[Cpt]; + end; +if FEncoding= 'cp1250' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1250_n[Cpt]; + CharCodes[Cpt]:= cp1250_v[Cpt]; + end; +if FEncoding= 'cp1251' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1251_n[Cpt]; + CharCodes[Cpt]:= cp1251_v[Cpt]; + end; +if FEncoding= 'cp1252' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1252_n[Cpt]; + CharCodes[Cpt]:= cp1252_v[Cpt]; + end +else + for Cpt:= 0 to 255 do + CharBase[Cpt]:= cp1252_n[Cpt]; +if FEncoding= 'cp1253' +then + for Cpt:= 0 to 255 do + begin + CharNames[Cpt]:= cp1253_n[Cpt]; + CharCodes[Cpt]:= cp1253_v[Cpt]; + end; +end; + +procedure T_Parser.MakedefinitionFile(FontFile: string); +var + FileDlg: TfpgFileDialog; + DestFile: TStringList; + Chaine,Fichier: widestring; + Cpt: Integer; +begin +DestFile:= TStringList.Create; +Chaine:= 'FontType=TrueType'; +DestFile.Add(Chaine); +Chaine:= 'FontName='+PostScriptName; +DestFile.Add(Chaine); +Chaine:= 'Ascent='+IntToStr(Ascender); +DestFile.Add(Chaine); +Chaine:= 'Descent='+IntToStr(Descender); +DestFile.Add(Chaine); +Chaine:= 'CapHeight='+IntToStr(CapHeight); +DestFile.Add(Chaine); +Chaine:= 'Flags='+IntToStr(Flags); +DestFile.Add(Chaine); +Chaine:= 'FontBBox='; +for Cpt:= 0 to 3 do + Chaine:= Chaine+IntToStr(BBox[Cpt])+' '; +Chaine:= Chaine+']'; +DestFile.Add(Chaine); +Chaine:= 'ItalicAngle='+IntToStr(ItalicAngle); +DestFile.Add(Chaine); +Chaine:= 'StemV='+IntToStr(StemV); +DestFile.Add(Chaine); +Chaine:= 'MissingWidth='+IntToStr(MissingWidth); +DestFile.Add(Chaine); +Chaine:= 'FontUp='+IntToStr(UnderlinePos); +DestFile.Add(Chaine); +Chaine:= 'FontUt='+IntToStr(UnderlineThick); +DestFile.Add(Chaine); +Chaine:= 'Encoding='+FEncoding; +DestFile.Add(Chaine); +Chaine:= 'FontFile='+Copy(FontFile,1,Length(FontFile)-4)+'.z'; +//Chaine:= 'FontFile='+FontFile; +DestFile.Add(Chaine); +Chaine:= 'OriginalSize='+IntToStr(OriginalSize); +DestFile.Add(Chaine); +if Differences> '' +then + begin + Chaine:= 'Diffs='+Differences; + DestFile.Add(Chaine); + end; +Chaine:= 'CharWidth='; +for Cpt:= 32 to 255 do + Chaine:= Chaine+IntToStr(CharWidth[Cpt])+' '; +Chaine:= Chaine+']'; +DestFile.Add(Chaine); +FileDlg:= TfpgFileDialog.Create(nil); +FileDlg.InitialDir:= RepCourant; +FileDlg.Filter:= 'Fichiers fnt |*.fnt'; +FontFile:= StringReplace(FontFile,'-Regular','',[rfIgnoreCase]); +Fichier:= Copy(FontFile,1,Length(FontFile)-3)+'fnt'; +FileDlg.FileName:= Fichier; +try + if FileDlg.RunSaveFile + then + DestFile.SaveToFile(Fichier); +finally + FileDlg.Free; + DestFile.Free; + end; +end; + +function T_Parser.MakeDifferences: widestring; +var + Cpt,Last: Integer; +begin +Result:= ''; +Last:= 0; +for Cpt:=32 to 255 do + if CharNames[Cpt]<> CharBase[Cpt] + then + begin + if Cpt<> Succ(Cpt) + then + Result:= Result+IntToStr(Cpt)+' '; + Last:= Cpt; + Result:= Result+'/'+CharNames[Cpt]+' '; + end; +end; + +procedure T_Parser.MakeFont(const FontFile: string; const Encoding:string; Embed: Boolean); +var + Cpt: Integer; +begin +FEncoding:= Encoding; +PrepareEncoding; +ParseTtfFile(FontFile); +MissingWidth:= Round(Coef*Widths[Chars[CharCodes[32]]]); +for Cpt:= 0 to 255 do + begin + if (Widths[Chars[CharCodes[Cpt]]]> 0) and (CharNames[Cpt]<> '.notdef') + then + CharWidth[Cpt]:= Round(Coef*Widths[Chars[CharCodes[Cpt]]]) + else + CharWidth[Cpt]:= MissingWidth; + end; +if Encoding<> 'cp1252' +then + Differences:= MakeDifferences; +MakeDefinitionFile(FontFile); +end; + +constructor T_Parser.Create(AOwner: TComponent); +begin +inherited Create; +end; + +end. + diff --git a/uidesigner/extrafpc.cfg b/uidesigner/extrafpc.cfg index 06ab13a9..7804b795 100644 --- a/uidesigner/extrafpc.cfg +++ b/uidesigner/extrafpc.cfg @@ -3,3 +3,7 @@ -Xs -XX -CX +#ifdef mswindows +-WG +#endif + diff --git a/uidesigner/icons.inc b/uidesigner/icons.inc index b764e738..0e75a91f 100644 --- a/uidesigner/icons.inc +++ b/uidesigner/icons.inc @@ -3619,3 +3619,104 @@ const 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, 255,255, 0,255,255, 0,255, 0, 0, 0); + + +const + stdimg_vfd_scrollframe: array[0..1617] of byte = ( + 66, 77, 82, 6, 0, 0, 0, 0, 0, 0,122, 0, 0, 0,108, 0, 0, + 0, 22, 0, 0, 0, 22, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 216, 5, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 66, 71, 82,115, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255,255,255,146,119,119,146,119,119,146,119,119,146,119, + 119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146, + 119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119, 0, 0,146,119,119,193,192,194,193,192,194,193,192,194,193,192, + 194,146,119,119,255,252,251,201,188,186,255,252,251,201,188,186,255, + 252,251,146,119,119,193,192,194,193,192,194,193,192,194,193,192,194, + 146,119,119,237,239,239,237,239,239,237,239,239,237,239,239,146,119, + 119, 0, 0,146,119,119,193,192,194,137,137,137, 6, 8, 8,237,239, + 239,146,119,119,201,188,186,255,252,251,201,188,186,255,252,251,201, + 188,186,146,119,119,193,192,194, 4, 6, 7,137,137,137,237,239,239, + 146,119,119,237,239,239,237,239,239,237,239,239,237,239,239,146,119, + 119, 0, 0,146,119,119,193,192,194,122,122,122, 1, 1, 1,237,239, + 239,146,119,119,255,252,251,201,188,186,255,252,251,201,188,186,255, + 252,251,146,119,119,193,192,194, 1, 5, 6,122,122,122,237,239,239, + 146,119,119,237,239,239,237,239,239,237,239,239,237,239,239,146,119, + 119, 0, 0,146,119,119,193,192,194,237,239,239,237,239,239,237,239, + 239,146,119,119,201,188,186,255,252,251,201,188,186,255,252,251,201, + 188,186,146,119,119,193,192,194,237,239,239,237,239,239,237,239,239, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119, 0, 0,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146, + 119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 146,119,119,193,192,194,193,192,194,193,192,194,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239,122,122,122,137,137,137,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,148,145,148,148,145,148,148,145, + 148,148,145,148,148,145,148,148,145,148,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239, 1, 1, 1, 6, 8, 8,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,237,239,239,237,239, + 239,237,239,239,237,239,239,148,145,148,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239,237,239,239,237,239,239,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,237,239,239,237,239, + 239,237,239,239,237,239,239,148,145,148,255,255,255,148,145,148,148, + 145,148,148,145,148,148,145,148,148,145,148,148,145,148,255,255,255, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,193,192,194,193,192, + 194,193,192,194,193,192,194,148,145,148,255,255,255,193,192,194,237, + 239,239,237,239,239,237,239,239,237,239,239,148,145,148,255,255,255, + 146,119,119,201,188,186,255,254,254,198,193,192,255,251,252,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,193,192,194,237, + 239,239,237,239,239,237,239,239,237,239,239,148,145,148,255,255,255, + 146,119,119,255,252,251,209,193,194,255,251,251,204,196,197,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,193,192,194,193, + 192,194,193,192,194,193,192,194,193,192,194,148,145,148,255,255,255, + 146,119,119,213,204,201,254,244,244,208,200,200,255,254,255,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,255,255,252,189,184,183,255,254,253,192,192,192,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,148,145,148,148, + 145,148,148,145,148,148,145,148,148,145,148,148,145,148,255,255,255, + 146,119,119,197,188,185,255,255,254,183,188,186,251,255,255,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,193,192,194,237, + 239,239,237,239,239,237,239,239,237,239,239,148,145,148,255,255,255, + 146,119,119,255,255,254,187,192,190,248,255,255,184,190,189,146,119, + 119, 0, 0,146,119,119,255,255,255,148,145,148,148,145,148,148,145, + 148,148,145,148,148,145,148,148,145,148,255,255,255,193,192,194,237, + 239,239,237,239,239,237,239,239,237,239,239,148,145,148,255,255,255, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,237,239,239,237,239, + 239,237,239,239,237,239,239,148,145,148,255,255,255,193,192,194,193, + 192,194,193,192,194,193,192,194,193,192,194,148,145,148,255,255,255, + 146,119,119,193,192,194,193,192,194,193,192,194,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,237,239,239,237,239, + 239,237,239,239,237,239,239,148,145,148,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239, 1, 5, 6, 4, 6, 7,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,193,192,194,193,192,194,193,192, + 194,193,192,194,193,192,194,148,145,148,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239,122,122,122,137,137,137,193,192,194,146,119, + 119, 0, 0,146,119,119,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 146,119,119,237,239,239,237,239,239,237,239,239,193,192,194,146,119, + 119, 0, 0,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146, + 119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,255,255, + 255, 0, 0); + diff --git a/uidesigner/images/scrollframe.bmp b/uidesigner/images/scrollframe.bmp Binary files differnew file mode 100644 index 00000000..3733100b --- /dev/null +++ b/uidesigner/images/scrollframe.bmp diff --git a/uidesigner/newformdesigner.pas b/uidesigner/newformdesigner.pas index eec39b12..31b9431d 100644 --- a/uidesigner/newformdesigner.pas +++ b/uidesigner/newformdesigner.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -61,6 +61,8 @@ type procedure miHelpAboutClick(Sender: TObject); procedure miHelpAboutGUI(Sender: TObject); procedure miMRUClick(Sender: TObject; const FileName: string); + procedure SetupCaptions; + procedure BuildThemePreviewMenu; public {@VFD_HEAD_BEGIN: frmMain} MainMenu: TfpgMenuBar; @@ -148,15 +150,17 @@ type TfrmAbout = class(TfpgForm) private {@VFD_HEAD_BEGIN: frmAbout} - lblName1: TfpgLabel; + lblAppName: TfpgLabel; lblVersion: TfpgLabel; - btnName1: TfpgButton; - lblName3: TfpgLabel; - lblName4: TfpgHyperlink; + btnClose: TfpgButton; + lblWrittenBy: TfpgLabel; + lblURL: TfpgHyperlink; lblCompiled: TfpgLabel; {@VFD_HEAD_END: frmAbout} + procedure SetupCaptions; + procedure FormShow(Sender: TObject); public - procedure AfterCreate; override; + procedure AfterCreate; override; class procedure Execute; end; @@ -172,9 +176,12 @@ implementation uses fpg_main, - vfdmain, fpg_iniutils, - fpg_dialogs; + fpg_dialogs, + fpg_constants, + fpg_stylemanager, + vfdmain, + vfd_constants; // Anchor images @@ -183,6 +190,25 @@ uses {@VFD_NEWFORM_IMPL} +procedure TfrmAbout.SetupCaptions; +begin + WindowTitle := rsDlgProductInfo; + lblAppName.Text := cAppName; + lblVersion.Text := Format(rsVersion, [cAppVersion]); + lblWrittenBy.Text := Format(rsWrittenBy, ['Graeme Geldenhuys']); + lblURL.URL := fpGUIWebsite; + lblURL.Text := fpGUIWebsite; + lblCompiled.Text := Format(rsCompiledOn, [{$I %date%} + ' ' + {$I %time%}]); + btnClose.Text := rsClose; +end; + +procedure TfrmAbout.FormShow(Sender: TObject); +begin + SetupCaptions; + lblURL.HotTrackColor := clBlue; + lblURL.TextColor := clRoyalBlue; +end; + procedure TfrmAbout.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} @@ -191,13 +217,14 @@ begin SetPosition(378, 267, 276, 180); WindowTitle := 'Product Information...'; Hint := ''; - Sizeable := False; WindowPosition := wpScreenCenter; + Sizeable := False; + OnShow := @FormShow; - lblName1 := TfpgLabel.Create(self); - with lblName1 do + lblAppName := TfpgLabel.Create(self); + with lblAppName do begin - Name := 'lblName1'; + Name := 'lblAppName'; SetPosition(12, 16, 255, 31); FontDesc := 'Arial-20'; Hint := ''; @@ -215,14 +242,13 @@ begin Text := 'Version: %s'; end; - btnName1 := TfpgButton.Create(self); - with btnName1 do + btnClose := TfpgButton.Create(self); + with btnClose do begin - Name := 'btnName1'; + Name := 'btnClose'; SetPosition(194, 148, 75, 24); Anchors := [anRight,anBottom]; Text := 'Close'; - Down := False; FontDesc := '#Label1'; Hint := ''; ImageName := 'stdimg.close'; @@ -230,27 +256,28 @@ begin TabOrder := 2; end; - lblName3 := TfpgLabel.Create(self); - with lblName3 do + lblWrittenBy := TfpgLabel.Create(self); + with lblWrittenBy do begin - Name := 'lblName3'; + Name := 'lblWrittenBy'; SetPosition(12, 100, 241, 14); FontDesc := 'Arial-9'; Hint := ''; Text := 'Written by Graeme Geldenhuys'; end; - lblName4 := TfpgHyperlink.Create(self); - with lblName4 do + lblURL := TfpgHyperlink.Create(self); + with lblURL do begin - Name := 'lblName4'; + Name := 'lblURL'; SetPosition(12, 116, 246, 14); - Text := 'http://fpgui.sourceforge.net'; - URL := 'http://fpgui.sourceforge.net'; FontDesc := 'Arial-9:underline'; - TextColor := clRoyalBlue; + Hint := ''; HotTrackColor := clBlue; HotTrackFont := 'Arial-9:underline'; + Text := 'http://fpgui.sourceforge.net'; + TextColor := clRoyalBlue; + URL := 'http://fpgui.sourceforge.net'; end; lblCompiled := TfpgLabel.Create(self); @@ -273,8 +300,6 @@ var begin frm := TfrmAbout.Create(nil); try - frm.lblVersion.Text := Format(frm.lblVersion.Text, [program_version]); - frm.lblCompiled.Text := Format(frm.lblCompiled.Text, [ {$I %date%} + ' ' + {$I %time%}]); frm.ShowModal; finally frm.Free; @@ -314,7 +339,6 @@ begin Name := 'btnNewForm'; SetPosition(4, 28, 25, 24); Text := ''; - Down := False; FontDesc := '#Label1'; Hint := 'Add New Form to Unit'; ImageMargin := -1; @@ -331,9 +355,8 @@ begin Name := 'btnOpen'; SetPosition(30, 28, 25, 24); Text := ''; - Down := False; FontDesc := '#Label1'; - Hint := 'Open a file'; + Hint := ''; ImageMargin := -1; ImageName := 'stdimg.open'; ImageSpacing := 0; @@ -348,7 +371,6 @@ begin Name := 'btnSave'; SetPosition(56, 28, 25, 24); Text := ''; - Down := False; FontDesc := '#Label1'; Hint := 'Save the current form design'; ImageMargin := -1; @@ -377,11 +399,12 @@ begin Name := 'chlPalette'; SetPosition(4, 67, 144, 22); Anchors := [anLeft,anBottom]; + ExtraHint := ''; FontDesc := '#List'; Hint := ''; Items.Add('-'); - TabOrder := 5; FocusItem := 0; + TabOrder := 5; end; filemenu := TfpgPopupMenu.Create(self); @@ -442,11 +465,6 @@ begin begin Name := 'previewmenu'; SetPosition(324, 36, 120, 20); - AddMenuItem('with Windows 9x', '', nil).Enabled := False; - AddMenuItem('with Windows XP', '', nil).Enabled := False; - AddMenuItem('with OpenSoft', '', nil).Enabled := False; - AddMenuItem('with Motif', '', nil).Enabled := False; - AddMenuItem('with OpenLook', '', nil).Enabled := False; end; {@VFD_BODY_END: frmMain} @@ -479,6 +497,8 @@ begin end; end; + BuildThemePreviewMenu; + chlPalette.Items.Sort; MainMenu.AddMenuItem('&File', nil).SubMenu := filemenu; MainMenu.AddMenuItem('&Settings', nil).SubMenu := setmenu; @@ -623,7 +643,7 @@ begin x := 64; - btnAnLeft := CreateButton(self, x, y - 2, 28, '', nil); + btnAnLeft := CreateButton(self, x, y - 2, 26, '', nil); with btnAnLeft do begin ImageName := 'vfd.anchorleft'; @@ -897,6 +917,7 @@ procedure TfrmMain.FormShow(Sender: TObject); begin gINI.ReadFormState(self); UpdateWindowPosition; + SetupCaptions; end; procedure TfrmMain.PaletteBarResized(Sender: TObject); @@ -937,6 +958,28 @@ begin maindsgn.OnLoadFile(maindsgn); end; +procedure TfrmMain.SetupCaptions; +begin + btnOpen.Hint := rsOpenFormFile; +end; + +procedure TfrmMain.BuildThemePreviewMenu; +var + sl: TStringList; + i: integer; +begin + sl := TStringList.Create; + fpgStyleManager.AssignStyleTypes(sl); + sl.Sort; + for i := 0 to sl.Count-1 do + begin + if sl[i] = 'auto' then + continue; + previewmenu.AddMenuItem(sl[i], '', nil).Enabled := False; + end; + sl.Free; +end; + constructor TfrmMain.Create(AOwner: TComponent); begin inherited Create(AOwner); diff --git a/uidesigner/tests/frm_menutest.pas b/uidesigner/tests/frm_menutest.pas deleted file mode 100644 index 4f707e11..00000000 --- a/uidesigner/tests/frm_menutest.pas +++ /dev/null @@ -1,86 +0,0 @@ -unit frm_menutest; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, gfxbase, fpgfx, gui_edit, - gfx_widget, gui_form, gui_label, gui_button, - gui_listbox, gui_memo, gui_combobox, gui_grid, - gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, - gui_progressbar, gui_radiobutton, gui_tab, gui_menu; - -type - - TfrmMain = class(TfpgForm) - private - procedure miExitClicked(Sender: TObject); - public - {@VFD_HEAD_BEGIN: frmMain} - MainMenu: TfpgMenuBar; - miFile: TfpgPopupMenu; - btnName1: TfpgButton; - {@VFD_HEAD_END: frmMain} - - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -{@VFD_NEWFORM_IMPL} - -procedure TfrmMain.miExitClicked(Sender: TObject); -begin - Close; -end; - -procedure TfrmMain.AfterCreate; -begin - {@VFD_BODY_BEGIN: frmMain} - Name := 'frmMain'; - SetPosition(278, 186, 399, 142); - WindowTitle := 'frmMain'; - WindowPosition := wpScreenCenter; - - MainMenu := TfpgMenuBar.Create(self); - with MainMenu do - begin - Name := 'MainMenu'; - SetPosition(0, 0, 400, 23); - Anchors := [anLeft,anRight,anTop]; - end; - - miFile := TfpgPopupMenu.Create(self); - with miFile do - begin - Name := 'miFile'; - SetPosition(200, 48, 152, 24); - AddMenuItem('&New...', 'Ctrl-N', nil); - AddMenuItem('&Open...', 'Ctrl-O', nil); - AddMenuItem('-', '', nil); - AddMenuItem('E&xit', 'Alt+F4', @miExitClicked); - end; - - btnName1 := TfpgButton.Create(self); - with btnName1 do - begin - Name := 'btnName1'; - SetPosition(8, 112, 75, 24); - Text := 'Button'; - FontDesc := '#Label1'; - ImageName := 'stdimg.quit'; - ModalResult := 0; - ShowImage := True; - OnClick := @miExitClicked; - end; - - {@VFD_BODY_END: frmMain} - - MainMenu.AddMenuItem('&File', nil).SubMenu := miFile; -end; - - -end. diff --git a/uidesigner/tests/menutest.lpi b/uidesigner/tests/menutest.lpi deleted file mode 100644 index 3f9b35ec..00000000 --- a/uidesigner/tests/menutest.lpi +++ /dev/null @@ -1,57 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> - <Title Value="menutest"/> - </General> - <VersionInfo> - <ProjectVersion Value=""/> - </VersionInfo> - <PublishOptions> - <Version Value="2"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - <RequiredPackages Count="1"> - <Item1> - <PackageName Value="fpgui_toolkit"/> - </Item1> - </RequiredPackages> - <Units Count="2"> - <Unit0> - <Filename Value="menutest.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="menutest"/> - </Unit0> - <Unit1> - <Filename Value="frm_menutest.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_menutest"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="5"/> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/uidesigner/tests/tabsheet_design.lpi b/uidesigner/tests/tabsheet_design.lpi deleted file mode 100644 index 2124c06d..00000000 --- a/uidesigner/tests/tabsheet_design.lpi +++ /dev/null @@ -1,58 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> - <Title Value="project1"/> - </General> - <VersionInfo> - <ProjectVersion Value=""/> - </VersionInfo> - <PublishOptions> - <Version Value="2"/> - <IgnoreBinaries Value="False"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - <RequiredPackages Count="1"> - <Item1> - <PackageName Value="fpgui_toolkit"/> - </Item1> - </RequiredPackages> - <Units Count="2"> - <Unit0> - <Filename Value="tabsheet_design.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="tabsheet_design"/> - </Unit0> - <Unit1> - <Filename Value="tabtest.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="tabtest"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="5"/> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/uidesigner/tests/tabtest.pas b/uidesigner/tests/tabtest.pas deleted file mode 100644 index 9355a6d2..00000000 --- a/uidesigner/tests/tabtest.pas +++ /dev/null @@ -1,226 +0,0 @@ -unit tabtest; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, gfxbase, fpgfx, gui_edit, - gfx_widget, gui_form, gui_label, gui_button, - gui_listbox, gui_memo, gui_combobox, gui_grid, - gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, - gui_progressbar, gui_radiobutton, gui_tab, gui_menu, - gui_bevel; - -type - - TfraGeneral = class(TfpgForm) - public - {@VFD_HEAD_BEGIN: fraGeneral} - lblName1: TfpgLabel; - edtName1: TfpgEdit; - memName1: TfpgMemo; - btnName1: TfpgButton; - {@VFD_HEAD_END: fraGeneral} - procedure AfterCreate; override; - end; - - - TfraAddress = class(TfpgForm) - public - {@VFD_HEAD_BEGIN: fraAddress} - edtName1: TfpgEdit; - lblName1: TfpgLabel; - lblName2: TfpgLabel; - lblName3: TfpgLabel; - cbName1: TfpgComboBox; - {@VFD_HEAD_END: fraAddress} - procedure AfterCreate; override; - end; - - - TfrmTabTest = class(TfpgForm) - private - procedure btnCloseClicked(Sender: TObject); - public - {@VFD_HEAD_BEGIN: frmTabTest} - pcName1: TfpgPageControl; - btnClose: TfpgButton; - {@VFD_HEAD_END: frmTabTest} - - // these must be added manually for now, until the GUI Designer is improved. - tsGeneral: TfpgTabSheet; - tsAddress: TfpgTabSheet; - tsAccounts: TfpgTabSheet; - fraGeneral: TfraGeneral; - fraAddress: TfraAddress; - procedure AfterCreate; override; - end; - - -{@VFD_NEWFORM_DECL} - -implementation - -{@VFD_NEWFORM_IMPL} - -procedure TfraAddress.AfterCreate; -begin - {@VFD_BODY_BEGIN: fraAddress} - Name := 'fraAddress'; - SetPosition(602, 485, 208, 127); - WindowTitle := 'fraAddress'; - - edtName1 := TfpgEdit.Create(self); - with edtName1 do - begin - Name := 'edtName1'; - SetPosition(64, 32, 120, 22); - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(4, 4, 156, 16); - Text := 'TabSheet - Address'; - FontDesc := '#Label2'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 36, 44, 16); - Text := 'Street'; - FontDesc := '#Label1'; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(8, 60, 48, 16); - Text := 'City'; - FontDesc := '#Label1'; - end; - - cbName1 := TfpgComboBox.Create(self); - with cbName1 do - begin - Name := 'cbName1'; - SetPosition(64, 56, 120, 23); - Items.Add('Somerset West'); - Items.Add('Cape Town'); - Items.Add('Durban'); - Items.Add('Jo''burg'); - Items.Add('Pretoria'); - FontDesc := '#List'; - FocusItem := 1; - end; - - {@VFD_BODY_END: fraAddress} -end; - - -procedure TfraGeneral.AfterCreate; -begin - {@VFD_BODY_BEGIN: fraGeneral} - Name := 'fraGeneral'; - SetPosition(611, 290, 197, 165); - WindowTitle := 'fraGeneral'; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(4, 4, 212, 16); - Text := 'TabSheet - General'; - FontDesc := '#Label2'; - end; - - edtName1 := TfpgEdit.Create(self); - with edtName1 do - begin - Name := 'edtName1'; - SetPosition(12, 28, 144, 22); - Anchors := [anLeft,anRight,anTop]; - Text := ''; - FontDesc := '#Edit1'; - end; - - memName1 := TfpgMemo.Create(self); - with memName1 do - begin - Name := 'memName1'; - SetPosition(12, 56, 172, 96); - Anchors := [anLeft,anRight,anTop,anBottom]; - FontDesc := '#Edit1'; - end; - - btnName1 := TfpgButton.Create(self); - with btnName1 do - begin - Name := 'btnName1'; - SetPosition(160, 28, 19, 20); - Anchors := [anRight,anTop]; - Text := '...'; - FontDesc := '#Label1'; - ImageName := ''; - ModalResult := 0; - end; - - {@VFD_BODY_END: fraGeneral} -end; - -procedure TfrmTabTest.btnCloseClicked(Sender: TObject); -begin - Close; -end; - -procedure TfrmTabTest.AfterCreate; -begin - {@VFD_BODY_BEGIN: frmTabTest} - Name := 'frmTabTest'; - SetPosition(293, 290, 275, 198); - WindowTitle := 'Tab Design Test'; - - pcName1 := TfpgPageControl.Create(self); - with pcName1 do - begin - Name := 'pcName1'; - SetPosition(8, 12, 258, 148); - Anchors := [anLeft,anRight,anTop,anBottom]; - FixedTabWidth := 0; - Style := tsTabs; - TabPosition := tpTop; - tsGeneral := AppendTabSheet('General'); - tsAddress := AppendTabSheet('Address'); - tsAccounts := AppendTabSheet('EAddress'); - ActivePage := tsGeneral; - end; - - btnClose := TfpgButton.Create(self); - with btnClose do - begin - Name := 'btnClose'; - SetPosition(192, 168, 75, 24); - Anchors := [anRight,anBottom]; - Text := 'Close'; - FontDesc := '#Label1'; - ImageName := ''; - ModalResult := 0; - OnClick := @btnCloseClicked; - end; - - {@VFD_BODY_END: frmTabTest} - - fraGeneral := TfraGeneral.Create(tsGeneral); - fraGeneral.Align := alClient; - fraAddress := TfraAddress.Create(tsAddress); - fraAddress.Align := alClient; -end; - -end. diff --git a/uidesigner/uidesigner.lpi b/uidesigner/uidesigner.lpi index 83bb344b..be5b651a 100644 --- a/uidesigner/uidesigner.lpi +++ b/uidesigner/uidesigner.lpi @@ -1,4 +1,4 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> @@ -32,7 +32,7 @@ <PackageName Value="fpgui_toolkit"/> </Item1> </RequiredPackages> - <Units Count="16"> + <Units Count="17"> <Unit0> <Filename Value="uidesigner.lpr"/> <IsPartOfProject Value="True"/> @@ -111,10 +111,15 @@ <Filename Value="icons.inc"/> <IsPartOfProject Value="True"/> </Unit15> + <Unit16> + <Filename Value="vfd_constants.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="vfd_constants"/> + </Unit16> </Units> </ProjectOptions> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <SearchPaths> <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> diff --git a/uidesigner/uidesigner.lpr b/uidesigner/uidesigner.lpr index 968a45dc..90da9d39 100644 --- a/uidesigner/uidesigner.lpr +++ b/uidesigner/uidesigner.lpr @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Library - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -25,7 +25,8 @@ uses {$ENDIF}{$ENDIF} Classes, SysUtils, fpg_base, fpg_main, vfdmain, vfdresizer, vfdforms, vfdfile, newformdesigner, vfdwidgets, vfdformparser, vfdeditors, - vfdwidgetclass, vfdutils, vfdprops, vfddesigner, vfdpropeditgrid; + vfdwidgetclass, vfdutils, vfdprops, vfddesigner, vfdpropeditgrid, + vfd_constants; procedure MainProc; @@ -37,10 +38,10 @@ begin maindsgn := TMainDesigner.Create; maindsgn.CreateWindows; - // Note: This needs improving!! + // Making sure the correct form is set as the MainForm fpgApplication.MainForm := frmMain; - { If file passed in as param, load it! } + { If a file is passed in as a parameter, then load it } maindsgn.EditedFileName := ParamStr(1); if FileExists(maindsgn.EditedFileName) then maindsgn.OnLoadFile(maindsgn); diff --git a/uidesigner/vfd_constants.pas b/uidesigner/vfd_constants.pas new file mode 100644 index 00000000..908b7436 --- /dev/null +++ b/uidesigner/vfd_constants.pas @@ -0,0 +1,91 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit contains all the language resource strings used by the + UI Designer project. Thus making it possible to translate the UI Designer + to other languages. It also contains all project constants. +} + +unit vfd_constants; + +{$mode objfpc}{$H+} + +interface + +uses + fpg_constants; + + +const + cFileFilter = '%s (%s)|%s'; + cPascalSourceFiles = '*.pp;*.pas;*.inc;*.dpr;*.lpr'; + cAppName = 'fpGUI UI Designer'; + cAppVersion = FPGUI_VERSION; + cAppNameAndVersion = cAppName + ' v' + cAppVersion; + cDesignerINIVersion = 1; + +resourcestring + rsOpenFormFile = 'Open form file'; + rsPascalSourceFiles = 'Pascal source filess'; + rsSaveFormFile = 'Save form source'; + rsVersion = 'Version: %s'; + rsWrittenBy = 'Written by %s'; + rsCompiledOn = 'Compiled on: %s'; + rsNewUnnamedForm = 'new'; + rsDesignerHelp1 = 'F11: switch to Properties'; + rsDesignerHelp2 = 'TAB, SHIFT+TAB: select next widget'; + rsDesignerHelp3 = 'F2: edit widget order'; + rsDesignerQuickHelp = 'Quick Help'; + rsLeft = 'Left'; + rsTop = 'Top'; + rsWidth = 'Width'; + rsHeight = 'Height'; + rsNewClassName = 'Class name'; + rsNewFormName = 'Form name'; + rsPosition = 'Position'; + rsFormTitle = 'Form %s'; + rsUp = 'Up'; + rsDown = 'Down'; + rsGridResolution = 'Grid resolution'; + rsRecentFilesCount = 'Recent files count'; + rsShowFullPathName = 'Show the full file path'; + rsFormDesigner = 'Form designer'; + rsOpenRecentSettings = 'Open Recent menu settings'; + rsVarious = 'Various'; + rsUndoOnPropertyExit = 'Undo on property editor exit'; + rsOneClickSelectAndMove = 'One click select and move'; + rsDefaultFileExt = 'Default file extension'; + rsUseCodeRegions = 'Use code-folding regions in auto-generated code'; + rsIndentType = 'Indent Type for generated code'; + + rsDlgProductInfo = 'Product Information'; + rsDlgSetup = 'General Settings'; + rsDlgInsertCustomWidget = 'Insert Custom Widget'; + rsDlgNewForm = 'New Form'; + rsDlgEditFormPosition = 'Form Position'; + rsDlgWidgetOrder = 'Widget Order'; + rsDlgTabOrder = 'Tab Order'; + + rsErrUnitNotFound = 'The unit <%s> was not found.'; + rsErrLoadingForm = 'Error loading form'; + rsErrFailedToFindDesignerForm = 'Failed to find Designer Form'; + rsErrFormSaveIOError = 'Form save I/O failure in <%s>.'; + rsErrNameConflict = 'Name Conflict'; + rsErrNoStringsProperty = 'Failed to find TStrings type property.'; + rsErrFailedToParseBoolean = 'Failed to parse Boolean value <%s>'; + +implementation + +end. + diff --git a/uidesigner/vfddesigner.pas b/uidesigner/vfddesigner.pas index db548784..70757ba4 100644 --- a/uidesigner/vfddesigner.pas +++ b/uidesigner/vfddesigner.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -142,13 +142,14 @@ type implementation uses + TypInfo, vfdmain, vfdutils, - TypInfo, + vfd_constants, fpg_tree; const - cEditOrder: array[TfpgEditMode] of string = ('Widget Order', 'Tab Order'); + cEditOrder: array[TfpgEditMode] of string = (rsDlgWidgetOrder, rsDlgTabOrder); { TWidgetDesigner } @@ -643,9 +644,7 @@ end; procedure TFormDesigner.EditWidgetOrTabOrder(AMode: TfpgEditMode); var frm: TWidgetOrderForm; - n, fi: integer; - cd: TWidgetDesigner; - identlevel: integer; + n: integer; lFocused: TfpgTreeNode; lNode: TfpgTreeNode; s: string; @@ -678,9 +677,7 @@ begin frm := TWidgetOrderForm.Create(nil); frm.WindowTitle := cEditOrder[AMode]; frm.Title := cEditOrder[AMode]; - fi := 0; - identlevel := 0; frm.Treeview1.RootNode.Clear; lFocused := nil; @@ -743,10 +740,10 @@ begin end; keyF1: - ShowMessage('F11: switch to Properties' + LineEnding + - 'TAB, SHIFT+TAB: select next widget' + LineEnding + - 'F2: edit widget order' + LineEnding {+ - 'F4: edit items' + LineEnding}, 'Small help'); + ShowMessage(rsDesignerHelp1 + LineEnding + + rsDesignerHelp2 + LineEnding + + rsDesignerHelp3 + LineEnding {+ + 'F4: edit items' + LineEnding}, rsDesignerQuickHelp); keyF2: EditWidgetOrTabOrder(emTabOrder); @@ -981,22 +978,22 @@ begin if Sender = frmProperties.btnLeft then begin - frm.lbPos.Text := 'Left:'; + frm.lbPos.Text := rsLeft + ':'; frm.edPos.Text := IntToStr(wg.Left); end else if Sender = frmProperties.btnTop then begin - frm.lbPos.Text := 'Top:'; + frm.lbPos.Text := rsTop + ':'; frm.edPos.Text := IntToStr(wg.Top); end else if Sender = frmProperties.btnWidth then begin - frm.lbPos.Text := 'Width:'; + frm.lbPos.Text := rsWidth + ':'; frm.edPos.Text := IntToStr(wg.Width); end else if Sender = frmProperties.btnHeight then begin - frm.lbPos.Text := 'Height:'; + frm.lbPos.Text := rsHeight + ':'; frm.edPos.Text := IntToStr(wg.Height); end; @@ -1473,7 +1470,7 @@ procedure TDesignedForm.AfterCreate; begin inherited AfterCreate; WindowPosition := wpUser; - WindowTitle := 'New Form'; + WindowTitle := rsDlgNewForm; SetPosition(300, 150, 300, 250); end; diff --git a/uidesigner/vfdfile.pas b/uidesigner/vfdfile.pas index 3db2ae31..b6636fa2 100644 --- a/uidesigner/vfdfile.pas +++ b/uidesigner/vfdfile.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: - This unit handles the load, save and merge functions. Doing + This unit handles the load, save and merge functions. Doing VFD marker searching. } diff --git a/uidesigner/vfdformparser.pas b/uidesigner/vfdformparser.pas index 831e5083..75681cbe 100644 --- a/uidesigner/vfdformparser.pas +++ b/uidesigner/vfdformparser.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -65,6 +65,8 @@ function GetColorValue(var s: string): integer; implementation +uses + vfd_constants; { TVFDFormParser } @@ -152,7 +154,7 @@ begin else if UpperCase(fs) = 'FALSE' then Result := False else - raise exception.Create('Failed to parse Boolean value <' + s + '>'); + raise Exception.CreateFmt(rsErrFailedToParseBoolean, [s]); if Result then Delete(s, 1, 4) diff --git a/uidesigner/vfdforms.pas b/uidesigner/vfdforms.pas index d1557fbc..9d9b42bd 100644 --- a/uidesigner/vfdforms.pas +++ b/uidesigner/vfdforms.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: - The main uiDesigner forms. + This unit defines various forms/dialogs used in the UI Designer. } unit vfdforms; @@ -33,18 +33,23 @@ uses fpg_combobox, fpg_trackbar, fpg_checkbox, - fpg_panel, fpg_tree; type TVFDDialog = class(TfpgForm) protected - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + procedure SetupCaptions; virtual; + procedure FormShow(Sender: TObject); virtual; + public + constructor Create(AOwner: TComponent); override; end; TInsertCustomForm = class(TVFDDialog) + protected + procedure SetupCaptions; override; public l1, l2: TfpgLabel; @@ -52,34 +57,38 @@ type edName: TfpgEdit; btnOK: TfpgButton; btnCancel: TfpgButton; - procedure AfterCreate; override; - procedure OnButtonClick(Sender: TObject); + procedure AfterCreate; override; + procedure OnButtonClick(Sender: TObject); end; TNewFormForm = class(TVFDDialog) private - procedure OnedNameKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure OnedNameKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + protected + procedure SetupCaptions; override; public l1: TfpgLabel; edName: TfpgEdit; btnOK: TfpgButton; btnCancel: TfpgButton; - procedure AfterCreate; override; - procedure OnButtonClick(Sender: TObject); + procedure AfterCreate; override; + procedure OnButtonClick(Sender: TObject); end; TEditPositionForm = class(TVFDDialog) private - procedure edPosKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure edPosKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + protected + procedure SetupCaptions; override; public lbPos: TfpgLabel; edPos: TfpgEdit; btnOK: TfpgButton; btnCancel: TfpgButton; - procedure AfterCreate; override; - procedure OnButtonClick(Sender: TObject); + procedure AfterCreate; override; + procedure OnButtonClick(Sender: TObject); end; @@ -87,6 +96,8 @@ type private function GetTitle: string; procedure SetTitle(const AValue: string); + protected + procedure SetupCaptions; override; public {@VFD_HEAD_BEGIN: WidgetOrderForm} lblTitle: TfpgLabel; @@ -105,13 +116,15 @@ type end; - TfrmVFDSetup = class(TfpgForm) + TfrmVFDSetup = class(TVFDDialog) private FINIVersion: integer; - procedure FormShow(Sender: TObject); procedure LoadSettings; procedure SaveSettings; procedure btnOKClick(Sender: TObject); + protected + procedure FormShow(Sender: TObject); override; + procedure SetupCaptions; override; public {@VFD_HEAD_BEGIN: frmVFDSetup} lb1: TfpgLabel; @@ -132,7 +145,6 @@ type cbIndentationType: TfpgComboBox; lblIndentType: TfpgLabel; {@VFD_HEAD_END: frmVFDSetup} - constructor Create(AOwner: TComponent); override; procedure AfterCreate; override; procedure BeforeDestruction; override; end; @@ -145,20 +157,27 @@ uses fpg_main, fpg_iniutils, fpg_constants, + fpg_utils, + vfd_constants, vfdprops; // used to get Object Inspector defaults -const - cDesignerINIVersion = 1; - { TInsertCustomForm } +procedure TInsertCustomForm.SetupCaptions; +begin + inherited SetupCaptions; + WindowTitle := rsDlgInsertCustomWidget; + l1.Text := fpgAddColon(rsNewClassName); + l2.Text := fpgAddColon(rsName); +end; + procedure TInsertCustomForm.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} inherited; WindowPosition := wpScreenCenter; - WindowTitle := 'Insert Custom Widget'; + WindowTitle := 'TInsertCustomForm'; SetPosition(0, 0, 300, 100); l1 := CreateLabel(self, 8, 4, 'Class name:'); @@ -166,8 +185,8 @@ begin edClass.Text := 'Tfpg'; l2 := CreateLabel(self, 8, 48, 'Name:'); edName := CreateEdit(self, 8, 68, 150, 0); - btnOK := CreateButton(self, 180, 20, 100, 'OK', @OnButtonClick); - btnCancel := CreateButton(self, 180, 52, 100, 'Cancel', @OnButtonClick); + btnOK := CreateButton(self, 180, 20, 100, rsOK, @OnButtonClick); + btnCancel := CreateButton(self, 180, 52, 100, rsCancel, @OnButtonClick); {%endregion} end; @@ -188,12 +207,19 @@ begin btnOK.Click; end; +procedure TNewFormForm.SetupCaptions; +begin + inherited SetupCaptions; + WindowTitle := rsDlgNewForm; + l1.Text := fpgAddColon(rsNewFormName); +end; + procedure TNewFormForm.AfterCreate; begin inherited AfterCreate; WindowPosition := wpScreenCenter; SetPosition(0, 0, 286, 66); - WindowTitle := 'New Form'; + WindowTitle := 'TNewFormForm'; l1 := CreateLabel(self, 8, 8, 'Form name:'); edName := CreateEdit(self, 8, 28, 180, 0); @@ -220,16 +246,23 @@ begin btnOK.Click; end; +procedure TEditPositionForm.SetupCaptions; +begin + inherited SetupCaptions; + WindowTitle := rsDlgEditFormPosition; + lbPos.Text := fpgAddColon(rsPosition); +end; + procedure TEditPositionForm.AfterCreate; begin inherited AfterCreate; WindowPosition := wpScreenCenter; Width := 186; Height := 66; - WindowTitle := 'Position'; + WindowTitle := 'TEditPositionForm'; Sizeable := False; - lbPos := CreateLabel(self, 8, 8, 'Pos: '); + lbPos := CreateLabel(self, 8, 8, 'Pos:'); edPos := CreateEdit(self, 8, 28, 80, 0); edPos.OnKeyPress := @edPosKeyPressed; btnOK := CreateButton(self, 98, 8, 80, rsOK, @OnButtonClick); @@ -256,6 +289,17 @@ begin lblTitle.Text := Format(lblTitle.Text, [AValue]); end; +procedure TWidgetOrderForm.SetupCaptions; +begin + inherited SetupCaptions; + WindowTitle := rsDlgWidgetOrder; + lblTitle.Text := fpgAddColon(rsFormTitle); + btnOK.Text := rsOK; + btnCancel.Text := rsCancel; + btnUp.Text := rsUp; + btnDown.Text := rsDown; +end; + constructor TWidgetOrderForm.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -275,7 +319,7 @@ begin {@VFD_BODY_BEGIN: WidgetOrderForm} Name := 'WidgetOrderForm'; SetPosition(534, 173, 426, 398); - WindowTitle := 'Widget order'; + WindowTitle := 'TWidgetOrderForm'; Hint := ''; WindowPosition := wpScreenCenter; @@ -388,6 +432,11 @@ end; { TVFDDialogBase } +procedure TVFDDialog.FormShow(Sender: TObject); +begin + SetupCaptions; +end; + procedure TVFDDialog.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); begin if keycode = keyEscape then @@ -398,8 +447,20 @@ begin inherited HandleKeyPress(keycode, shiftstate, consumed); end; +procedure TVFDDialog.SetupCaptions; +begin + // to be implemented in descendants +end; + +constructor TVFDDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + OnShow := @FormShow; +end; + procedure TfrmVFDSetup.FormShow(Sender: TObject); begin + inherited FormShow(Sender); { If it's an older version, don't load the size because the dialog dimensions probably changed in a newer version } if FINIVersion >= cDesignerINIVersion then @@ -408,6 +469,25 @@ begin gINI.ReadFormState(self, -1, -1, True); end; +procedure TfrmVFDSetup.SetupCaptions; +begin + inherited SetupCaptions; + WindowTitle := rsDlgSetup; + lb1.Text := fpgAddColon(rsGridResolution); + btnOK.Text := rsOK; + btnCancel.Text := rsCancel; + lblRecentFiles.Text := fpgAddColon(rsRecentFilesCount); + chkFullPath.Text := rsShowFullPathName; + lblName1.Text := rsFormDesigner; + lblName2.Text := rsOpenRecentSettings; + lblName3.Text := rsVarious; + chkUndoOnExit.Text := rsUndoOnPropertyExit; + chkOneClick.Text := rsOneClickSelectAndMove; + Label1.Text := fpgAddColon(rsDefaultFileExt); + chkCodeRegions.Text := rsUseCodeRegions; + lblIndentType.Text := fpgAddColon(rsIndentType); +end; + procedure TfrmVFDSetup.LoadSettings; begin FINIVersion := gINI.ReadInteger('Designer', 'Version', 0); @@ -440,12 +520,6 @@ begin ModalResult := mrOK; end; -constructor TfrmVFDSetup.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - OnShow := @FormShow; -end; - procedure TfrmVFDSetup.AfterCreate; begin {@VFD_BODY_BEGIN: frmVFDSetup} diff --git a/uidesigner/vfdmain.pas b/uidesigner/vfdmain.pas index 1f5485dc..5dcb90d4 100644 --- a/uidesigner/vfdmain.pas +++ b/uidesigner/vfdmain.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -28,16 +28,12 @@ uses fpg_main, fpg_widget, fpg_dialogs, - fpg_constants, vfdprops, vfdforms, vfddesigner, vfdfile, newformdesigner; -const - program_version = FPGUI_VERSION; - type TMainDesigner = class(TObject) @@ -85,9 +81,11 @@ var implementation uses - vfdformparser, + fpg_constants, fpg_iniutils, - fpg_utils; + fpg_utils, + vfd_constants, + vfdformparser; var DefaultPasExt : String = '.pas'; @@ -123,8 +121,10 @@ begin begin afiledialog := TfpgFileDialog.Create(nil); afiledialog.Filename := EditedFilename; - afiledialog.WindowTitle := 'Open form file'; - afiledialog.Filter := 'Pascal source files (*.pp;*.pas;*.inc;*.dpr;*.lpr)|*.pp;*.pas;*.inc;*.dpr;*.lpr|All Files (*)|*'; + afiledialog.WindowTitle := rsOpenFormFile; + afiledialog.Filter := + Format(cFileFilter, [rsPascalSourceFiles, cPascalSourceFiles, cPascalSourceFiles]) + + '|' + Format(cFileFilter, [rsAllFiles, AllFilesMask, AllFilesMask]); if afiledialog.RunOpenFile then begin EditedFileName := aFileDialog.Filename; @@ -147,7 +147,7 @@ begin if not fpgFileExists(fname) then begin - ShowMessage('File does not exists.', 'Error loading form'); + ShowMessage(Format(rsErrUnitNotFound, [fname]), rsErrLoadingForm); Exit; end; @@ -186,8 +186,10 @@ begin begin afiledialog := TfpgFileDialog.Create(nil); afiledialog.Filename := EditedFilename; - afiledialog.WindowTitle := 'Save form source'; - afiledialog.Filter := 'Pascal source files (*.pp;*.pas;*.inc;*.dpr;*.lpr)|*.pp;*.pas;*.inc;*.dpr;*.lpr|All Files (*)|*'; + afiledialog.WindowTitle := rsSaveFormFile; + afiledialog.Filter := + Format(cFileFilter, [rsPascalSourceFiles, cPascalSourceFiles, cPascalSourceFiles]) + + '|' + Format(cFileFilter, [rsAllFiles, AllFilesMask, AllFilesMask]); if afiledialog.RunSaveFile then begin fname:=aFileDialog.Filename; @@ -224,7 +226,7 @@ begin fd := nil; fd := Designer(n); if fd = nil then - raise Exception.Create('Failed to find Designer Form'); + raise Exception.Create(rsErrFailedToFindDesignerForm); FFile.SetFormData(fd.Form.Name, fd.GetFormSourceDecl, fd.GetFormSourceImpl); end; @@ -241,8 +243,7 @@ begin frmMain.mru.AddItem(fname); except on E: Exception do - raise Exception.Create('Form save I/O failure in TMainDesigner.OnSaveFile.' + #13 + - E.Message); + raise Exception.CreateFmt(rsErrFormSaveIOError + LineEnding + E.Message, ['TMainDesigner.OnSaveFile']); end; end; @@ -302,7 +303,7 @@ begin begin if DoesNameAlreadyExist(nfrm.edName.Text) then begin - TfpgMessageDialog.Critical('Name Conflict','The form name already exists in the current unit, please try again'); + TfpgMessageDialog.Critical(rsErrNameConflict,'The form name already exists in the current unit, please try again'); exit; end; fd := TFormDesigner.Create; @@ -323,7 +324,7 @@ end; procedure TMainDesigner.CreateWindows; begin frmMain := TfrmMain.Create(nil); - frmMain.WindowTitle := 'fpGUI Designer v' + program_version; + frmMain.WindowTitle := cAppNameAndVersion; frmMain.Show; frmProperties := TfrmProperties.Create(nil); @@ -459,8 +460,8 @@ begin FEditedFileName := Value; s := ExtractFileName(FEditedFileName); if s = '' then - s := '[new]'; - frmMain.WindowTitle := 'fpGUI Designer v' + program_version + ' - ' + s; + s := '[' + rsNewUnnamedForm + ']'; + frmMain.WindowTitle := cAppNameAndVersion + ' - ' + s; end; procedure TMainDesigner.LoadDefaults; diff --git a/uidesigner/vfdprops.pas b/uidesigner/vfdprops.pas index faf4d858..55fff148 100644 --- a/uidesigner/vfdprops.pas +++ b/uidesigner/vfdprops.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -176,6 +176,7 @@ uses TypInfo, vfdformparser, vfdeditors, + vfd_constants, fpg_dialogs; @@ -442,7 +443,7 @@ var begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); if not Assigned(sl) then - raise Exception.Create('Failed to find TStrings type property.'); + raise Exception.Create(rsErrNoStringsProperty); Result := ''; @@ -461,7 +462,7 @@ var begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); if not Assigned(sl) then - raise Exception.Create('Failed to find TStrings type property.'); + raise Exception.Create(rsErrNoStringsProperty); Result := '[' + IntToStr(sl.Count) + ' lines]'; end; @@ -471,7 +472,7 @@ var begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); if not Assigned(sl) then - raise Exception.Create('Failed to find TStrings type property.'); + raise Exception.Create(rsErrNoStringsProperty); EditStringList(sl); end; @@ -500,7 +501,7 @@ begin begin sl := TStringList(GetObjectProp(wg, Name, TStrings)); if not Assigned(sl) then - raise Exception.Create('Failed to find TStrings type property.'); + raise Exception.Create(rsErrNoStringsProperty); sl.Add(sval); end; end; @@ -854,7 +855,6 @@ var PropInfo: PPropInfo; i: integer; c: TfpgColor; - nc: TfpgColor; begin PropInfo := GetPropInfo(wg.ClassType, Name); i := GetOrdProp(wg, Name); diff --git a/uidesigner/vfdwidgetclass.pas b/uidesigner/vfdwidgetclass.pas index 7b9d3c62..76bececc 100644 --- a/uidesigner/vfdwidgetclass.pas +++ b/uidesigner/vfdwidgetclass.pas @@ -162,7 +162,7 @@ end; function TVFDWidgetProperty.GetPropertySource(wg: TfpgWidget; const ident: string): string; begin - + Result := ''; end; function TVFDWidgetProperty.ParseSourceLine(wg: TfpgWidget; const line: string): boolean; diff --git a/uidesigner/vfdwidgets.pas b/uidesigner/vfdwidgets.pas index 26efe1e3..2238e4e5 100644 --- a/uidesigner/vfdwidgets.pas +++ b/uidesigner/vfdwidgets.pas @@ -172,7 +172,6 @@ begin sizeof(stdimg_vfd_colorlistbox), 0, 0); - fpgImages.AddMaskedBMP( 'vfd.combobox', @stdimg_vfd_combobox, sizeof(stdimg_vfd_combobox), @@ -322,6 +321,10 @@ begin 'vfd.hyperlink', @stdimg_vfd_hyperlink, sizeof(stdimg_vfd_hyperlink), 0, 0); + + fpgImages.AddBMP( + 'vfd.scrollframe', @stdimg_vfd_scrollframe, + sizeof(stdimg_vfd_scrollframe)); end; procedure AddWidgetPosProps(wgc: TVFDWidgetClass); @@ -691,6 +694,7 @@ begin wc.AddProperty('Position', TPropertyInteger, ''); wc.AddProperty('ShowHint', TPropertyBoolean, ''); wc.AddProperty('ShowPosition', TPropertyBoolean, ''); + wc.AddProperty('SliderLength', TPropertyInteger, ''); wc.AddProperty('TabOrder', TPropertyInteger, 'The tab order'); wc.AddProperty('TextColor', TPropertyColor, ''); wc.WidgetIconName := 'vfd.trackbar'; |
