You've already forked lazarus-ccr
20070107 release of Orpheus - initial commit to SVN.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
BIN
components/orpheus/ORBLUEDOT.bmp
Normal file
BIN
components/orpheus/ORBLUEDOT.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 318 B |
BIN
components/orpheus/ORBTNCLC.bmp
Normal file
BIN
components/orpheus/ORBTNCLC.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 206 B |
BIN
components/orpheus/ORCOLUMNMOVECURSOR.cur
Normal file
BIN
components/orpheus/ORCOLUMNMOVECURSOR.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 326 B |
BIN
components/orpheus/ORREDDOT.bmp
Normal file
BIN
components/orpheus/ORREDDOT.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 318 B |
BIN
components/orpheus/ORROWMOVECURSOR.cur
Normal file
BIN
components/orpheus/ORROWMOVECURSOR.cur
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 326 B |
BIN
components/orpheus/ORTCCHECKGLYPHS.bmp
Normal file
BIN
components/orpheus/ORTCCHECKGLYPHS.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 454 B |
BIN
components/orpheus/ORTCCOMBOARROW.bmp
Normal file
BIN
components/orpheus/ORTCCOMBOARROW.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 162 B |
570
components/orpheus/OrphStatus.html
Normal file
570
components/orpheus/OrphStatus.html
Normal file
@ -0,0 +1,570 @@
|
|||||||
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
|
||||||
|
<!--Copyright 2006 Phil Hess-->
|
||||||
|
<HTML>
|
||||||
|
|
||||||
|
<HEAD>
|
||||||
|
|
||||||
|
<TITLE>Status of Orpheus Port</TITLE>
|
||||||
|
|
||||||
|
<META NAME="AUTHOR" CONTENT="Phil Hess">
|
||||||
|
</HEAD>
|
||||||
|
|
||||||
|
<BODY>
|
||||||
|
|
||||||
|
<CENTER>
|
||||||
|
<H1>Status of Orpheus Port</H1>
|
||||||
|
</CENTER>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<H3>Contents</H3>
|
||||||
|
<A HREF="#Whats_New">What's New</A><BR>
|
||||||
|
<A HREF="#Introduction">Introduction</A><BR>
|
||||||
|
<A HREF="#Installation">Installation</A><BR>
|
||||||
|
<A HREF="#Platforms_Tested">Platforms Tested</A><BR>
|
||||||
|
<A HREF="#Examples">Examples</A><BR>
|
||||||
|
<A HREF="#Porting_Philosophy">Porting Philosophy</A><BR>
|
||||||
|
<A HREF="#Usage_Notes">Usage Notes</A><BR>
|
||||||
|
<A HREF="#Limitations">Limitations</A><BR>
|
||||||
|
<A HREF="#Status_Controls">Status of Individual Controls</A><BR>
|
||||||
|
<A HREF="#To_Do">To Do</A><BR>
|
||||||
|
<A HREF="#Other_Resources">Other Resources</A><P>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Whats_New"></A><H3>What's New</H3>
|
||||||
|
|
||||||
|
<UL>
|
||||||
|
<LI>20070107 release
|
||||||
|
<UL>
|
||||||
|
<LI>TOvcVirtualListBox control added.
|
||||||
|
<LI>Installation no longer registers TOvcSimpleField and TOvcTCSimpleField
|
||||||
|
controls (see myovcreg.pas) on non-Windows platforms since these two controls
|
||||||
|
don't work on other platforms and crash Lazarus IDE if added to a form on
|
||||||
|
those platforms.
|
||||||
|
</UL>
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Introduction"></A><H3>Introduction</H3>
|
||||||
|
|
||||||
|
These notes describe the status of the OrphPort Project, an attempt to
|
||||||
|
port a subset of TurboPower's Orpheus controls to <A HREF="http://www.lazarus.freepascal.org">Lazarus</A>
|
||||||
|
and <A HREF="http://www.freepascal.org">Free Pascal</A>. At this time,
|
||||||
|
several <B>enhanced label controls</B> and most of the <B>table (grid) controls</B>
|
||||||
|
have been ported. Some of the controls
|
||||||
|
work quite well on multiple platforms; others need more work or
|
||||||
|
await better support by the Lazarus LCL or by specific widgetsets before
|
||||||
|
they are fully functional. The table below gives the status of individual
|
||||||
|
controls. You are encouraged to work on improving these controls
|
||||||
|
(see <A HREF="#To_Do">To Do list</A>). Please send your bug reports, suggestions
|
||||||
|
and patches to:<P>
|
||||||
|
|
||||||
|
MacPgmr (at) fastermac (dot) net<P>
|
||||||
|
|
||||||
|
<I>Note:</I> You can also post to the "Ported from Delphi/Kylix" section of the Lazarus
|
||||||
|
forum if you want your bug reports and suggestions to be seen by the entire
|
||||||
|
Lazarus community.<P>
|
||||||
|
|
||||||
|
The ported source code is here: <A HREF="http://web.fastermac.net/~MacPgmr/OrphPort/downloads">http://web.fastermac.net/~MacPgmr/OrphPort/downloads</A><P>
|
||||||
|
|
||||||
|
The original Orpheus 4.06 source code that this port was based on is here:
|
||||||
|
|
||||||
|
<A HREF="http://sourceforge.net/projects/tporpheus">http://sourceforge.net/projects/tporpheus</A>
|
||||||
|
(although you don't need this for Lazarus)<p>
|
||||||
|
|
||||||
|
TurboPower's 1,392-page Orpheus User's Manual is also available from the Source Forge site.<P>
|
||||||
|
|
||||||
|
Note that the ported source remains under the original MPL 1.1 license.
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Installation"></A><H3>Installation</H3>
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>Unzip the ported source files into their own folder.
|
||||||
|
<LI>Start Lazarus.
|
||||||
|
<LI>Optionally, choose File | New | Application to make sure Lazarus doesn't
|
||||||
|
mess up the currently open project.
|
||||||
|
<LI>Choose Component | Open package file and select orpheus.lpk.
|
||||||
|
<LI>Click Compile to make sure your version of Lazarus can compile the
|
||||||
|
Orpheus units.
|
||||||
|
<LI>Click Install and click Yes when prompted to rebuild the Lazarus IDE.
|
||||||
|
<LI>After rebuilding is finished, restart Lazarus if it didn't restart
|
||||||
|
automatically. The installed Orpheus controls will be on the Orpheus tab
|
||||||
|
of the component palette.
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
<I>Important!</I> If you don't have write access to the folder where Lazarus
|
||||||
|
is installed, you may have problems rebuilding the Lazarus IDE with older
|
||||||
|
versions of Lazarus. However, if you have a relatively new version of Lazarus,
|
||||||
|
it will compile itself to the ~/.lazarus/bin folder if you don't have write
|
||||||
|
access to the Lazarus install folder. After rebuilding, be sure to start
|
||||||
|
~/.lazarus/bin/lazarus, not the installed Lazarus.<P>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Platforms_Tested"></A><H3>Platforms Tested</H3>
|
||||||
|
|
||||||
|
<TABLE BORDER=1 CELLPADDING=3>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TH>Platform</TH>
|
||||||
|
<TH>OS Version</TH>
|
||||||
|
<TH>Library Versions</TH>
|
||||||
|
<TH>Widgetsets Tested</TH>
|
||||||
|
<TH>Lazarus Version Tested</TH>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>Windows</TD>
|
||||||
|
<TD>XP SP2</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>win32</TD>
|
||||||
|
<TD>20070105 snapshot of 0.9.21 with FPC 2.1.1</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>OS X</TD>
|
||||||
|
<TD>10.3.9 (Panther) on PowerPC</TD>
|
||||||
|
<TD>gtk: 1.2.0.9.1<BR>qt: 4.1.4</TD>
|
||||||
|
<TD>gtk, carbon, qt</TD>
|
||||||
|
<TD>20070105 snapshot of 0.9.21 with FPC 2.0.4</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>Linux</TD>
|
||||||
|
<TD>SUSE 10.1</TD>
|
||||||
|
<TD>gtk: 1.2.10-907</TD>
|
||||||
|
<TD>gtk</TD>
|
||||||
|
<TD>Stable 0.9.20 with FPC 2.0.4</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
</TABLE><BR>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Examples"></A><H3>Examples</H3>
|
||||||
|
|
||||||
|
The source for several small test applications is included which demonstrates
|
||||||
|
most of the ported controls. Open each test app's .lpi file and compile it once
|
||||||
|
Orpheus has been installed in Lazarus. Folders for the test apps are located
|
||||||
|
in the <I>tests</I> folder in your Orpheus folder, as follows:
|
||||||
|
<UL>
|
||||||
|
<LI>TestTable - demos TOvcTable and various table cell controls (column
|
||||||
|
headers, row labels, string, memo, check box, combo box, bitmap).
|
||||||
|
<LI>TestURL - demos TOvcURL
|
||||||
|
<LI>TestRLbl - demos TOvcRotatedLabel
|
||||||
|
<LI>TestLabel - demos TOvcLabel
|
||||||
|
<LI>TestVLB - demos TOvcVirtualListBox
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
To see the TOvcSpinner control in action, try out the table's Rows and Columns
|
||||||
|
property editors with the TestTable app.<P>
|
||||||
|
|
||||||
|
<I>Note:</I> The TestTable app uses the included .bmp files to demo the
|
||||||
|
TOvcTCBitMap control. These bitmap files are not needed to rebuild the Lazarus
|
||||||
|
IDE since they're in the ovcreg.lrs resource file, but they are
|
||||||
|
included for completeness.<p>
|
||||||
|
|
||||||
|
<I>Tip:</I> The necessary files for compiling the test apps with Delphi are
|
||||||
|
also included (.dof, .dfm, .bdsproj). If you have Delphi you can compile
|
||||||
|
the apps to see exactly how the Orpheus controls are supposed to look and
|
||||||
|
behave. Note that with the free Turbo Delphi Explorer you can't install
|
||||||
|
Orpheus (a limitation of the free version). However, you can still compile
|
||||||
|
the test apps, as follows:
|
||||||
|
<UL>
|
||||||
|
<LI>Start Turbo Delphi Explorer and open the test app's .bdsproj file.
|
||||||
|
<LI>Click Ignore All to proceed when Delphi encounters the unrecognized
|
||||||
|
Orpheus controls.
|
||||||
|
<LI>Choose File | Close and click Cancel to close the main form.
|
||||||
|
<LI>Choose Project | Options and make sure the Search path in
|
||||||
|
Directories/Conditionals points to your Orpheus folder.
|
||||||
|
<LI>Choose Project | Compile to compile the test app.
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Porting_Philosophy"></A><H3>Porting Philosophy</H3>
|
||||||
|
|
||||||
|
<UL>
|
||||||
|
<LI>All changes to the original source code were made via conditional
|
||||||
|
compiling (IFDEF's). Thus the ported source retains full Delphi compatibility.
|
||||||
|
An added benefit is that you can see what the original code was, something
|
||||||
|
that is often lost with ported code.
|
||||||
|
<LI>A compatibility unit, <I>MyMisc</I>, was added to fill in gaps in the
|
||||||
|
Lazarus LCL and provide other compatibility routines.
|
||||||
|
<LI>Orpheus functions written in assembly were "Pascal-ized" so the ported code could
|
||||||
|
be compiled on non-Intel platforms.
|
||||||
|
<LI>For now, the Lazarus package (orpheus.lpk) compiles the source with range,
|
||||||
|
overflow and stack checking turned on. This revealed several apparently harmless
|
||||||
|
bugs in the TurboPower code, which have been fixed. To find these and other
|
||||||
|
minor bugs, grep the source for "TurboPower bug".
|
||||||
|
<LI>In general, no other significant changes or "improvements" were made to
|
||||||
|
the source. An exception is the o32tcflx unit, where a few additions were
|
||||||
|
made to correct apparent omissions or inconsistencies.
|
||||||
|
<LI>A note on comments: Comments added to the ported source are generally
|
||||||
|
marked with "//". However, the "o32" units (developed later than other units
|
||||||
|
by TurboPower) already included some "//" comments. With these units, you can
|
||||||
|
tell the added comments by their context (near IFDEF's, for example).
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Usage_Notes"></A><H3>Usage Notes</H3>
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>When you first add an Orpheus control to a form, Lazarus will add
|
||||||
|
the Orpheus unit to the uses section of your main source file (.lpr).
|
||||||
|
This pulls in a great deal of code that you don't need. Delete the Orpheus unit
|
||||||
|
from the uses section to reduce the size of your executable file.<P>
|
||||||
|
<LI>Several of the ported controls are not supported by the GTK widgetset
|
||||||
|
(see table below). Don't use these controls in cross-platform applications.
|
||||||
|
Just opening a form that has a TOvcSimpleField or TOvcTCSimpleField control
|
||||||
|
on it will likely crash the Lazarus IDE with GTK. Use the
|
||||||
|
TO32FlexEdit and TO32TCFlexEdit controls in place of TOvcSimpleField and
|
||||||
|
TOvcTCSimpleField controls in cross-platform applications.<P>
|
||||||
|
<LI>To display the TOvcLabel's Style Manager property editor in the Lazarus
|
||||||
|
IDE, right-click on the TOvcLabel control (Apple key+click on Mac). You can
|
||||||
|
also change Style Manager properties via the CustomSettings in the
|
||||||
|
Object Inspector. Also, with GTK, the default clNone Color displays a black
|
||||||
|
background, so be sure to set ParentColor to True or select a different
|
||||||
|
Color.<P>
|
||||||
|
<LI>An added benefit of the Orpheus TOvcSpinner control is that it is
|
||||||
|
available for Delphi too, unlike the LCL TSpinEdit, which has no equivalent
|
||||||
|
in the Delphi VCL.
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Limitations"></A><H3>Limitations</H3>
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>The TO32FlexEdit and TO32TCFlexEdit controls include code for displaying
|
||||||
|
an optional button within the text editing area. However, this TBitBtn-within-
|
||||||
|
a-TEdit is not supported by the LCL, so the code has been IFDEF'd out for now.
|
||||||
|
If this is ever supported by the LCL, defining ButtonOkay in o32flxed.pas
|
||||||
|
is all that's needed to enable the button code.<P>
|
||||||
|
<LI>Widgetsets generally implement LCL controls by creating native controls
|
||||||
|
that correspond to the LCL controls (text edit, check box, etc.). However,
|
||||||
|
Orpheus builds its TOvcSimpleField control from TCustomControl, rather than
|
||||||
|
descending from an existing edit control such as TCustomEdit. This sort of
|
||||||
|
edit control does not appear to be supported by the GTK widgetset.<P>
|
||||||
|
<LI>The GTK and Carbon widgetsets do not support TOvcRotatedLabel, apparently
|
||||||
|
because the GetTextMetrics function is not fully implemented on those
|
||||||
|
widgetsets.
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Status_Controls"></A><H3>Status of Individual Controls</H3>
|
||||||
|
|
||||||
|
<TABLE BORDER=1 CELLPADDING=3>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TH>Control</TH>
|
||||||
|
<TH>VCL / LCL ancestor</TH>
|
||||||
|
<TH>Description</TH>
|
||||||
|
<TH>Issues / To-do</TH>
|
||||||
|
<TH>win32</TH>
|
||||||
|
<TH>gtk</TH>
|
||||||
|
<TH>carbon</TH>
|
||||||
|
<TH>qt</TH>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcRotatedLabel<BR><IMG SRC="TOVCROTATEDLABEL.bmp"></TD>
|
||||||
|
<TD>TGraphicControl</TD>
|
||||||
|
<TD>Rotated text</TD>
|
||||||
|
<TD>gtk and carbon don't support</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Not working</TD>
|
||||||
|
<TD>Not working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcLabel<BR><IMG SRC="TOVCLABEL.bmp"></TD>
|
||||||
|
<TD>TGraphicControl</TD>
|
||||||
|
<TD>Fancy shading, color and highlighting</TD>
|
||||||
|
<TD>Property editor still needs work</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Not working</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcURL<BR><IMG SRC="TOVCURL.bmp"></TD>
|
||||||
|
<TD>TCustomLabel</TD>
|
||||||
|
<TD>Looks and acts like HTML hyperlink</TD>
|
||||||
|
<TD>No TLabel yet on carbon</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Not working</TD>
|
||||||
|
<TD>Partial</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcSpinner<BR><IMG SRC="TOVCSPINNER.bmp"></TD>
|
||||||
|
<TD>TCustomControl</TD>
|
||||||
|
<TD>Can associate with a TEdit; 8 different styles</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcVirtualListBox<BR><IMG SRC="TOVCVIRTUALLISTBOX.bmp"></TD>
|
||||||
|
<TD>TCustomControl</TD>
|
||||||
|
<TD>Tabs, header, huge number of rows</TD>
|
||||||
|
<TD>Scrolling problems</TD>
|
||||||
|
<TD>Partial</TD>
|
||||||
|
<TD>Partial</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>Not working</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcSimpleField<BR><IMG SRC="TOVCSIMPLEFIELD.bmp"></TD>
|
||||||
|
<TD>TCustomControl</TD>
|
||||||
|
<TD>Edit control with validation</TD>
|
||||||
|
<TD>gtk doesn't support</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TO32FlexEdit<BR><IMG SRC="TO32FLEXEDIT.bmp"></TD>
|
||||||
|
<TD>TCustomEdit</TD>
|
||||||
|
<TD>Edit control with validation</TD>
|
||||||
|
<TD>See "To Do" list</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTable<BR><IMG SRC="TOVCTABLE.bmp"></TD>
|
||||||
|
<TD>TCustomControl</TD>
|
||||||
|
<TD>Full-featured grid control</TD>
|
||||||
|
<TD>See "To Do" list</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCColHead<BR><IMG SRC="TOVCTCCOLHEAD.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Table column headings</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCRowHead<BR><IMG SRC="TOVCTCROWHEAD.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Table row headings</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCString<BR><IMG SRC="TOVCTCSTRING.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TEdit)</TD>
|
||||||
|
<TD>Table cell for editing strings</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCSimpleField<BR><IMG SRC="TOVCTCSIMPLEFIELD.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TOvcSimpleField)</TD>
|
||||||
|
<TD>Table cell for editing strings, with validation</TD>
|
||||||
|
<TD>gtk doesn't support</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Crashes</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCMemo<BR><IMG SRC="TOVCTCMEMO.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TMemo)</TD>
|
||||||
|
<TD>Table cell for editing memo text</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCCheckBox<BR><IMG SRC="TOVCTCCHECKBOX.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TCustomControl)</TD>
|
||||||
|
<TD>Table cell for check box</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCComboBox<BR><IMG SRC="TOVCTCCOMBOBOX.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TComboBox)</TD>
|
||||||
|
<TD>Table cell for combo box</TD>
|
||||||
|
<TD>Dropdown problem w/o XP manifest</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCBitmap<BR><IMG SRC="TOVCTCBITMAP.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Table cell for displaying bitmap</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCGlyph<BR><IMG SRC="TOVCTCGLYPH.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Table cell for cycling thru glyphs</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working?</TD>
|
||||||
|
<TD>Working?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcTCIcon<BR><IMG SRC="TOVCTCICON.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Table cell for displaying icon</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working?</TD>
|
||||||
|
<TD>Working?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TO32TCFlexEdit<BR><IMG SRC="TO32TCFLEXEDIT.bmp"></TD>
|
||||||
|
<TD>TComponent<BR>(edits with TO32FlexEdit)</TD>
|
||||||
|
<TD>Table cell for editing strings, with validation</TD>
|
||||||
|
<TD> </TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>Working</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
<TR VALIGN=TOP>
|
||||||
|
<TD>TOvcController<BR><IMG SRC="TOVCCONTROLLER.bmp"></TD>
|
||||||
|
<TD>TComponent</TD>
|
||||||
|
<TD>Key-to-command translator</TD>
|
||||||
|
<TD>Property editor uses TTabSet</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
<TD>?</TD>
|
||||||
|
</TR>
|
||||||
|
|
||||||
|
</TABLE>
|
||||||
|
<BR>
|
||||||
|
|
||||||
|
Notes:<BR>
|
||||||
|
(1) "Working" means control is basically functional. "Partial" means
|
||||||
|
control compiles, installs in IDE and displays at run-time, but doesn't function
|
||||||
|
correctly. "Not working" means control compiles and installs in IDE but
|
||||||
|
doesn't display correctly. "Widgetset doesn't support" means the widgetset
|
||||||
|
currently does not provide the support needed for the control.<BR>
|
||||||
|
(2) TOvcSimpleField and TOvcTable require a TOvcController on form.
|
||||||
|
However, TO32FlexEdit doesn't need TOvcController.<P>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="To_Do"></A><H3>To Do</H3>
|
||||||
|
<UL>
|
||||||
|
<LI>TOvcLabel
|
||||||
|
<UL>
|
||||||
|
<LI>Figure out why TOvcColorComboBox controls in Style Manager property editor
|
||||||
|
don't work.
|
||||||
|
<LI>Figure out why Color's default value (clNone) displays black
|
||||||
|
background with GTK. Workaround for now is to set TOvcLabel's
|
||||||
|
ParentColor to True in Object Inspector or select a different Color.
|
||||||
|
</UL>
|
||||||
|
<LI>TOvcVirtualListBox
|
||||||
|
<UL>
|
||||||
|
<LI>Fix scrolling problems on both Windows and GTK.
|
||||||
|
<LI>Figure out why double-click doesn't work on GTK.
|
||||||
|
</UL>
|
||||||
|
<LI>TO32FlexEdit
|
||||||
|
<UL>
|
||||||
|
<LI>Figure out why, on Windows, presence of XP manifest prevents setting Text.
|
||||||
|
<LI>Come up with workaround for LCL's lack of MakeObjectInstance for making
|
||||||
|
callback function from method. Without this, control's validation is not
|
||||||
|
performed. (See LclEditWindowProc in ovctccbx.pas for example
|
||||||
|
of a workaround approach that currently doesn't work.)
|
||||||
|
<LI>Can't tab out of control on Windows.
|
||||||
|
</UL>
|
||||||
|
<LI>TOvcTable
|
||||||
|
<UL>
|
||||||
|
<LI>Custom cursors not visible when sizing and moving columns and rows.
|
||||||
|
Determine whether this is an LCL limitation.
|
||||||
|
<LI>Sizing and moving columns and rows doesn't work at all with GTK.
|
||||||
|
Determine whether this is a GTK limitation.
|
||||||
|
<LI>Table scroll bar "thumb" extends entire length of scrollbar with GTK
|
||||||
|
(same problem with TScrollBar on GTK). Determine if this is a GTK limitation.
|
||||||
|
<LI>Figure out how to move edit cell to stay with its row when scrolling
|
||||||
|
table (GTK only).
|
||||||
|
</UL>
|
||||||
|
<LI>TOvcTCComboBox
|
||||||
|
<UL>
|
||||||
|
<LI>Figure out why, on Windows, won't drop down without presence of
|
||||||
|
XP manifest.
|
||||||
|
</UL>
|
||||||
|
<LI>TO32TCFlexEdit
|
||||||
|
<UL>
|
||||||
|
<LI>Need a way of setting OnValidationError handler (an apparent
|
||||||
|
omission since TO32FlexEdit has it).
|
||||||
|
</UL>
|
||||||
|
<LI>TOvcController
|
||||||
|
<UL>
|
||||||
|
<LI>Rewrite ovccmdp0.pas property editor to use TTabControl instead of
|
||||||
|
TTabSet (not part of LCL).
|
||||||
|
</UL>
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Other_Resources"></A><H3>Other Resources</H3>
|
||||||
|
|
||||||
|
Qt widgetset status:<P>
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/Qt_Interface">http://wiki.lazarus.freepascal.org/Qt_Interface</A><P>
|
||||||
|
|
||||||
|
Carbon widgetset status:<P>
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/Carbon_Interface">http://wiki.lazarus.freepascal.org/Carbon_Interface</A><P>
|
||||||
|
|
||||||
|
OS X tips for Lazarus:<P>
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips">http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips</A><P>
|
||||||
|
|
||||||
|
<P>
|
||||||
|
<HR>
|
||||||
|
Last updated: Jan. 07, 2007
|
||||||
|
<P>
|
||||||
|
|
||||||
|
</BODY>
|
||||||
|
|
||||||
|
</HTML>
|
||||||
5
components/orpheus/README.txt
Normal file
5
components/orpheus/README.txt
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
|
||||||
|
This is the Lazarus port of a subset of Orpheus controls.
|
||||||
|
|
||||||
|
See OrphStatus.html for more information.
|
||||||
|
|
||||||
BIN
components/orpheus/TO32FLEXEDIT.bmp
Normal file
BIN
components/orpheus/TO32FLEXEDIT.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TO32TCFLEXEDIT.bmp
Normal file
BIN
components/orpheus/TO32TCFLEXEDIT.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCCONTROLLER.bmp
Normal file
BIN
components/orpheus/TOVCCONTROLLER.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCLABEL.bmp
Normal file
BIN
components/orpheus/TOVCLABEL.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCROTATEDLABEL.bmp
Normal file
BIN
components/orpheus/TOVCROTATEDLABEL.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCSIMPLEFIELD.bmp
Normal file
BIN
components/orpheus/TOVCSIMPLEFIELD.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCSPINNER.bmp
Normal file
BIN
components/orpheus/TOVCSPINNER.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTABLE.bmp
Normal file
BIN
components/orpheus/TOVCTABLE.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCBITMAP.bmp
Normal file
BIN
components/orpheus/TOVCTCBITMAP.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCCHECKBOX.bmp
Normal file
BIN
components/orpheus/TOVCTCCHECKBOX.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCCOLHEAD.bmp
Normal file
BIN
components/orpheus/TOVCTCCOLHEAD.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCCOMBOBOX.bmp
Normal file
BIN
components/orpheus/TOVCTCCOMBOBOX.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCGLYPH.bmp
Normal file
BIN
components/orpheus/TOVCTCGLYPH.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCICON.bmp
Normal file
BIN
components/orpheus/TOVCTCICON.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCMEMO.bmp
Normal file
BIN
components/orpheus/TOVCTCMEMO.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCROWHEAD.bmp
Normal file
BIN
components/orpheus/TOVCTCROWHEAD.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCSIMPLEFIELD.bmp
Normal file
BIN
components/orpheus/TOVCTCSIMPLEFIELD.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCTCSTRING.bmp
Normal file
BIN
components/orpheus/TOVCTCSTRING.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCURL.bmp
Normal file
BIN
components/orpheus/TOVCURL.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/orpheus/TOVCVIRTUALLISTBOX.bmp
Normal file
BIN
components/orpheus/TOVCVIRTUALLISTBOX.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
36
components/orpheus/mymin.pas
Normal file
36
components/orpheus/mymin.pas
Normal file
@ -0,0 +1,36 @@
|
|||||||
|
unit MyMin;
|
||||||
|
|
||||||
|
{Minimum uses to compile all ported runtime and property
|
||||||
|
editor (design) units.
|
||||||
|
|
||||||
|
Note: Doesn't compile orpheus.pas.}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ovctcsim,
|
||||||
|
ovctcedt,
|
||||||
|
ovctccbx,
|
||||||
|
ovctcbox,
|
||||||
|
ovctcico,
|
||||||
|
ovctable,
|
||||||
|
o32tcflx,
|
||||||
|
o32vpool,
|
||||||
|
ovcrlbl,
|
||||||
|
ovcurl,
|
||||||
|
ovclabel,
|
||||||
|
ovcsc,
|
||||||
|
ovcvlb,
|
||||||
|
ovcclrcb
|
||||||
|
{$IFDEF FPC}, {These already installed in Delphi}
|
||||||
|
ovcabot0,
|
||||||
|
ovclbl0,
|
||||||
|
ovclbl1,
|
||||||
|
myovctbpe1,
|
||||||
|
myovctbpe2,
|
||||||
|
myovcreg
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
917
components/orpheus/mymisc.pas
Normal file
917
components/orpheus/mymisc.pas
Normal file
@ -0,0 +1,917 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* mymisc.pas *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is Orpheus for Lazarus Additional Units. *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is Phil Hess. *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by Phil Hess are Copyright (C) 2006 Phil Hess. *}
|
||||||
|
{* All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
unit MyMisc;
|
||||||
|
|
||||||
|
{
|
||||||
|
This unit provides types, constants, and functions that fill
|
||||||
|
in some gaps in the Lazarus LCL for compiling the ported
|
||||||
|
Orpheus controls.
|
||||||
|
|
||||||
|
Declarations that have been commented out in the interface
|
||||||
|
section are no longer needed. It is expected that over time
|
||||||
|
more of these can be eliminated as the LCL evolves.
|
||||||
|
|
||||||
|
Several of these functions are only used by Orpheus units
|
||||||
|
that have not yet been ported to Lazarus. For now, these
|
||||||
|
functions are just stubs on non-Windows platforms, as
|
||||||
|
indicated in the function comments.
|
||||||
|
}
|
||||||
|
|
||||||
|
{$I ovc.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF MSWINDOWS} Windows, {$ELSE} Types, {$ENDIF}
|
||||||
|
LclIntf, LMessages, LclType,
|
||||||
|
{$IFDEF LINUX} FileUtil, {$ENDIF}
|
||||||
|
GraphType, Graphics, Controls, SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
|
||||||
|
|
||||||
|
TWMMouse = TLMMouse;
|
||||||
|
TWMKeyDown = TLMKeyDown;
|
||||||
|
TWMNCHitTest = TLMNCHitTest;
|
||||||
|
TWMSetText = TLMSetText;
|
||||||
|
TCMDesignHitTest = TWMMouse;
|
||||||
|
TWMChar = TLMChar;
|
||||||
|
TWMClear = TLMNoParams;
|
||||||
|
TWMCopy = TLMNoParams;
|
||||||
|
TWMCut = TLMNoParams;
|
||||||
|
TWMLButtonDblClk = TLMLButtonDblClk;
|
||||||
|
TWMLButtonDown = TLMLButtonDown;
|
||||||
|
TWMLButtonUp = TLMLButtonUp;
|
||||||
|
TWMRButtonDown = TLMRButtonDown;
|
||||||
|
TWMSysKeyDown = TLMSysKeyDown;
|
||||||
|
TWMMouseActivate = packed record
|
||||||
|
Msg: Cardinal;
|
||||||
|
TopLevel: HWND;
|
||||||
|
HitTestCode: Word;
|
||||||
|
MouseMsg: Word;
|
||||||
|
Result: Longint;
|
||||||
|
end;
|
||||||
|
TWMMouseMove = TLMMouseMove;
|
||||||
|
TWMPaste = TLMNoParams;
|
||||||
|
TMessage = TLMessage;
|
||||||
|
TWMEraseBkgnd = TLMEraseBkgnd;
|
||||||
|
TWMGetText = TLMGetText;
|
||||||
|
TWMGetTextLength = TLMGetTextLength;
|
||||||
|
TWMKillFocus = TLMKillFocus;
|
||||||
|
TWMSetCursor = packed record
|
||||||
|
Msg: Cardinal;
|
||||||
|
CursorWnd: HWND;
|
||||||
|
HitTest: Word;
|
||||||
|
MouseMsg: Word;
|
||||||
|
Result: Longint;
|
||||||
|
end;
|
||||||
|
TWMSetFocus = TLMSetFocus;
|
||||||
|
TWMGetDlgCode = TLMNoParams;
|
||||||
|
TWMSize = TLMSize;
|
||||||
|
TWMSetFont = packed record
|
||||||
|
Msg: Cardinal;
|
||||||
|
Font: HFONT;
|
||||||
|
Redraw: WordBool;
|
||||||
|
Unused: Word;
|
||||||
|
Result: Longint;
|
||||||
|
end;
|
||||||
|
TWMCommand = TLMCommand;
|
||||||
|
TWMDrawItem = TLMDrawItems;
|
||||||
|
LPDWORD = PDWORD;
|
||||||
|
TFNWndEnumProc = TFarProc;
|
||||||
|
TNonClientMetrics = packed record
|
||||||
|
cbSize: UINT;
|
||||||
|
iBorderWidth: Integer;
|
||||||
|
iScrollWidth: Integer;
|
||||||
|
iScrollHeight: Integer;
|
||||||
|
iCaptionWidth: Integer;
|
||||||
|
iCaptionHeight: Integer;
|
||||||
|
lfCaptionFont: TLogFontA;
|
||||||
|
iSmCaptionWidth: Integer;
|
||||||
|
iSmCaptionHeight: Integer;
|
||||||
|
lfSmCaptionFont: TLogFontA;
|
||||||
|
iMenuWidth: Integer;
|
||||||
|
iMenuHeight: Integer;
|
||||||
|
lfMenuFont: TLogFontA;
|
||||||
|
lfStatusFont: TLogFontA;
|
||||||
|
lfMessageFont: TLogFontA;
|
||||||
|
end;
|
||||||
|
TWMKey = TLMKey;
|
||||||
|
TWMScroll = TLMScroll;
|
||||||
|
TWMNoParams = TLMNoParams;
|
||||||
|
TWMPaint = TLMPaint;
|
||||||
|
TWMNCPaint = packed record
|
||||||
|
Msg: Cardinal;
|
||||||
|
RGN: HRGN;
|
||||||
|
Unused: Longint;
|
||||||
|
Result: Longint;
|
||||||
|
end;
|
||||||
|
TWMHScroll = TLMHScroll;
|
||||||
|
TWMVScroll = TLMVScroll;
|
||||||
|
|
||||||
|
const
|
||||||
|
WM_WININICHANGE = CM_WININICHANGE;
|
||||||
|
WM_CANCELMODE = LM_CANCELMODE;
|
||||||
|
WM_ERASEBKGND = LM_ERASEBKGND;
|
||||||
|
WM_GETTEXTLENGTH = LM_GETTEXTLENGTH;
|
||||||
|
WM_KEYDOWN = LM_KEYDOWN;
|
||||||
|
WM_KILLFOCUS = LM_KILLFOCUS;
|
||||||
|
WM_LBUTTONDOWN = LM_LBUTTONDOWN;
|
||||||
|
WM_LBUTTONUP = LM_LBUTTONUP;
|
||||||
|
WM_MOUSEMOVE = LM_MOUSEMOVE;
|
||||||
|
WM_NCHITTEST = LM_NCHITTEST;
|
||||||
|
WM_SETCURSOR = LM_SETCURSOR;
|
||||||
|
WM_SETTEXT = $000C;
|
||||||
|
WM_GETTEXT = $000D;
|
||||||
|
WM_SETFOCUS = LM_SETFOCUS;
|
||||||
|
WM_CHAR = LM_CHAR;
|
||||||
|
WM_CLEAR = LM_CLEARSEL;
|
||||||
|
WM_COPY = LM_COPYTOCLIP;
|
||||||
|
WM_CUT = LM_CUTTOCLIP;
|
||||||
|
WM_PASTE = LM_PASTEFROMCLIP;
|
||||||
|
WM_GETDLGCODE = LM_GETDLGCODE;
|
||||||
|
WM_SIZE = LM_SIZE;
|
||||||
|
WM_SETFONT = LM_SETFONT;
|
||||||
|
WM_SYSKEYDOWN = LM_SYSKEYDOWN;
|
||||||
|
WM_RBUTTONUP = LM_RBUTTONUP;
|
||||||
|
WM_MOUSEACTIVATE = $0021;
|
||||||
|
WM_LBUTTONDBLCLK = LM_LBUTTONDBLCLK;
|
||||||
|
WM_SETREDRAW = $000B;
|
||||||
|
WM_NEXTDLGCTL = $0028;
|
||||||
|
WM_MOUSEWHEEL = LM_MOUSEWHEEL;
|
||||||
|
WM_PAINT = LM_PAINT;
|
||||||
|
WM_VSCROLL = LM_VSCROLL;
|
||||||
|
WM_HSCROLL = LM_HSCROLL;
|
||||||
|
WM_NCPAINT = LM_NCPAINT;
|
||||||
|
WM_MEASUREITEM = LM_MEASUREITEM;
|
||||||
|
|
||||||
|
EM_GETMODIFY = $00B8;
|
||||||
|
EM_SETMODIFY = $00B9;
|
||||||
|
EM_GETSEL = $00B0;
|
||||||
|
EM_SETSEL = $00B1;
|
||||||
|
EM_GETLINECOUNT = $00BA;
|
||||||
|
EM_LINELENGTH = $00C1;
|
||||||
|
EM_LINEINDEX = $00BB;
|
||||||
|
EM_GETLINE = $00C4;
|
||||||
|
EM_REPLACESEL = $00C2;
|
||||||
|
|
||||||
|
CS_SAVEBITS = $800;
|
||||||
|
CS_DBLCLKS = 8;
|
||||||
|
SPI_GETWORKAREA = 48;
|
||||||
|
SPI_GETNONCLIENTMETRICS = 41;
|
||||||
|
DLGC_STATIC = $100;
|
||||||
|
GW_HWNDLAST = 1;
|
||||||
|
GW_HWNDNEXT = 2;
|
||||||
|
GW_HWNDPREV = 3;
|
||||||
|
GW_CHILD = 5;
|
||||||
|
DT_EXPANDTABS = $40;
|
||||||
|
DT_END_ELLIPSIS = $8000;
|
||||||
|
DT_MODIFYSTRING = $10000;
|
||||||
|
GHND = 66;
|
||||||
|
TMPF_TRUETYPE = 4;
|
||||||
|
SWP_HIDEWINDOW = $80;
|
||||||
|
SWP_SHOWWINDOW = $40;
|
||||||
|
RDW_INVALIDATE = 1;
|
||||||
|
RDW_UPDATENOW = $100;
|
||||||
|
RDW_FRAME = $400;
|
||||||
|
LANG_JAPANESE = $11;
|
||||||
|
ES_PASSWORD = $20;
|
||||||
|
ES_LEFT = 0;
|
||||||
|
ES_RIGHT = 2;
|
||||||
|
ES_CENTER = 1;
|
||||||
|
ES_AUTOHSCROLL = $80;
|
||||||
|
ES_MULTILINE = 4;
|
||||||
|
ODS_COMBOBOXEDIT = $1000;
|
||||||
|
CB_FINDSTRING = $014C;
|
||||||
|
CB_SETITEMHEIGHT = $0153;
|
||||||
|
CB_FINDSTRINGEXACT = $0158;
|
||||||
|
CB_SETDROPPEDWIDTH = 352;
|
||||||
|
CBS_DROPDOWN = 2;
|
||||||
|
CBS_DROPDOWNLIST = 3;
|
||||||
|
CBS_OWNERDRAWVARIABLE = $20;
|
||||||
|
CBS_AUTOHSCROLL = $40;
|
||||||
|
CBS_HASSTRINGS = $200;
|
||||||
|
WHEEL_DELTA = 120;
|
||||||
|
LB_GETCARETINDEX = $019F;
|
||||||
|
LB_GETCOUNT = $018B;
|
||||||
|
LB_GETCURSEL = $0188;
|
||||||
|
LB_GETITEMHEIGHT = $01A1;
|
||||||
|
LB_GETITEMRECT = $0198;
|
||||||
|
LB_GETSEL = $0187;
|
||||||
|
LB_GETTOPINDEX = $018E;
|
||||||
|
LB_RESETCONTENT = $0184;
|
||||||
|
LB_SELITEMRANGE = $019B;
|
||||||
|
LB_SETCURSEL = $0186;
|
||||||
|
LB_SETSEL = $0185;
|
||||||
|
LB_SETTABSTOPS = $0192;
|
||||||
|
LB_SETTOPINDEX = $0197;
|
||||||
|
LB_ERR = -1;
|
||||||
|
MA_ACTIVATE = 1;
|
||||||
|
MA_NOACTIVATEANDEAT = 4;
|
||||||
|
|
||||||
|
|
||||||
|
{These belong in LclIntf unit}
|
||||||
|
function IsCharAlpha(c : Char) : Boolean;
|
||||||
|
function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
||||||
|
function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
|
||||||
|
function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
|
||||||
|
lpReturnedString: PChar; nSize: DWORD): DWORD;
|
||||||
|
function GetTickCount : DWORD;
|
||||||
|
//function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
|
||||||
|
// lpTimerFunc: TFNTimerProc): UINT;
|
||||||
|
//function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
|
||||||
|
function GetCaretBlinkTime: UINT;
|
||||||
|
function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
|
||||||
|
//function DestroyCaret: BOOL;
|
||||||
|
function MessageBeep(uType: UINT): BOOL;
|
||||||
|
function SystemParametersInfo(uiAction, uiParam: UINT;
|
||||||
|
pvParam: Pointer; fWinIni: UINT): BOOL;
|
||||||
|
{$IFNDEF MSWINDOWS}
|
||||||
|
function GetSystemMetrics(nIndex: Integer): Integer;
|
||||||
|
{$ENDIF}
|
||||||
|
function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
|
||||||
|
function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
|
||||||
|
X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
|
||||||
|
function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
|
||||||
|
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
|
||||||
|
function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
|
||||||
|
function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
|
||||||
|
function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
|
||||||
|
function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
|
||||||
|
function GetBkColor(hDC: HDC): COLORREF;
|
||||||
|
function GetBkMode(hDC: HDC): Integer;
|
||||||
|
function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
|
||||||
|
function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
|
||||||
|
function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
|
||||||
|
function GetWindowDC(hWnd: HWND): HDC;
|
||||||
|
function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
|
||||||
|
Update: PRect): BOOL;
|
||||||
|
function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
|
||||||
|
function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
|
||||||
|
nCount, nTabPositions: Integer;
|
||||||
|
var lpnTabStopPositions): DWORD;
|
||||||
|
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
|
||||||
|
nCount, nTabPositions: Integer;
|
||||||
|
var lpnTabStopPositions; nTabOrigin: Integer): Longint;
|
||||||
|
//function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
|
||||||
|
function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
|
||||||
|
function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
|
||||||
|
procedure OutputDebugString(lpOutputString: PChar);
|
||||||
|
function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
|
||||||
|
function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
|
||||||
|
function GlobalLock(hMem: HGLOBAL): Pointer;
|
||||||
|
function GlobalUnlock(hMem: HGLOBAL): BOOL;
|
||||||
|
//function DestroyCursor(hCursor: HICON): BOOL;
|
||||||
|
{$IFDEF MSWINDOWS} //Shouldn't be needed with GTK widgetset.
|
||||||
|
function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
|
||||||
|
function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure RecreateWnd(const AWinControl:TWinControl);
|
||||||
|
|
||||||
|
{These belong in Classes unit}
|
||||||
|
//function MakeObjectInstance(Method: TWndMethod): Pointer;
|
||||||
|
//procedure FreeObjectInstance(ObjectInstance: Pointer);
|
||||||
|
//function AllocateHWnd(Method: TWndMethod): HWND;
|
||||||
|
//procedure DeallocateHWnd(Wnd: HWND);
|
||||||
|
|
||||||
|
{This belongs in System unit}
|
||||||
|
function FindClassHInstance(ClassType: TClass): LongWord;
|
||||||
|
|
||||||
|
{This belongs in ExtCtrls unit}
|
||||||
|
procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
|
||||||
|
TopColor, BottomColor: TColor; Width: Integer);
|
||||||
|
|
||||||
|
{This should be a TCanvas method}
|
||||||
|
procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
|
||||||
|
const Source: TRect; Color: TColor);
|
||||||
|
|
||||||
|
{This belongs in Buttons unit}
|
||||||
|
function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
|
||||||
|
BevelWidth: Integer; Style: TButtonStyle;
|
||||||
|
IsRounded, IsDown, IsFocused: Boolean): TRect;
|
||||||
|
|
||||||
|
{Additional routines}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
function GetBrowserPath : string;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{These functions belong in LclIntf unit}
|
||||||
|
|
||||||
|
function IsCharAlpha(c : Char) : Boolean;
|
||||||
|
// Doesn't handle upper-ANSI chars, but then LCL IsCharAlphaNumeric
|
||||||
|
// function doesn't either.
|
||||||
|
begin
|
||||||
|
Result := ((Ord(c) >= 65) and (Ord(c) <= 90)) or
|
||||||
|
((Ord(c) >= 97) and (Ord(c) <= 122));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
||||||
|
// DefWindowProc is a Win API function for handling any window message
|
||||||
|
// that the application doesn't handle.
|
||||||
|
// Can't find equivalent in LCL.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.DefWindowProc(hWnd, Msg, wParam, lParam);
|
||||||
|
{$ELSE}
|
||||||
|
Result := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
|
||||||
|
// Return the integer value for the key name in the lpAppName section
|
||||||
|
// of the WIN.INI file, which on Win32 maps to the corresponding
|
||||||
|
// section of the Windows registry.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetProfileInt(lpAppName, lpKeyName, nDefault);
|
||||||
|
{$ELSE} //Just return default for now.
|
||||||
|
Result := nDefault;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
|
||||||
|
lpReturnedString: PChar; nSize: DWORD): DWORD;
|
||||||
|
// Return the string value for the key name in the lpAppName section
|
||||||
|
// of the WIN.INI file, which on Win32 maps to the corresponding
|
||||||
|
// section of the Windows registry.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetProfileString(lpAppName, lpKeyName, lpDefault,
|
||||||
|
lpReturnedString, nSize);
|
||||||
|
{$ELSE} //Just return default for now.
|
||||||
|
StrLCopy(lpReturnedString, lpDefault, Pred(nSize));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetTickCount : DWORD;
|
||||||
|
{On Windows, this is number of milliseconds since Windows was
|
||||||
|
started. On non-Windows platforms, LCL returns number of
|
||||||
|
milliseconds since Dec. 30, 1899, wrapped by size of DWORD.
|
||||||
|
This value can overflow LongInt variable when checks turned on,
|
||||||
|
so "wrap" value here so it fits within LongInt.
|
||||||
|
Also, since same thing could happen with Windows that has been
|
||||||
|
running for at least approx. 25 days, override it too.}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetTickCount mod High(LongInt);
|
||||||
|
{$ELSE}
|
||||||
|
Result := LclIntf.GetTickCount mod High(LongInt);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
|
||||||
|
lpTimerFunc: TFNTimerProc): UINT;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := {Windows.}SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.KillTimer(hWnd, UIDEvent);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetCaretBlinkTime: UINT;
|
||||||
|
// This function and SetCaretBlinkTime are only used in OvcCaret unit's
|
||||||
|
// TOvcSingleCaret.SetLinked, which is used to write Linked property.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetCaretBlinkTime;
|
||||||
|
{$ELSE}
|
||||||
|
Result := 530; //Default on Win XP, so use as reasonable value
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.SetCaretBlinkTime(uMSeconds);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DestroyCaret: BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.DestroyCaret;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MessageBeep(uType: UINT): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.MessageBeep(uType);
|
||||||
|
{$ELSE}
|
||||||
|
Beep; //Most calls pass 0 as uType (MB_OK), which is system default sound}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SystemParametersInfo(uiAction, uiParam: UINT;
|
||||||
|
pvParam: Pointer; fWinIni: UINT): BOOL;
|
||||||
|
// Only used in:
|
||||||
|
// OvcMisc: PathEllipsis, which is only used in ovcmru (not yet ported).
|
||||||
|
// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
|
||||||
|
// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
|
||||||
|
// OvcEdSld (not yet ported).
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam,
|
||||||
|
fWinIni);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF MSWINDOWS}
|
||||||
|
function GetSystemMetrics(nIndex: Integer): Integer;
|
||||||
|
// SM_CYBORDER, etc. not implemented yet in GTK widgetset.
|
||||||
|
begin
|
||||||
|
if nIndex = SM_SWAPBUTTON then
|
||||||
|
Result := 0 {Not implemented on GTK, so assume buttons not swapped}
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if nIndex = SM_CYBORDER then
|
||||||
|
nIndex := SM_CYEDGE; //Substitute for now so returned value is valid.
|
||||||
|
Result := LclIntf.GetSystemMetrics(nIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
|
||||||
|
// Only used in:
|
||||||
|
// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
|
||||||
|
// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
|
||||||
|
// OvcEdSld (not yet ported).
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.MoveWindow(hWnd, X, Y, nWidth, nHeight, bRepaint);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
|
||||||
|
X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
|
||||||
|
{$ELSE} //Doesn't do much with GTK, but call it anyway.
|
||||||
|
Result := LclIntf.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
|
||||||
|
if (uFlags and SWP_HIDEWINDOW) <> 0 then
|
||||||
|
FindControl(hWnd).Visible := False
|
||||||
|
else if (uFlags and SWP_SHOWWINDOW) <> 0 then
|
||||||
|
FindControl(hWnd).Visible := True;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
|
||||||
|
// Since LCL InvalidateRect redraws window, shouldn't need this function,
|
||||||
|
// so leave it as stub for now.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
// Result := Windows.ValidateRect(hWnd, lpRect);
|
||||||
|
{$ENDIF}
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
|
||||||
|
{InvalidateRect crashes if lpRect is nil with some versions of LCL.}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if Assigned(lpRect) then
|
||||||
|
Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
|
||||||
|
else
|
||||||
|
Result := Windows.InvalidateRect(hWnd, lpRect, bErase);
|
||||||
|
{$ELSE}
|
||||||
|
if Assigned(lpRect) then
|
||||||
|
Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
|
||||||
|
else
|
||||||
|
Result := True;
|
||||||
|
//For now just ignore if nil since no alternative as with Windows.
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
begin
|
||||||
|
Result := Windows.InvalidateRgn(hWnd, hRgn, bErase);
|
||||||
|
{$ELSE}
|
||||||
|
var
|
||||||
|
ARect : TRect;
|
||||||
|
begin
|
||||||
|
GetRgnBox(hRgn, @ARect);
|
||||||
|
Result := InvalidateRect(hWnd, @ARect, bErase);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetRgnBox(RGN, lpRect);
|
||||||
|
{$ELSE}
|
||||||
|
Result := LclIntf.GetRgnBox(RGN, lpRect);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
begin
|
||||||
|
Result := Windows.PtInRegion(RGN, X, Y);
|
||||||
|
{$ELSE}
|
||||||
|
var
|
||||||
|
ARect : TRect;
|
||||||
|
APt : TPoint;
|
||||||
|
begin
|
||||||
|
GetRgnBox(RGN, @ARect);
|
||||||
|
APt.X := X;
|
||||||
|
APt.Y := Y;
|
||||||
|
Result := LclIntf.PtInRect(ARect, APt);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.SetWindowText(hWnd, lpString);
|
||||||
|
{$ELSE}
|
||||||
|
// Use FindControl, then assign to control's Text property?
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBkColor(hDC: HDC): COLORREF;
|
||||||
|
// Only used in:
|
||||||
|
// OvcEF: TOvcBaseEntryField.efPaintPrim.
|
||||||
|
// OvcLkOut (not yet ported).
|
||||||
|
// O32LkOut (not yet ported).
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetBkColor(hDC);
|
||||||
|
{$ELSE} // Since SetBkColor returns previous color, use it to get color.
|
||||||
|
Result := SetBkColor(hDC, 0); //Set background color to black.
|
||||||
|
SetBkColor(hDC, Result); //Restore background color
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBkMode(hDC: HDC): Integer;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetBkMode(hDC);
|
||||||
|
{$ELSE}
|
||||||
|
Result := TRANSPARENT; //For now
|
||||||
|
// Result := SetBkMode(hDC, TRANSPARENT); //Use when widgetsets support it
|
||||||
|
// SetBkMode(hDC, Result);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
begin
|
||||||
|
Result := Windows.GetWindow(hWnd, uCmd);
|
||||||
|
{$ELSE}
|
||||||
|
var
|
||||||
|
AWinControl : TWinControl;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
AWinControl := FindControl(hWnd);
|
||||||
|
if AWinControl <> nil then
|
||||||
|
begin
|
||||||
|
case uCmd of
|
||||||
|
GW_HWNDNEXT :
|
||||||
|
begin
|
||||||
|
// FindNextControl is declared in protected section, so can't use it.
|
||||||
|
// AWinControl := AWinControl.FindNextControl(AWinControl, True, False, False);
|
||||||
|
// if AWinControl <> nil then
|
||||||
|
// Result := AWinControl.Handle;
|
||||||
|
end;
|
||||||
|
GW_CHILD :
|
||||||
|
begin
|
||||||
|
if AWinControl.ControlCount > 0 then
|
||||||
|
Result := TWinControl(AWinControl.Controls[0]).Handle;
|
||||||
|
end;
|
||||||
|
GW_HWNDLAST :
|
||||||
|
begin
|
||||||
|
if AWinControl.Parent <> nil then
|
||||||
|
Result := TWinControl(AWinControl.Parent.Controls[Pred(AWinControl.Parent.ControlCount)]).Handle;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetNextWindow(hWnd, uCmd);
|
||||||
|
{$ELSE}
|
||||||
|
Result := GetWindow(hWnd, uCmd);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.RedrawWindow(hWnd, lprcUpdate, hrgnUpdate, flags);
|
||||||
|
{$ELSE}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetWindowDC(hWnd: HWND): HDC;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetWindowDC(hWnd);
|
||||||
|
{$ELSE}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
|
||||||
|
Update: PRect): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.ScrollDC(DC, DX, DY, Scroll, Clip, Rgn, Update);
|
||||||
|
{$ELSE}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
begin
|
||||||
|
Result := Windows.SetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw);
|
||||||
|
end;
|
||||||
|
{$ELSE} //GTK needs more information, so use SetScrollInfo
|
||||||
|
var
|
||||||
|
ScrInfo : TScrollInfo;
|
||||||
|
begin
|
||||||
|
ScrInfo.fMask := SIF_RANGE or SIF_UPDATEPOLICY;
|
||||||
|
ScrInfo.nTrackPos := SB_POLICY_CONTINUOUS;
|
||||||
|
ScrInfo.nMin := nMinPos;
|
||||||
|
ScrInfo.nMax := nMaxPos;
|
||||||
|
LclIntf.SetScrollInfo(hWnd, nBar, ScrInfo, True);
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
|
||||||
|
nCount, nTabPositions: Integer;
|
||||||
|
var lpnTabStopPositions): DWORD;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions,
|
||||||
|
lpnTabStopPositions);
|
||||||
|
{$ELSE}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
|
||||||
|
nCount, nTabPositions: Integer;
|
||||||
|
var lpnTabStopPositions; nTabOrigin: Integer): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions,
|
||||||
|
lpnTabStopPositions, nTabOrigin);
|
||||||
|
{$ELSE}
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.LoadBitmap(hInstance, lpBitmapName);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.LoadCursor(hInstance, lpCursorName);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
|
||||||
|
// Only used in OvcMisc IsForegroundTask function, which is only
|
||||||
|
// used in OvcSpeed (not yet ported).
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.EnumThreadWindows(dwThreadId, lpfn, lParam);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OutputDebugString(lpOutputString: PChar);
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Windows.OutputDebugString(lpOutputString);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
|
||||||
|
// Only used in OvcMisc CopyParentImage procedure, which is only
|
||||||
|
// used by TOvcCustomSpeedButton.Paint in OvcSpeed (not yet ported).
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.SetViewportOrgEx(DC, X, Y, Point);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
|
||||||
|
// GlobalAlloc, GlobalLock, and GlobalUnlock are only used in:
|
||||||
|
// OvcEF: TOvcBaseEntryField.efCopyPrim and TOvcBaseEntryField.WMPaste.
|
||||||
|
// OvcEdit (not yet ported).
|
||||||
|
// OvcViewr (not yet ported).
|
||||||
|
// Replace code in those units with calls to standard Clipboard methods?
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GlobalAlloc(uFlags, dwBytes);
|
||||||
|
{$ELSE}
|
||||||
|
Result := THandle(GetMem(dwBytes));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GlobalLock(hMem: HGLOBAL): Pointer;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GlobalLock(hMem);
|
||||||
|
{$ELSE}
|
||||||
|
Result := PAnsiChar(hMem);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GlobalUnlock(hMem: HGLOBAL): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.GlobalUnlock(hMem);
|
||||||
|
{$ELSE}
|
||||||
|
FreeMem(Pointer(hMem));
|
||||||
|
Result := True;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DestroyCursor(hCursor: HICON): BOOL;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := Windows.DestroyCursor(hCursor);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
|
||||||
|
{Use control's Perform method to force it to respond to message}
|
||||||
|
var
|
||||||
|
AWinControl : TWinControl;
|
||||||
|
begin
|
||||||
|
// Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam); {Doesn't work}
|
||||||
|
Assert(hWnd <> 0, 'Window handle not assigned on entry to PostMessage');
|
||||||
|
AWinControl := FindOwnerControl(hWnd);
|
||||||
|
// Assert(AWinControl <> nil,
|
||||||
|
// 'Owner control not found in PostMessage ($' + IntToHex(Msg, 4) + ') ');
|
||||||
|
if AWinControl <> nil then
|
||||||
|
AWinControl.Perform(Msg, wParam, lParam);
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
||||||
|
{Use control's Perform method to force it to respond to message}
|
||||||
|
var
|
||||||
|
AWinControl : TWinControl;
|
||||||
|
begin
|
||||||
|
// Result := LclIntf.SendMessage(hWnd, Msg, wParam, lParam); {Doesn't work}
|
||||||
|
Assert(hWnd <> 0, 'Window handle not assigned on entry to SendMessage');
|
||||||
|
AWinControl := FindOwnerControl(hWnd);
|
||||||
|
// Assert(AWinControl <> nil,
|
||||||
|
// 'Owner control not found in SendMessage ($' + IntToHex(Msg, 4) + ') ');
|
||||||
|
if AWinControl <> nil then
|
||||||
|
Result := AWinControl.Perform(Msg, wParam, lParam);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RecreateWnd(const AWinControl:TWinControl);
|
||||||
|
// Calls to Controls.RecreateWnd shouldn't be needed with GTK widgetset,
|
||||||
|
// so just ignore them.
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Controls.RecreateWnd(AWinControl);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{These belong in Classes unit}
|
||||||
|
function MakeObjectInstance(Method: TWndMethod): Pointer;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FreeObjectInstance(ObjectInstance: Pointer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function AllocateHWnd(Method: TWndMethod): HWND;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DeallocateHWnd(Wnd: HWND);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{This belongs in System unit}
|
||||||
|
function FindClassHInstance(ClassType: TClass): LongWord;
|
||||||
|
begin
|
||||||
|
(*
|
||||||
|
Result := System.MainInstance;
|
||||||
|
*)
|
||||||
|
Result := System.HInstance;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{This belongs in ExtCtrls unit}
|
||||||
|
procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
|
||||||
|
TopColor, BottomColor: TColor; Width: Integer);
|
||||||
|
begin
|
||||||
|
Canvas.Frame3D(Rect, Width, bvLowered);
|
||||||
|
{Need a way of determining whether to pass bvNone, bvLowered,
|
||||||
|
bvRaised, or bvSpace based on TopColor and BottomColor.
|
||||||
|
See Delphi help for Frame3D.}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{This should be a TCanvas method}
|
||||||
|
procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
|
||||||
|
const Source: TRect; Color: TColor);
|
||||||
|
begin
|
||||||
|
StretchBlt(DestCanvas.Handle, Dest.Left, Dest.Top,
|
||||||
|
Dest.Right - Dest.Left, Dest.Bottom - Dest.Top,
|
||||||
|
Bitmap.Canvas.Handle, Source.Left, Source.Top,
|
||||||
|
Source.Right - Source.Left, Source.Bottom - Source.Top, SrcCopy);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{This belongs in Buttons unit}
|
||||||
|
function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
|
||||||
|
BevelWidth: Integer; Style: TButtonStyle;
|
||||||
|
IsRounded, IsDown, IsFocused: Boolean): TRect;
|
||||||
|
{Draw a push button.
|
||||||
|
Style, IsRounded and IsFocused params appear to be left over
|
||||||
|
from Win 3.1, so ignore them.}
|
||||||
|
var
|
||||||
|
ARect : TRect;
|
||||||
|
begin
|
||||||
|
ARect := Client;
|
||||||
|
{The way LCL TCustomSpeedButton draws a button}
|
||||||
|
if IsDown then
|
||||||
|
Canvas.Frame3D(ARect, BevelWidth, bvLowered)
|
||||||
|
else
|
||||||
|
Canvas.Frame3D(ARect, BevelWidth, bvRaised);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{Additional routines}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
function SearchForBrowser(const BrowserFileName : string) : string;
|
||||||
|
{Search path for specified browser file name, returning
|
||||||
|
its expanded file name that includes path to it.}
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'),
|
||||||
|
PathSeparator, [sffDontSearchInBasePath]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBrowserPath : string;
|
||||||
|
{Return path to first browser found.}
|
||||||
|
begin
|
||||||
|
Result := SearchForBrowser('firefox');
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('konqueror'); {KDE browser}
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('epiphany'); {GNOME browser}
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('mozilla');
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('opera');
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
234
components/orpheus/myovcreg.pas
Normal file
234
components/orpheus/myovcreg.pas
Normal file
@ -0,0 +1,234 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* myovcreg.pas *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* Phil Hess - adapted ovcreg.pas to register only ported controls. *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
unit MyOvcReg;
|
||||||
|
|
||||||
|
{
|
||||||
|
Registration unit for the ported Orpheus components.
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
Forms,
|
||||||
|
LResources,
|
||||||
|
PropEdits,
|
||||||
|
ComponentEditors,
|
||||||
|
ovcabot0, {Property editors}
|
||||||
|
ovclbl0,
|
||||||
|
myovctbpe1,
|
||||||
|
myovctbpe2,
|
||||||
|
ovcbase, {Controls}
|
||||||
|
ovctcedt,
|
||||||
|
ovctchdr,
|
||||||
|
ovctccbx,
|
||||||
|
ovctcsim,
|
||||||
|
ovctcbox,
|
||||||
|
ovctcbmp,
|
||||||
|
ovctcgly,
|
||||||
|
ovctcico,
|
||||||
|
ovctbcls,
|
||||||
|
ovctbrws,
|
||||||
|
ovctable,
|
||||||
|
ovcurl,
|
||||||
|
ovcrlbl,
|
||||||
|
ovclabel,
|
||||||
|
ovcsf,
|
||||||
|
o32flxed,
|
||||||
|
o32tcflx,
|
||||||
|
// ovccalc,
|
||||||
|
// ovcclrcb,
|
||||||
|
ovcsc,
|
||||||
|
ovcvlb;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcHeaderProperty = class(TCaptionProperty);
|
||||||
|
|
||||||
|
{component editor for the table}
|
||||||
|
TOvcTableEditor = class(TDefaultComponentEditor)
|
||||||
|
public
|
||||||
|
procedure ExecuteVerb(Index : Integer);
|
||||||
|
override;
|
||||||
|
function GetVerb(Index : Integer) : AnsiString;
|
||||||
|
override;
|
||||||
|
function GetVerbCount : Integer;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** TOvcTableEditor ***}
|
||||||
|
|
||||||
|
const
|
||||||
|
TableVerbs : array[0..1] of PAnsiChar =
|
||||||
|
('Columns Editor', 'Rows Editor');
|
||||||
|
|
||||||
|
procedure TOvcTableEditor.ExecuteVerb(Index : Integer);
|
||||||
|
var
|
||||||
|
Table : TOvcTable;
|
||||||
|
C : TOvcfrmColEditor;
|
||||||
|
R : TOvcfrmRowEditor;
|
||||||
|
begin
|
||||||
|
Table := TOvcTable(Component);
|
||||||
|
if Index = 0 then begin
|
||||||
|
C := TOvcfrmColEditor.Create(Application);
|
||||||
|
try
|
||||||
|
C.Editor := Self;
|
||||||
|
C.SetCols(TOvcTableColumns(Table.Columns));
|
||||||
|
C.ShowModal;
|
||||||
|
Designer.Modified;
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end else if Index = 1 then begin
|
||||||
|
R := TOvcfrmRowEditor.Create(Application);
|
||||||
|
try
|
||||||
|
R.SetRows(TOvcTableRows(Table.Rows));
|
||||||
|
R.ShowModal;
|
||||||
|
Designer.Modified;
|
||||||
|
finally
|
||||||
|
R.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcTableEditor.GetVerb(Index : Integer) : AnsiString;
|
||||||
|
begin
|
||||||
|
Result := StrPas(TableVerbs[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcTableEditor.GetVerbCount : Integer;
|
||||||
|
begin
|
||||||
|
Result := High(TableVerbs) + 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'Caption', TOvcHeaderProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'URL', TOvcHeaderProperty);
|
||||||
|
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcRotatedLabel, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcLabel, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcSpinner, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcVirtualListBox, 'About', TOvcAboutProperty);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcSimpleField, 'About', TOvcAboutProperty);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TO32FlexEdit, 'About', TOvcAboutProperty);
|
||||||
|
// RegisterPropertyEditor(TypeInfo(string), TOvcCalculator, 'About', TOvcAboutProperty);
|
||||||
|
// RegisterPropertyEditor(TypeInfo(string), TOvcColorComboBox, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTable, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCColHead, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCRowHead, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCString, 'About', TOvcAboutProperty);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCSimpleField, 'About', TOvcAboutProperty);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCMemo, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCCheckBox, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCComboBox, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCBitMap, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCGlyph, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcTCIcon, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TO32TCFlexEdit, 'About', TOvcAboutProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TOvcController, 'About', TOvcAboutProperty);
|
||||||
|
|
||||||
|
{register label component editor}
|
||||||
|
RegisterComponentEditor(TOvcCustomLabel, TOvcLabelEditor);
|
||||||
|
|
||||||
|
{register property editors for the entry fields}
|
||||||
|
(*
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(Char), TOvcSimpleField, 'PictureMask', TSimpleMaskProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcPictureField, 'PictureMask', TPictureMaskProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcNumericField, 'PictureMask', TNumericMaskProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcSimpleField, 'RangeHi', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcSimpleField, 'RangeLo', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcPictureField, 'RangeHi', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcPictureField, 'RangeLo', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcNumericField, 'RangeHi', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcNumericField, 'RangeLo', OvcEfPe.TEfRangeProperty);
|
||||||
|
RegisterPropertyEditor(
|
||||||
|
TypeInfo(string), TOvcPictureLabel, 'PictureMask', TPictureMaskProperty);
|
||||||
|
*)
|
||||||
|
|
||||||
|
RegisterPropertyEditor(TypeInfo(TOvcTableRows), TOvcTable, '', TOvcTableRowProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(TOvcTableColumns), TOvcTable, '', TOvcTableColumnProperty);
|
||||||
|
|
||||||
|
{register component editor for the table}
|
||||||
|
RegisterComponentEditor(TOvcTable, TOvcTableEditor);
|
||||||
|
|
||||||
|
RegisterComponents('Orpheus', [TOvcRotatedLabel]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcLabel]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcURL]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcSpinner]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcVirtualListBox]);
|
||||||
|
{$IFDEF MSWINDOWS} //If used, crashes IDE with GTK, so only register if Windows
|
||||||
|
RegisterComponents('Orpheus', [TOvcSimpleField]);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterComponents('Orpheus', [TO32FlexEdit]);
|
||||||
|
// RegisterComponents('Orpheus', [TOvcCalculator]);
|
||||||
|
// RegisterComponents('Orpheus', [TOvcColorComboBox]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTable]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCColHead]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCRowHead]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCString]);
|
||||||
|
{$IFDEF MSWINDOWS} //If used, crashes IDE with GTK, so only register if Windows
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCSimpleField]);
|
||||||
|
{$ENDIF}
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCMemo]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCCheckBox]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCComboBox]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCBitMap]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCGlyph]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcTCIcon]);
|
||||||
|
RegisterComponents('Orpheus', [TO32TCFlexEdit]);
|
||||||
|
RegisterComponents('Orpheus', [TOvcController]);
|
||||||
|
end; {Register}
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I ovcreg.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
342
components/orpheus/myovctbpe1.lfm
Normal file
342
components/orpheus/myovctbpe1.lfm
Normal file
@ -0,0 +1,342 @@
|
|||||||
|
object OvcfrmRowEditor: TOvcfrmRowEditor
|
||||||
|
Left = 387
|
||||||
|
Top = 266
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Rows Editor'
|
||||||
|
ClientHeight = 280
|
||||||
|
Height = 280
|
||||||
|
ClientWidth = 401
|
||||||
|
Width = 401
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Style = []
|
||||||
|
Position = poScreenCenter
|
||||||
|
OnShow = FormShow
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object DoneButton: TBitBtn
|
||||||
|
Left = 307
|
||||||
|
Top = 248
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Done'
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 5
|
||||||
|
OnClick = DoneButtonClick
|
||||||
|
NumGlyphs = 2
|
||||||
|
end
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Width = 401
|
||||||
|
Height = 41
|
||||||
|
Align = alTop
|
||||||
|
Alignment = taLeftJustify
|
||||||
|
BevelInner = bvLowered
|
||||||
|
TabOrder = 0
|
||||||
|
object SpeedButton1: TSpeedButton
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Previous row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB0000
|
||||||
|
BBBBBBBBBBBB777BBBBBBBBBBBB00CC0BBBBBBBBBBB7777BBBBBBBBBBB00CCC0
|
||||||
|
BBBBBBBBBB77777BBBBBBBBBB00CCCC0BBBBBBBBB777777BBBBBBBBB00CCCCC0
|
||||||
|
BBBBBBBB7777777BBBBBBBBF0CCCCCC0BBBBBBB77777777BBBBBBBBF0CCCCCC0
|
||||||
|
BBBBBBB77777777BBBBBBBBBFCCCCCC0BBBBBBBB7777777BBBBBBBBBBFCCCCC0
|
||||||
|
BBBBBBBBB777777BBBBBBBBBBBFCCCC0BBBBBBBBBB77777BBBBBBBBBBBBFCCC0
|
||||||
|
BBBBBBBBBBB7777BBBBBBBBBBBBBFFFFBBBBBBBBBBBB777BBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton1Click
|
||||||
|
end
|
||||||
|
object SpeedButton2: TSpeedButton
|
||||||
|
Left = 32
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Next row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBB
|
||||||
|
BBBBBBBFFFFBBBBBBBBBBBBF0000BBBBBBBBBBBFFFFFBBBBBBBBBBBFCCC00BBB
|
||||||
|
BBBBBBBFFFFFFBBBBBBBBBBFCCCC00BBBBBBBBBFFFFFFFBBBBBBBBBFCCCCC00B
|
||||||
|
BBBBBBBFFFFFFFFBBBBBBBBFCCCCCC00BBBBBBBFFFFFFFFFBBBBBBBFCCCCCC0F
|
||||||
|
BBBBBBBFFFFFFFFFBBBBBBBFCCCCCCFBBBBBBBBFFFFFFFFBBBBBBBBFCCCCCFBB
|
||||||
|
BBBBBBBFFFFFFFBBBBBBBBBFCCCCFBBBBBBBBBBFFFFFFBBBBBBBBBBFCCCFBBBB
|
||||||
|
BBBBBBBFFFFFBBBBBBBBBBBFFFFBBBBBBBBBBBBFFFFBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton2Click
|
||||||
|
end
|
||||||
|
object SpeedButton3: TSpeedButton
|
||||||
|
Left = 72
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'First row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB00
|
||||||
|
BBBBBBFFBBBBBBFFBBBBBB00BBBBB000BBBBBBFFBBBBBFFFBBBBBB00BBBB00C0
|
||||||
|
BBBBBBFFBBBBFFFFBBBBBB00BBB00CC0BBBBBBFFBBBFFFFFBBBBBB00BB00CCC0
|
||||||
|
BBBBBBFFBBFFFFFFBBBBBB00B00CCCC0BBBBBBFFBFFFFFFFBBBBBB00BFCCCCC0
|
||||||
|
BBBBBBFFBFFFFFFFBBBBBB00BBFCCCC0BBBBBBFFBBFFFFFFBBBBBB00BBBFCCC0
|
||||||
|
BBBBBBFFBBBFFFFFBBBBBB00BBBBFCC0BBBBBBFFBBBBFFFFBBBBBB00BBBBBFC0
|
||||||
|
BBBBBBFFBBBBBFFFBBBBBB00BBBBBBFFBBBBBBFFBBBBBBFFBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton3Click
|
||||||
|
end
|
||||||
|
object SpeedButton4: TSpeedButton
|
||||||
|
Left = 96
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Last row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB
|
||||||
|
00BBBBBB77BBBBBB77BBBBBB000BBBBB00BBBBBB777BBBBB77BBBBBB0C00BBBB
|
||||||
|
00BBBBBB7777BBBB77BBBBBB0CC00BBB00BBBBBB77777BBB77BBBBBB0CCC00BB
|
||||||
|
00BBBBBB777777BB77BBBBBB0CCCC00B00BBBBBB7777777B77BBBBBB0CCCCCFB
|
||||||
|
00BBBBBB7777777B77BBBBBB0CCCCFBB00BBBBBB777777BB77BBBBBB0CCCFBBB
|
||||||
|
00BBBBBB77777BBB77BBBBBB0CCFBBBB00BBBBBB7777BBBB77BBBBBB0CFBBBBB
|
||||||
|
00BBBBBB777BBBBB77BBBBBBFFBBBBBB00BBBBBB77BBBBBB77BBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton4Click
|
||||||
|
end
|
||||||
|
object SpeedButton5: TSpeedButton
|
||||||
|
Left = 136
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Insert row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBBBBBBBBBF777BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBB000000CC000
|
||||||
|
000BB777777BB777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
|
||||||
|
CC0BBFBBBBBBBBBBBB7BBFFFFFFCC0FFFFFBBFFFFFFBB7FFFFFBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFFF0BB
|
||||||
|
BBBBBBBBBBFFF7BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton5Click
|
||||||
|
end
|
||||||
|
object SpeedButton6: TSpeedButton
|
||||||
|
Left = 160
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Delete Row'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00000000000
|
||||||
|
000BB77777777777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
|
||||||
|
CC0BBFBBBBBBBBBBBB7BBFFFFFFFFFFFFFFBBFFFFFFFFFFFFFFBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton6Click
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 208
|
||||||
|
Top = 13
|
||||||
|
Width = 89
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = '&Row number'
|
||||||
|
end
|
||||||
|
object OvcSpinner1: TOvcSpinner
|
||||||
|
Left = 369
|
||||||
|
Top = 12
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlRowNumber
|
||||||
|
end
|
||||||
|
object ctlRowNumber: TEdit
|
||||||
|
Left = 296
|
||||||
|
Top = 12
|
||||||
|
Width = 73
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 8
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = ctlRowNumberChange
|
||||||
|
OnExit = ctlRowNumberExit
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Top = 48
|
||||||
|
Width = 273
|
||||||
|
Height = 113
|
||||||
|
Caption = 'Selected row details'
|
||||||
|
TabOrder = 1
|
||||||
|
object ctlHidden: TCheckBox
|
||||||
|
Left = 16
|
||||||
|
Top = 8
|
||||||
|
Width = 89
|
||||||
|
Height = 17
|
||||||
|
Caption = 'Hidde&n'
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object ctlUseDefHeight: TRadioButton
|
||||||
|
Left = 16
|
||||||
|
Top = 40
|
||||||
|
Width = 145
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Use &default height'
|
||||||
|
TabOrder = 1
|
||||||
|
TabStop = True
|
||||||
|
OnClick = ctlUseDefHeightClick
|
||||||
|
end
|
||||||
|
object ctlUseCustHeight: TRadioButton
|
||||||
|
Left = 16
|
||||||
|
Top = 64
|
||||||
|
Width = 145
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Use &custom height'
|
||||||
|
TabOrder = 2
|
||||||
|
OnClick = ctlUseCustHeightClick
|
||||||
|
end
|
||||||
|
object OvcSpinner2: TOvcSpinner
|
||||||
|
Left = 217
|
||||||
|
Top = 67
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlHeight
|
||||||
|
end
|
||||||
|
object ctlHeight: TEdit
|
||||||
|
Left = 168
|
||||||
|
Top = 68
|
||||||
|
Width = 49
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 5
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox2: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Top = 168
|
||||||
|
Width = 273
|
||||||
|
Height = 105
|
||||||
|
Caption = 'Overall row details'
|
||||||
|
TabOrder = 2
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 16
|
||||||
|
Top = 17
|
||||||
|
Width = 121
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'De&fault row height'
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 16
|
||||||
|
Top = 53
|
||||||
|
Width = 121
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Ma&ximum rows'
|
||||||
|
end
|
||||||
|
object OvcSpinner3: TOvcSpinner
|
||||||
|
Left = 193
|
||||||
|
Top = 17
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlDefaultHeight
|
||||||
|
end
|
||||||
|
object OvcSpinner4: TOvcSpinner
|
||||||
|
Left = 217
|
||||||
|
Top = 53
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlRowLimit
|
||||||
|
end
|
||||||
|
object ctlRowLimit: TEdit
|
||||||
|
Left = 144
|
||||||
|
Top = 52
|
||||||
|
Width = 73
|
||||||
|
Height = 21
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object ctlDefaultHeight: TEdit
|
||||||
|
Left = 144
|
||||||
|
Top = 17
|
||||||
|
Width = 49
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 5
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Reset: TBitBtn
|
||||||
|
Left = 307
|
||||||
|
Top = 88
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Re&set'
|
||||||
|
TabOrder = 4
|
||||||
|
OnClick = ResetClick
|
||||||
|
NumGlyphs = 2
|
||||||
|
end
|
||||||
|
object ApplyButton: TBitBtn
|
||||||
|
Left = 307
|
||||||
|
Top = 56
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = '&Apply'
|
||||||
|
Default = True
|
||||||
|
TabOrder = 3
|
||||||
|
OnClick = ApplyButtonClick
|
||||||
|
NumGlyphs = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
170
components/orpheus/myovctbpe1.lrs
Normal file
170
components/orpheus/myovctbpe1.lrs
Normal file
@ -0,0 +1,170 @@
|
|||||||
|
LazarusResources.Add('TOvcfrmRowEditor','FORMDATA',[
|
||||||
|
'TPF0'#16'TOvcfrmRowEditor'#15'OvcfrmRowEditor'#4'Left'#3#131#1#3'Top'#3#10#1
|
||||||
|
+#11'BorderIcons'#11#12'biSystemMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Capti'
|
||||||
|
+'on'#6#11'Rows Editor'#12'ClientHeight'#3#24#1#6'Height'#3#24#1#11'ClientWid'
|
||||||
|
+'th'#3#145#1#5'Width'#3#145#1#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15
|
||||||
|
+'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
|
||||||
|
+'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#6'OnShow'#7#8'FormShow'#13
|
||||||
|
+'PixelsPerInch'#2'`'#10'TextHeight'#2#13#0#7'TBitBtn'#10'DoneButton'#4'Left'
|
||||||
|
+#3'3'#1#3'Top'#3#248#0#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#4'Done'#11
|
||||||
|
+'ModalResult'#2#1#8'TabOrder'#2#5#7'OnClick'#7#15'DoneButtonClick'#9'NumGlyp'
|
||||||
|
+'hs'#2#2#0#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3#145#1#6'H'
|
||||||
|
+'eight'#2')'#5'Align'#7#5'alTop'#9'Alignment'#7#13'taLeftJustify'#10'BevelIn'
|
||||||
|
+'ner'#7#9'bvLowered'#8'TabOrder'#2#0#0#12'TSpeedButton'#12'SpeedButton1'#4'L'
|
||||||
|
+'eft'#2#8#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#12'Previous row'
|
||||||
|
+#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '
|
||||||
|
+#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0
|
||||||
|
+#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192
|
||||||
|
+#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255
|
||||||
|
+#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#0#0#187#187#187#187#187#187'w{'#187#187#187#187#187#176
|
||||||
|
+#12#192#187#187#187#187#187#183'w{'#187#187#187#187#187#0#204#192#187#187#187
|
||||||
|
+#187#187'ww{'#187#187#187#187#176#12#204#192#187#187#187#187#183'ww{'#187#187
|
||||||
|
+#187#187#0#204#204#192#187#187#187#187'www{'#187#187#187#191#12#204#204#192
|
||||||
|
+#187#187#187#183'www{'#187#187#187#191#12#204#204#192#187#187#187#183'www{'
|
||||||
|
+#187#187#187#187#252#204#204#192#187#187#187#187'www{'#187#187#187#187#191
|
||||||
|
+#204#204#192#187#187#187#187#183'ww{'#187#187#187#187#187#252#204#192#187#187
|
||||||
|
+#187#187#187'ww{'#187#187#187#187#187#191#204#192#187#187#187#187#187#183'w{'
|
||||||
|
+#187#187#187#187#187#187#255#255#187#187#187#187#187#187'w{'#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowH'
|
||||||
|
+'int'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton1Click'#0#0#12'TSpeedButton'
|
||||||
|
+#12'SpeedButton2'#4'Left'#2' '#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hin'
|
||||||
|
+'t'#6#8'Next row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0
|
||||||
|
+#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0
|
||||||
|
+#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0
|
||||||
|
+#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255
|
||||||
|
+#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#191#0#11#187#187#187#187#187#191#255#251#187#187#187
|
||||||
|
+#187#187#191#0#0#187#187#187#187#187#191#255#255#187#187#187#187#187#191#204
|
||||||
|
+#192#11#187#187#187#187#191#255#255#251#187#187#187#187#191#204#204#0#187#187
|
||||||
|
+#187#187#191#255#255#255#187#187#187#187#191#204#204#192#11#187#187#187#191
|
||||||
|
+#255#255#255#251#187#187#187#191#204#204#204#0#187#187#187#191#255#255#255
|
||||||
|
+#255#187#187#187#191#204#204#204#15#187#187#187#191#255#255#255#255#187#187
|
||||||
|
+#187#191#204#204#204#251#187#187#187#191#255#255#255#251#187#187#187#191#204
|
||||||
|
+#204#207#187#187#187#187#191#255#255#255#187#187#187#187#191#204#204#251#187
|
||||||
|
+#187#187#187#191#255#255#251#187#187#187#187#191#204#207#187#187#187#187#187
|
||||||
|
+#191#255#255#187#187#187#187#187#191#255#251#187#187#187#187#187#191#255#251
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGl'
|
||||||
|
+'yphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton2Cl'
|
||||||
|
+'ick'#0#0#12'TSpeedButton'#12'SpeedButton3'#4'Left'#2'H'#3'Top'#2#8#5'Width'
|
||||||
|
+#2#25#6'Height'#2#25#4'Hint'#6#9'First row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0
|
||||||
|
+#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1
|
||||||
|
+#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
|
||||||
|
+#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#0#187#187#187#0#187#187#187
|
||||||
|
+#255#187#187#187#255#187#187#187#0#187#187#176#0#187#187#187#255#187#187#191
|
||||||
|
+#255#187#187#187#0#187#187#0#192#187#187#187#255#187#187#255#255#187#187#187
|
||||||
|
+#0#187#176#12#192#187#187#187#255#187#191#255#255#187#187#187#0#187#0#204#192
|
||||||
|
+#187#187#187#255#187#255#255#255#187#187#187#0#176#12#204#192#187#187#187#255
|
||||||
|
+#191#255#255#255#187#187#187#0#191#204#204#192#187#187#187#255#191#255#255
|
||||||
|
,#255#187#187#187#0#187#252#204#192#187#187#187#255#187#255#255#255#187#187
|
||||||
|
+#187#0#187#191#204#192#187#187#187#255#187#191#255#255#187#187#187#0#187#187
|
||||||
|
+#252#192#187#187#187#255#187#187#255#255#187#187#187#0#187#187#191#192#187
|
||||||
|
+#187#187#255#187#187#191#255#187#187#187#0#187#187#187#255#187#187#187#255
|
||||||
|
+#187#187#187#255#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedBu'
|
||||||
|
+'tton3Click'#0#0#12'TSpeedButton'#12'SpeedButton4'#4'Left'#2'`'#3'Top'#2#8#5
|
||||||
|
+'Width'#2#25#6'Height'#2#25#4'Hint'#6#8'Last row'#10'Glyph.Data'#10'z'#1#0#0
|
||||||
|
+'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0
|
||||||
|
+#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0
|
||||||
|
+#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0
|
||||||
|
+#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#0#187#187#187#0
|
||||||
|
+#187#187#187'w'#187#187#187'w'#187#187#187#0#11#187#187#0#187#187#187'w{'#187
|
||||||
|
+#187'w'#187#187#187#12#0#187#187#0#187#187#187'ww'#187#187'w'#187#187#187#12
|
||||||
|
+#192#11#187#0#187#187#187'ww{'#187'w'#187#187#187#12#204#0#187#0#187#187#187
|
||||||
|
+'www'#187'w'#187#187#187#12#204#192#11#0#187#187#187'www{w'#187#187#187#12
|
||||||
|
+#204#204#251#0#187#187#187'www{w'#187#187#187#12#204#207#187#0#187#187#187'w'
|
||||||
|
+'ww'#187'w'#187#187#187#12#204#251#187#0#187#187#187'ww{'#187'w'#187#187#187
|
||||||
|
+#12#207#187#187#0#187#187#187'ww'#187#187'w'#187#187#187#12#251#187#187#0#187
|
||||||
|
+#187#187'w{'#187#187'w'#187#187#187#255#187#187#187#0#187#187#187'w'#187#187
|
||||||
|
+#187'w'#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'
|
||||||
|
+#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton4Click'#0
|
||||||
|
+#0#12'TSpeedButton'#12'SpeedButton5'#4'Left'#3#136#0#3'Top'#2#8#5'Width'#2#25
|
||||||
|
+#6'Height'#2#25#4'Hint'#6#10'Insert row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0
|
||||||
|
+'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0
|
||||||
|
+#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0
|
||||||
|
+#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#240#0
|
||||||
|
+#187#187#187#187#187#187#247'w'#187#187#187#187#187#187#252#192#187#187#187
|
||||||
|
+#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187
|
||||||
|
+#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187
|
||||||
|
+#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#176
|
||||||
|
+#0#0#12#192#0#0#11#183'ww{'#183'ww{'#191#204#204#204#204#204#204#11#191#187
|
||||||
|
+#187#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187#187#187
|
||||||
|
+#187#187'{'#191#255#255#252#192#255#255#251#191#255#255#251#183#255#255#251
|
||||||
|
+#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187
|
||||||
|
+#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187
|
||||||
|
+#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187
|
||||||
|
+#187#187#251#183#187#187#187#187#187#187#255#240#187#187#187#187#187#187#255
|
||||||
|
+#247#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'Spe'
|
||||||
|
+'edButton5Click'#0#0#12'TSpeedButton'#12'SpeedButton6'#4'Left'#3#160#0#3'Top'
|
||||||
|
+#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#10'Delete Row'#10'Glyph.Data'#10
|
||||||
|
+'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0
|
||||||
|
+#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0
|
||||||
|
+#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128
|
||||||
|
+#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
|
||||||
|
+#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#176#0#0#0#0#0#0#11#183'wwwwww{'#191#204#204#204#204#204#204
|
||||||
|
+#11#191#187#187#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187
|
||||||
|
+#187#187#187#187'{'#191#255#255#255#255#255#255#251#191#255#255#255#255#255
|
||||||
|
+#255#251#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
,#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7
|
||||||
|
+#17'SpeedButton6Click'#0#0#6'TLabel'#6'Label1'#4'Left'#3#208#0#3'Top'#2#13#5
|
||||||
|
+'Width'#2'Y'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#11'&Row number'#0#0#11
|
||||||
|
+'TOvcSpinner'#11'OvcSpinner1'#4'Left'#3'q'#1#3'Top'#2#12#5'Width'#2#16#6'Hei'
|
||||||
|
+'ght'#2#21#10'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedCo'
|
||||||
|
+'ntrol'#7#12'ctlRowNumber'#0#0#5'TEdit'#12'ctlRowNumber'#4'Left'#3'('#1#3'To'
|
||||||
|
+'p'#2#12#5'Width'#2'I'#6'Height'#2#21#9'MaxLength'#2#8#8'TabOrder'#2#0#8'OnC'
|
||||||
|
+'hange'#7#18'ctlRowNumberChange'#6'OnExit'#7#16'ctlRowNumberExit'#0#0#0#9'TG'
|
||||||
|
+'roupBox'#9'GroupBox1'#4'Left'#2#8#3'Top'#2'0'#5'Width'#3#17#1#6'Height'#2'q'
|
||||||
|
+#7'Caption'#6#20'Selected row details'#8'TabOrder'#2#1#0#9'TCheckBox'#9'ctlH'
|
||||||
|
+'idden'#4'Left'#2#16#3'Top'#2#8#5'Width'#2'Y'#6'Height'#2#17#7'Caption'#6#7
|
||||||
|
+'Hidde&n'#8'TabOrder'#2#0#0#0#12'TRadioButton'#15'ctlUseDefHeight'#4'Left'#2
|
||||||
|
+#16#3'Top'#2'('#5'Width'#3#145#0#6'Height'#2#25#7'Caption'#6#19'Use &default'
|
||||||
|
+' height'#8'TabOrder'#2#1#7'TabStop'#9#7'OnClick'#7#20'ctlUseDefHeightClick'
|
||||||
|
+#0#0#12'TRadioButton'#16'ctlUseCustHeight'#4'Left'#2#16#3'Top'#2'@'#5'Width'
|
||||||
|
+#3#145#0#6'Height'#2#25#7'Caption'#6#18'Use &custom height'#8'TabOrder'#2#2#7
|
||||||
|
+'OnClick'#7#21'ctlUseCustHeightClick'#0#0#11'TOvcSpinner'#11'OvcSpinner2'#4
|
||||||
|
+'Left'#3#217#0#3'Top'#2'C'#5'Width'#2#16#6'Height'#2#21#10'AutoRepeat'#9#5'D'
|
||||||
|
+'elta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#9'ctlHeight'#0#0#5'TE'
|
||||||
|
+'dit'#9'ctlHeight'#4'Left'#3#168#0#3'Top'#2'D'#5'Width'#2'1'#6'Height'#2#21#9
|
||||||
|
+'MaxLength'#2#5#8'TabOrder'#2#3#0#0#0#9'TGroupBox'#9'GroupBox2'#4'Left'#2#8#3
|
||||||
|
+'Top'#3#168#0#5'Width'#3#17#1#6'Height'#2'i'#7'Caption'#6#19'Overall row det'
|
||||||
|
+'ails'#8'TabOrder'#2#2#0#6'TLabel'#6'Label2'#4'Left'#2#16#3'Top'#2#17#5'Widt'
|
||||||
|
+'h'#2'y'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#19'De&fault row height'#0
|
||||||
|
+#0#6'TLabel'#6'Label3'#4'Left'#2#16#3'Top'#2'5'#5'Width'#2'y'#6'Height'#2#16
|
||||||
|
+#8'AutoSize'#8#7'Caption'#6#13'Ma&ximum rows'#0#0#11'TOvcSpinner'#11'OvcSpin'
|
||||||
|
+'ner3'#4'Left'#3#193#0#3'Top'#2#17#5'Width'#2#16#6'Height'#2#21#10'AutoRepea'
|
||||||
|
+'t'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#16'ctlDefault'
|
||||||
|
+'Height'#0#0#11'TOvcSpinner'#11'OvcSpinner4'#4'Left'#3#217#0#3'Top'#2'5'#5'W'
|
||||||
|
+'idth'#2#16#6'Height'#2#21#10'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255
|
||||||
|
+'?'#14'FocusedControl'#7#11'ctlRowLimit'#0#0#5'TEdit'#11'ctlRowLimit'#4'Left'
|
||||||
|
+#3#144#0#3'Top'#2'4'#5'Width'#2'I'#6'Height'#2#21#8'TabOrder'#2#1#0#0#5'TEdi'
|
||||||
|
+'t'#16'ctlDefaultHeight'#4'Left'#3#144#0#3'Top'#2#17#5'Width'#2'1'#6'Height'
|
||||||
|
+#2#21#9'MaxLength'#2#5#8'TabOrder'#2#0#0#0#0#7'TBitBtn'#5'Reset'#4'Left'#3'3'
|
||||||
|
+#1#3'Top'#2'X'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#6'Re&set'#8'TabOrde'
|
||||||
|
+'r'#2#4#7'OnClick'#7#10'ResetClick'#9'NumGlyphs'#2#2#0#0#7'TBitBtn'#11'Apply'
|
||||||
|
+'Button'#4'Left'#3'3'#1#3'Top'#2'8'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6
|
||||||
|
+#6'&Apply'#7'Default'#9#8'TabOrder'#2#3#7'OnClick'#7#16'ApplyButtonClick'#9
|
||||||
|
+'NumGlyphs'#2#2#0#0#0
|
||||||
|
]);
|
||||||
342
components/orpheus/myovctbpe1.pas
Normal file
342
components/orpheus/myovctbpe1.pas
Normal file
@ -0,0 +1,342 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* myovctbpe1.pas *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* Phil Hess - adapted ovctbpe1.pas to eliminate TOvcSimpleField. *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit MyOvcTbPE1;
|
||||||
|
{Lazarus-specific Rows property editor for the table component.}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
|
||||||
|
Classes, Graphics, Controls,
|
||||||
|
{$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
|
||||||
|
SysUtils, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
|
||||||
|
OvcBase, OvcTCmmn, OvcTable, OvcTbRws, OvcSc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcfrmRowEditor = class(TForm)
|
||||||
|
ctlHidden: TCheckBox;
|
||||||
|
ctlUseDefHeight: TRadioButton;
|
||||||
|
ctlUseCustHeight: TRadioButton;
|
||||||
|
DoneButton: TBitBtn;
|
||||||
|
Panel1: TPanel;
|
||||||
|
SpeedButton1: TSpeedButton;
|
||||||
|
SpeedButton2: TSpeedButton;
|
||||||
|
SpeedButton3: TSpeedButton;
|
||||||
|
SpeedButton4: TSpeedButton;
|
||||||
|
SpeedButton5: TSpeedButton;
|
||||||
|
SpeedButton6: TSpeedButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
GroupBox2: TGroupBox;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Reset: TBitBtn;
|
||||||
|
ctlHeight: TEdit;
|
||||||
|
ctlDefaultHeight: TEdit;
|
||||||
|
ctlRowLimit: TEdit;
|
||||||
|
ctlRowNumber: TEdit;
|
||||||
|
ApplyButton: TBitBtn;
|
||||||
|
OvcSpinner1: TOvcSpinner;
|
||||||
|
OvcSpinner2: TOvcSpinner;
|
||||||
|
OvcSpinner3: TOvcSpinner;
|
||||||
|
OvcSpinner4: TOvcSpinner;
|
||||||
|
procedure ctlUseDefHeightClick(Sender: TObject);
|
||||||
|
procedure ctlUseCustHeightClick(Sender: TObject);
|
||||||
|
procedure SpeedButton1Click(Sender: TObject);
|
||||||
|
procedure SpeedButton2Click(Sender: TObject);
|
||||||
|
procedure SpeedButton3Click(Sender: TObject);
|
||||||
|
procedure SpeedButton4Click(Sender: TObject);
|
||||||
|
procedure SpeedButton5Click(Sender: TObject);
|
||||||
|
procedure SpeedButton6Click(Sender: TObject);
|
||||||
|
procedure ctlRowNumberExit(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure ResetClick(Sender: TObject);
|
||||||
|
procedure ApplyButtonClick(Sender: TObject);
|
||||||
|
procedure DoneButtonClick(Sender: TObject);
|
||||||
|
procedure ctlRowNumberChange(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FRows : TOvcTableRows;
|
||||||
|
FRowNum : TRowNum;
|
||||||
|
CurDefHt : boolean;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure RefreshRowData;
|
||||||
|
procedure SetRowNum(R : TRowNum);
|
||||||
|
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
procedure SetRows(RS : TOvcTableRows);
|
||||||
|
|
||||||
|
property Rows : TOvcTableRows
|
||||||
|
read FRows
|
||||||
|
write SetRows;
|
||||||
|
|
||||||
|
property RowNum : TRowNum
|
||||||
|
read FRowNum
|
||||||
|
write SetRowNum;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-A table row property editor}
|
||||||
|
TOvcTableRowProperty = class(TClassProperty)
|
||||||
|
public
|
||||||
|
procedure Edit; override;
|
||||||
|
function GetAttributes: TPropertyAttributes; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{$R *.DFM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{===TOvcTableRowProperty=============================================}
|
||||||
|
procedure TOvcTableRowProperty.Edit;
|
||||||
|
var
|
||||||
|
RowEditor : TOvcfrmRowEditor;
|
||||||
|
begin
|
||||||
|
RowEditor := TOvcfrmRowEditor.Create(Application);
|
||||||
|
try
|
||||||
|
RowEditor.SetRows(TOvcTableRows(GetOrdValue));
|
||||||
|
RowEditor.ShowModal;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Designer.Modified;
|
||||||
|
{$ELSE}
|
||||||
|
Modified;
|
||||||
|
{$ENDIF}
|
||||||
|
finally
|
||||||
|
RowEditor.Free;
|
||||||
|
end;{try..finally}
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcTableRowProperty.GetAttributes: TPropertyAttributes;
|
||||||
|
begin
|
||||||
|
Result := [paMultiSelect, paDialog, paReadOnly];
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
|
||||||
|
{===TRowEditor=======================================================}
|
||||||
|
procedure TOvcfrmRowEditor.ApplyButtonClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
NewRowLimit : Integer;
|
||||||
|
NewDefHeight : Integer;
|
||||||
|
NewHeight : Integer;
|
||||||
|
RS : TRowStyle;
|
||||||
|
begin
|
||||||
|
NewRowLimit := StrToIntDef(ctlRowLimit.Text, FRows.Limit);
|
||||||
|
if (NewRowLimit < 1) or (NewRowLimit > MaxInt) then {Out of range?}
|
||||||
|
NewRowLimit := FRows.Limit; {Restore previous row limit}
|
||||||
|
FRows.Limit := NewRowLimit;
|
||||||
|
ctlRowLimit.Text := IntToStr(NewRowLimit);
|
||||||
|
if FRowNum >= FRows.Limit then
|
||||||
|
RowNum := pred(FRows.Limit);
|
||||||
|
|
||||||
|
NewDefHeight := StrToIntDef(ctlDefaultHeight.Text, FRows.DefaultHeight);
|
||||||
|
if (NewDefHeight < 5) or (NewDefHeight > 32767) then {Out of range?}
|
||||||
|
NewDefHeight := FRows.DefaultHeight; {Restore previous default height}
|
||||||
|
FRows.DefaultHeight := NewDefHeight;
|
||||||
|
ctlDefaultHeight.Text := IntToStr(NewDefHeight);
|
||||||
|
|
||||||
|
with RS do
|
||||||
|
begin
|
||||||
|
if ctlUseDefHeight.Checked then
|
||||||
|
Height := StrToIntDef(ctlDefaultHeight.Text, Height)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
NewHeight := StrToIntDef(ctlHeight.Text, Height);
|
||||||
|
if (NewHeight < 5) or (NewHeight > 32767) then {Out of range?}
|
||||||
|
NewHeight := Height; {Restore previous row height}
|
||||||
|
Height := NewHeight;
|
||||||
|
ctlHeight.Text := IntToStr(NewHeight);
|
||||||
|
if (Height = FRows.DefaultHeight) then
|
||||||
|
ctlUseDefHeight.Checked := true;
|
||||||
|
end;
|
||||||
|
Hidden := ctlHidden.Checked;
|
||||||
|
FRows[RowNum] := RS;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.ctlRowNumberExit(Sender: TObject);
|
||||||
|
begin
|
||||||
|
RowNum := StrToInt(ctlRowNumber.Text);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.ctlUseCustHeightClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
CurDefHt := false;
|
||||||
|
ctlHeight.Enabled := true;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.ctlUseDefHeightClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
CurDefHt := true;
|
||||||
|
ctlHeight.Text := IntToStr(FRows.DefaultHeight);
|
||||||
|
ctlHeight.Enabled := false;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ctlDefaultHeight.Text := IntToStr(FRows.DefaultHeight);
|
||||||
|
ctlRowLimit.Text := IntToStr(FRows.Limit);
|
||||||
|
RefreshRowData;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.RefreshRowData;
|
||||||
|
begin
|
||||||
|
CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
|
||||||
|
|
||||||
|
ctlHidden.Checked := FRows.Hidden[RowNum];
|
||||||
|
ctlHeight.Text := IntToStr(FRows.Height[RowNum]);
|
||||||
|
if CurDefHt then
|
||||||
|
begin
|
||||||
|
ctlUseDefHeight.Checked := true;
|
||||||
|
ctlHeight.Enabled := false;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ctlUseCustHeight.Checked := true;
|
||||||
|
ctlHeight.Enabled := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ctlRowLimit.Text := IntToStr(FRows.Limit);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.ResetClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FRows.Clear;
|
||||||
|
ctlDefaultHeight.Text := IntToStr(FRows.DefaultHeight);
|
||||||
|
RefreshRowData;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SetRowNum(R : TRowNum);
|
||||||
|
begin
|
||||||
|
if (FRowNum <> R) then
|
||||||
|
begin
|
||||||
|
FRowNum := R;
|
||||||
|
RefreshRowData;
|
||||||
|
ctlRowNumber.Text := IntToStr(R); //Do this after refresh
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SetRows(RS : TOvcTableRows);
|
||||||
|
begin
|
||||||
|
if Assigned(FRows) then
|
||||||
|
FRows.Free;
|
||||||
|
FRows := RS;
|
||||||
|
FRowNum := 0;
|
||||||
|
ctlRowNumber.Text := '0';
|
||||||
|
CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if (RowNum > 0) then
|
||||||
|
RowNum := RowNum - 1;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton2Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if (RowNum < pred(FRows.Limit)) then
|
||||||
|
RowNum := RowNum + 1;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton3Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
RowNum := 0;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton4Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
RowNum := pred(FRows.Limit);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton5Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
RS : TRowStyle;
|
||||||
|
begin
|
||||||
|
RS.Hidden := false;
|
||||||
|
RS.Height := FRows.DefaultHeight;
|
||||||
|
FRows.Insert(FRowNum, RS);
|
||||||
|
RefreshRowData;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmRowEditor.SpeedButton6Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FRows.Delete(FRowNum);
|
||||||
|
RefreshRowData;
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
procedure TOvcfrmRowEditor.DoneButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcfrmRowEditor.ctlRowNumberChange(Sender: TObject);
|
||||||
|
var
|
||||||
|
NewRowNum : Integer;
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if not TryStrToInt(ctlRowNumber.Text, NewRowNum) then {Invalid?}
|
||||||
|
ctlRowNumber.Text := IntToStr(RowNum) {Restore previous row number}
|
||||||
|
else if NewRowNum = -1 then {Wrap around to last row?}
|
||||||
|
ctlRowNumber.Text := IntToStr(Pred(FRows.Limit))
|
||||||
|
else if NewRowNum = FRows.Limit then {Wrap around to first row?}
|
||||||
|
ctlRowNumber.Text := '0'
|
||||||
|
else if not (NewRowNum in [0..Pred(FRows.Limit)]) then {Out of range?}
|
||||||
|
ctlRowNumber.Text := IntToStr(RowNum); {Restore previous row number}
|
||||||
|
RowNum := StrToInt(ctlRowNumber.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{$I myovctbpe1.lrs} {Include form's resource file}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
290
components/orpheus/myovctbpe2.lfm
Normal file
290
components/orpheus/myovctbpe2.lfm
Normal file
@ -0,0 +1,290 @@
|
|||||||
|
object OvcfrmColEditor: TOvcfrmColEditor
|
||||||
|
Left = 353
|
||||||
|
Top = 207
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Columns Editor'
|
||||||
|
ClientHeight = 190
|
||||||
|
Height = 190
|
||||||
|
ClientWidth = 386
|
||||||
|
Width = 386
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Style = []
|
||||||
|
Position = poScreenCenter
|
||||||
|
OnShow = FormShow
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Width = 386
|
||||||
|
Height = 41
|
||||||
|
Align = alTop
|
||||||
|
Alignment = taLeftJustify
|
||||||
|
BevelInner = bvLowered
|
||||||
|
TabOrder = 0
|
||||||
|
object SpeedButton1: TSpeedButton
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Previous column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB0000
|
||||||
|
BBBBBBBBBBBB777BBBBBBBBBBBB00CC0BBBBBBBBBBB7777BBBBBBBBBBB00CCC0
|
||||||
|
BBBBBBBBBB77777BBBBBBBBBB00CCCC0BBBBBBBBB777777BBBBBBBBB00CCCCC0
|
||||||
|
BBBBBBBB7777777BBBBBBBBF0CCCCCC0BBBBBBB77777777BBBBBBBBF0CCCCCC0
|
||||||
|
BBBBBBB77777777BBBBBBBBBFCCCCCC0BBBBBBBB7777777BBBBBBBBBBFCCCCC0
|
||||||
|
BBBBBBBBB777777BBBBBBBBBBBFCCCC0BBBBBBBBBB77777BBBBBBBBBBBBFCCC0
|
||||||
|
BBBBBBBBBBB7777BBBBBBBBBBBBBFFFFBBBBBBBBBBBB777BBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton1Click
|
||||||
|
end
|
||||||
|
object SpeedButton2: TSpeedButton
|
||||||
|
Left = 32
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Next column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBB
|
||||||
|
BBBBBBBFFFFBBBBBBBBBBBBF0000BBBBBBBBBBBFFFFFBBBBBBBBBBBFCCC00BBB
|
||||||
|
BBBBBBBFFFFFFBBBBBBBBBBFCCCC00BBBBBBBBBFFFFFFFBBBBBBBBBFCCCCC00B
|
||||||
|
BBBBBBBFFFFFFFFBBBBBBBBFCCCCCC00BBBBBBBFFFFFFFFFBBBBBBBFCCCCCC0F
|
||||||
|
BBBBBBBFFFFFFFFFBBBBBBBFCCCCCCFBBBBBBBBFFFFFFFFBBBBBBBBFCCCCCFBB
|
||||||
|
BBBBBBBFFFFFFFBBBBBBBBBFCCCCFBBBBBBBBBBFFFFFFBBBBBBBBBBFCCCFBBBB
|
||||||
|
BBBBBBBFFFFFBBBBBBBBBBBFFFFBBBBBBBBBBBBFFFFBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton2Click
|
||||||
|
end
|
||||||
|
object SpeedButton3: TSpeedButton
|
||||||
|
Left = 72
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'First column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB00
|
||||||
|
BBBBBBFFBBBBBBFFBBBBBB00BBBBB000BBBBBBFFBBBBBFFFBBBBBB00BBBB00C0
|
||||||
|
BBBBBBFFBBBBFFFFBBBBBB00BBB00CC0BBBBBBFFBBBFFFFFBBBBBB00BB00CCC0
|
||||||
|
BBBBBBFFBBFFFFFFBBBBBB00B00CCCC0BBBBBBFFBFFFFFFFBBBBBB00BFCCCCC0
|
||||||
|
BBBBBBFFBFFFFFFFBBBBBB00BBFCCCC0BBBBBBFFBBFFFFFFBBBBBB00BBBFCCC0
|
||||||
|
BBBBBBFFBBBFFFFFBBBBBB00BBBBFCC0BBBBBBFFBBBBFFFFBBBBBB00BBBBBFC0
|
||||||
|
BBBBBBFFBBBBBFFFBBBBBB00BBBBBBFFBBBBBBFFBBBBBBFFBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton3Click
|
||||||
|
end
|
||||||
|
object SpeedButton4: TSpeedButton
|
||||||
|
Left = 96
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Last column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB
|
||||||
|
00BBBBBB77BBBBBB77BBBBBB000BBBBB00BBBBBB777BBBBB77BBBBBB0C00BBBB
|
||||||
|
00BBBBBB7777BBBB77BBBBBB0CC00BBB00BBBBBB77777BBB77BBBBBB0CCC00BB
|
||||||
|
00BBBBBB777777BB77BBBBBB0CCCC00B00BBBBBB7777777B77BBBBBB0CCCCCFB
|
||||||
|
00BBBBBB7777777B77BBBBBB0CCCCFBB00BBBBBB777777BB77BBBBBB0CCCFBBB
|
||||||
|
00BBBBBB77777BBB77BBBBBB0CCFBBBB00BBBBBB7777BBBB77BBBBBB0CFBBBBB
|
||||||
|
00BBBBBB777BBBBB77BBBBBBFFBBBBBB00BBBBBB77BBBBBB77BBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton4Click
|
||||||
|
end
|
||||||
|
object SpeedButton5: TSpeedButton
|
||||||
|
Left = 136
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Insert column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBBBBBBBBBF777BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBB000000CC000
|
||||||
|
000BB777777BB777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
|
||||||
|
CC0BBFBBBBBBBBBBBB7BBFFFFFFCC0FFFFFBBFFFFFFBB7FFFFFBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
|
||||||
|
BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFFF0BB
|
||||||
|
BBBBBBBBBBFFF7BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton5Click
|
||||||
|
end
|
||||||
|
object SpeedButton6: TSpeedButton
|
||||||
|
Left = 160
|
||||||
|
Top = 8
|
||||||
|
Width = 25
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Delete column'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
0400000000000001000000000000000000001000000010000000000000000000
|
||||||
|
80000080000000808000800000008000800080800000C0C0C000808080000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00000000000
|
||||||
|
000BB77777777777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
|
||||||
|
CC0BBFBBBBBBBBBBBB7BBFFFFFFFFFFFFFFBBFFFFFFFFFFFFFFBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
|
||||||
|
NumGlyphs = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = SpeedButton6Click
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 200
|
||||||
|
Top = 12
|
||||||
|
Width = 105
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Column &number'
|
||||||
|
end
|
||||||
|
object OvcSpinner2: TOvcSpinner
|
||||||
|
Left = 361
|
||||||
|
Top = 11
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlColNumber
|
||||||
|
end
|
||||||
|
object ctlColNumber: TEdit
|
||||||
|
Left = 312
|
||||||
|
Top = 11
|
||||||
|
Width = 49
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 5
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = ctlColNumberChange
|
||||||
|
OnExit = ctlColNumberExit
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Top = 48
|
||||||
|
Width = 273
|
||||||
|
Height = 137
|
||||||
|
Caption = 'Column details'
|
||||||
|
TabOrder = 1
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 4
|
||||||
|
Width = 75
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'De&fault Cell'
|
||||||
|
FocusControl = ctlDefaultCell
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 92
|
||||||
|
Width = 75
|
||||||
|
Height = 16
|
||||||
|
AutoSize = False
|
||||||
|
Caption = '&Width'
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 56
|
||||||
|
Width = 34
|
||||||
|
Height = 13
|
||||||
|
Caption = '&Hidden'
|
||||||
|
FocusControl = ctlHidden
|
||||||
|
end
|
||||||
|
object ctlDefaultCell: TComboBox
|
||||||
|
Left = 8
|
||||||
|
Top = 24
|
||||||
|
Width = 257
|
||||||
|
Height = 21
|
||||||
|
Style = csDropDownList
|
||||||
|
DropDownCount = 16
|
||||||
|
ItemHeight = 13
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object ctlHidden: TCheckBox
|
||||||
|
Left = 96
|
||||||
|
Top = 56
|
||||||
|
Width = 17
|
||||||
|
Height = 17
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object OvcSpinner1: TOvcSpinner
|
||||||
|
Left = 145
|
||||||
|
Top = 90
|
||||||
|
Width = 16
|
||||||
|
Height = 21
|
||||||
|
AutoRepeat = True
|
||||||
|
Delta = 1.000000000000000000
|
||||||
|
FocusedControl = ctlWidth
|
||||||
|
end
|
||||||
|
object ctlWidth: TEdit
|
||||||
|
Left = 96
|
||||||
|
Top = 90
|
||||||
|
Width = 49
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 5
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object DoneButton: TBitBtn
|
||||||
|
Left = 304
|
||||||
|
Top = 160
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = '&Done'
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 3
|
||||||
|
OnClick = DoneButtonClick
|
||||||
|
NumGlyphs = 2
|
||||||
|
end
|
||||||
|
object ApplyButton: TBitBtn
|
||||||
|
Left = 304
|
||||||
|
Top = 56
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = '&Apply'
|
||||||
|
Default = True
|
||||||
|
TabOrder = 2
|
||||||
|
OnClick = ApplyButtonClick
|
||||||
|
NumGlyphs = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
157
components/orpheus/myovctbpe2.lrs
Normal file
157
components/orpheus/myovctbpe2.lrs
Normal file
@ -0,0 +1,157 @@
|
|||||||
|
LazarusResources.Add('TOvcfrmColEditor','FORMDATA',[
|
||||||
|
'TPF0'#16'TOvcfrmColEditor'#15'OvcfrmColEditor'#4'Left'#3'a'#1#3'Top'#3#207#0
|
||||||
|
+#11'BorderIcons'#11#12'biSystemMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Capti'
|
||||||
|
+'on'#6#14'Columns Editor'#12'ClientHeight'#3#190#0#6'Height'#3#190#0#11'Clie'
|
||||||
|
+'ntWidth'#3#130#1#5'Width'#3#130#1#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
|
||||||
|
+#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
|
||||||
|
+#10'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#6'OnShow'#7#8'FormShow'
|
||||||
|
+#13'PixelsPerInch'#2'`'#10'TextHeight'#2#13#0#6'TPanel'#6'Panel1'#4'Left'#2#0
|
||||||
|
+#3'Top'#2#0#5'Width'#3#130#1#6'Height'#2')'#5'Align'#7#5'alTop'#9'Alignment'
|
||||||
|
+#7#13'taLeftJustify'#10'BevelInner'#7#9'bvLowered'#8'TabOrder'#2#0#0#12'TSpe'
|
||||||
|
+'edButton'#12'SpeedButton1'#4'Left'#2#8#3'Top'#2#8#5'Width'#2#25#6'Height'#2
|
||||||
|
+#25#4'Hint'#6#15'Previous column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1
|
||||||
|
+#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0
|
||||||
|
+#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0
|
||||||
|
+#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0
|
||||||
|
+#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#0#0#187#187#187#187#187
|
||||||
|
+#187'w{'#187#187#187#187#187#176#12#192#187#187#187#187#187#183'w{'#187#187
|
||||||
|
+#187#187#187#0#204#192#187#187#187#187#187'ww{'#187#187#187#187#176#12#204
|
||||||
|
+#192#187#187#187#187#183'ww{'#187#187#187#187#0#204#204#192#187#187#187#187
|
||||||
|
+'www{'#187#187#187#191#12#204#204#192#187#187#187#183'www{'#187#187#187#191
|
||||||
|
+#12#204#204#192#187#187#187#183'www{'#187#187#187#187#252#204#204#192#187#187
|
||||||
|
+#187#187'www{'#187#187#187#187#191#204#204#192#187#187#187#187#183'ww{'#187
|
||||||
|
+#187#187#187#187#252#204#192#187#187#187#187#187'ww{'#187#187#187#187#187#191
|
||||||
|
+#204#192#187#187#187#187#187#183'w{'#187#187#187#187#187#187#255#255#187#187
|
||||||
|
+#187#187#187#187'w{'#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'Spe'
|
||||||
|
+'edButton1Click'#0#0#12'TSpeedButton'#12'SpeedButton2'#4'Left'#2' '#3'Top'#2
|
||||||
|
+#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#11'Next column'#10'Glyph.Data'#10
|
||||||
|
+'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0
|
||||||
|
+#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0
|
||||||
|
+#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128
|
||||||
|
+#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
|
||||||
|
+#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#191#0#11
|
||||||
|
+#187#187#187#187#187#191#255#251#187#187#187#187#187#191#0#0#187#187#187#187
|
||||||
|
+#187#191#255#255#187#187#187#187#187#191#204#192#11#187#187#187#187#191#255
|
||||||
|
+#255#251#187#187#187#187#191#204#204#0#187#187#187#187#191#255#255#255#187
|
||||||
|
+#187#187#187#191#204#204#192#11#187#187#187#191#255#255#255#251#187#187#187
|
||||||
|
+#191#204#204#204#0#187#187#187#191#255#255#255#255#187#187#187#191#204#204
|
||||||
|
+#204#15#187#187#187#191#255#255#255#255#187#187#187#191#204#204#204#251#187
|
||||||
|
+#187#187#191#255#255#255#251#187#187#187#191#204#204#207#187#187#187#187#191
|
||||||
|
+#255#255#255#187#187#187#187#191#204#204#251#187#187#187#187#191#255#255#251
|
||||||
|
+#187#187#187#187#191#204#207#187#187#187#187#187#191#255#255#187#187#187#187
|
||||||
|
+#187#191#255#251#187#187#187#187#187#191#255#251#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'
|
||||||
|
+#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton2Click'#0#0#12'TSpeedButton'#12
|
||||||
|
+'SpeedButton3'#4'Left'#2'H'#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6
|
||||||
|
+#12'First column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0
|
||||||
|
+#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0
|
||||||
|
+#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0
|
||||||
|
+#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255
|
||||||
|
+#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#0#187#187#187#0#187#187#187#255#187#187#187#255#187
|
||||||
|
+#187#187#0#187#187#176#0#187#187#187#255#187#187#191#255#187#187#187#0#187
|
||||||
|
+#187#0#192#187#187#187#255#187#187#255#255#187#187#187#0#187#176#12#192#187
|
||||||
|
+#187#187#255#187#191#255#255#187#187#187#0#187#0#204#192#187#187#187#255#187
|
||||||
|
+#255#255#255#187#187#187#0#176#12#204#192#187#187#187#255#191#255#255#255#187
|
||||||
|
+#187#187#0#191#204#204#192#187#187#187#255#191#255#255#255#187#187#187#0#187
|
||||||
|
+#252#204#192#187#187#187#255#187#255#255#255#187#187#187#0#187#191#204#192
|
||||||
|
+#187#187#187#255#187#191#255#255#187#187#187#0#187#187#252#192#187#187#187
|
||||||
|
,#255#187#187#255#255#187#187#187#0#187#187#191#192#187#187#187#255#187#187
|
||||||
|
+#191#255#187#187#187#0#187#187#187#255#187#187#187#255#187#187#187#255#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14
|
||||||
|
+'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton3Click'#0#0#12'T'
|
||||||
|
+'SpeedButton'#12'SpeedButton4'#4'Left'#2'`'#3'Top'#2#8#5'Width'#2#25#6'Heigh'
|
||||||
|
+'t'#2#25#4'Hint'#6#11'Last column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1
|
||||||
|
+#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0
|
||||||
|
+#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0
|
||||||
|
+#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0
|
||||||
|
+#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#0#187#187#187#0#187#187#187'w'
|
||||||
|
+#187#187#187'w'#187#187#187#0#11#187#187#0#187#187#187'w{'#187#187'w'#187#187
|
||||||
|
+#187#12#0#187#187#0#187#187#187'ww'#187#187'w'#187#187#187#12#192#11#187#0
|
||||||
|
+#187#187#187'ww{'#187'w'#187#187#187#12#204#0#187#0#187#187#187'www'#187'w'
|
||||||
|
+#187#187#187#12#204#192#11#0#187#187#187'www{w'#187#187#187#12#204#204#251#0
|
||||||
|
+#187#187#187'www{w'#187#187#187#12#204#207#187#0#187#187#187'www'#187'w'#187
|
||||||
|
+#187#187#12#204#251#187#0#187#187#187'ww{'#187'w'#187#187#187#12#207#187#187
|
||||||
|
+#0#187#187#187'ww'#187#187'w'#187#187#187#12#251#187#187#0#187#187#187'w{'
|
||||||
|
+#187#187'w'#187#187#187#255#187#187#187#0#187#187#187'w'#187#187#187'w'#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'Par'
|
||||||
|
+'entShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton4Click'#0#0#12'TSpe'
|
||||||
|
+'edButton'#12'SpeedButton5'#4'Left'#3#136#0#3'Top'#2#8#5'Width'#2#25#6'Heigh'
|
||||||
|
+'t'#2#25#4'Hint'#6#13'Insert column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'
|
||||||
|
+#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0
|
||||||
|
+#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128
|
||||||
|
+#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0
|
||||||
|
+#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#240#0#187
|
||||||
|
+#187#187#187#187#187#247'w'#187#187#187#187#187#187#252#192#187#187#187#187
|
||||||
|
+#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251
|
||||||
|
+#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187
|
||||||
|
+#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#176#0#0
|
||||||
|
+#12#192#0#0#11#183'ww{'#183'ww{'#191#204#204#204#204#204#204#11#191#187#187
|
||||||
|
+#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187#187#187#187
|
||||||
|
+#187'{'#191#255#255#252#192#255#255#251#191#255#255#251#183#255#255#251#187
|
||||||
|
+#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252
|
||||||
|
+#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187
|
||||||
|
+#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187
|
||||||
|
+#187#251#183#187#187#187#187#187#187#255#240#187#187#187#187#187#187#255#247
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedBu'
|
||||||
|
+'tton5Click'#0#0#12'TSpeedButton'#12'SpeedButton6'#4'Left'#3#160#0#3'Top'#2#8
|
||||||
|
+#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#13'Delete column'#10'Glyph.Data'#10
|
||||||
|
+'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0
|
||||||
|
+#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0
|
||||||
|
+#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128
|
||||||
|
+#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
|
||||||
|
+#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#176#0#0#0#0#0#0#11#183'wwwwww{'#191#204#204#204#204#204#204
|
||||||
|
+#11#191#187#187#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187
|
||||||
|
+#187#187#187#187'{'#191#255#255#255#255#255#255#251#191#255#255#255#255#255
|
||||||
|
+#255#251#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
|
||||||
|
+#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7
|
||||||
|
,#17'SpeedButton6Click'#0#0#6'TLabel'#6'Label1'#4'Left'#3#200#0#3'Top'#2#12#5
|
||||||
|
+'Width'#2'i'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#14'Column &number'#0#0
|
||||||
|
+#11'TOvcSpinner'#11'OvcSpinner2'#4'Left'#3'i'#1#3'Top'#2#11#5'Width'#2#16#6
|
||||||
|
+'Height'#2#21#10'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'Focuse'
|
||||||
|
+'dControl'#7#12'ctlColNumber'#0#0#5'TEdit'#12'ctlColNumber'#4'Left'#3'8'#1#3
|
||||||
|
+'Top'#2#11#5'Width'#2'1'#6'Height'#2#21#9'MaxLength'#2#5#8'TabOrder'#2#0#8'O'
|
||||||
|
+'nChange'#7#18'ctlColNumberChange'#6'OnExit'#7#16'ctlColNumberExit'#0#0#0#9
|
||||||
|
+'TGroupBox'#9'GroupBox1'#4'Left'#2#8#3'Top'#2'0'#5'Width'#3#17#1#6'Height'#3
|
||||||
|
+#137#0#7'Caption'#6#14'Column details'#8'TabOrder'#2#1#0#6'TLabel'#6'Label2'
|
||||||
|
+#4'Left'#2#8#3'Top'#2#4#5'Width'#2'K'#6'Height'#2#16#8'AutoSize'#8#7'Caption'
|
||||||
|
+#6#13'De&fault Cell'#12'FocusControl'#7#14'ctlDefaultCell'#0#0#6'TLabel'#6'L'
|
||||||
|
+'abel3'#4'Left'#2#8#3'Top'#2'\'#5'Width'#2'K'#6'Height'#2#16#8'AutoSize'#8#7
|
||||||
|
+'Caption'#6#6'&Width'#0#0#6'TLabel'#6'Label4'#4'Left'#2#8#3'Top'#2'8'#5'Widt'
|
||||||
|
+'h'#2'"'#6'Height'#2#13#7'Caption'#6#7'&Hidden'#12'FocusControl'#7#9'ctlHidd'
|
||||||
|
+'en'#0#0#9'TComboBox'#14'ctlDefaultCell'#4'Left'#2#8#3'Top'#2#24#5'Width'#3#1
|
||||||
|
+#1#6'Height'#2#21#5'Style'#7#14'csDropDownList'#13'DropDownCount'#2#16#10'It'
|
||||||
|
+'emHeight'#2#13#8'TabOrder'#2#0#0#0#9'TCheckBox'#9'ctlHidden'#4'Left'#2'`'#3
|
||||||
|
+'Top'#2'8'#5'Width'#2#17#6'Height'#2#17#8'TabOrder'#2#1#0#0#11'TOvcSpinner'
|
||||||
|
+#11'OvcSpinner1'#4'Left'#3#145#0#3'Top'#2'Z'#5'Width'#2#16#6'Height'#2#21#10
|
||||||
|
+'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#8'ct'
|
||||||
|
+'lWidth'#0#0#5'TEdit'#8'ctlWidth'#4'Left'#2'`'#3'Top'#2'Z'#5'Width'#2'1'#6'H'
|
||||||
|
+'eight'#2#21#9'MaxLength'#2#5#8'TabOrder'#2#2#0#0#0#7'TBitBtn'#10'DoneButton'
|
||||||
|
+#4'Left'#3'0'#1#3'Top'#3#160#0#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#5'&'
|
||||||
|
+'Done'#11'ModalResult'#2#1#8'TabOrder'#2#3#7'OnClick'#7#15'DoneButtonClick'#9
|
||||||
|
+'NumGlyphs'#2#2#0#0#7'TBitBtn'#11'ApplyButton'#4'Left'#3'0'#1#3'Top'#2'8'#5
|
||||||
|
+'Width'#2'K'#6'Height'#2#25#7'Caption'#6#6'&Apply'#7'Default'#9#8'TabOrder'#2
|
||||||
|
+#2#7'OnClick'#7#16'ApplyButtonClick'#9'NumGlyphs'#2#2#0#0#0
|
||||||
|
]);
|
||||||
345
components/orpheus/myovctbpe2.pas
Normal file
345
components/orpheus/myovctbpe2.pas
Normal file
@ -0,0 +1,345 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* myovctbpe2.pas *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* Phil Hess - adapted ovctbpe2.pas to eliminate TOvcSimpleField. *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit MyOvcTbPE2;
|
||||||
|
{Lazarus-specific Columns property editor for the table component}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
|
||||||
|
SysUtils, Classes, Graphics, Controls,
|
||||||
|
{$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
|
||||||
|
TypInfo, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
|
||||||
|
OvcBase, OvcTCmmn, OvcTCell, OvcTbCls, OvcTable, OvcSc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcfrmColEditor = class(TForm)
|
||||||
|
ctlColNumber: TEdit;
|
||||||
|
ctlDefaultCell: TComboBox;
|
||||||
|
ctlHidden: TCheckBox;
|
||||||
|
ctlWidth: TEdit;
|
||||||
|
Panel1: TPanel;
|
||||||
|
SpeedButton1: TSpeedButton;
|
||||||
|
SpeedButton2: TSpeedButton;
|
||||||
|
SpeedButton3: TSpeedButton;
|
||||||
|
SpeedButton4: TSpeedButton;
|
||||||
|
SpeedButton5: TSpeedButton;
|
||||||
|
SpeedButton6: TSpeedButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Label4: TLabel;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
DoneButton: TBitBtn;
|
||||||
|
ApplyButton: TBitBtn;
|
||||||
|
OvcSpinner1: TOvcSpinner;
|
||||||
|
OvcSpinner2: TOvcSpinner;
|
||||||
|
procedure ctlColNumberExit(Sender: TObject);
|
||||||
|
procedure ApplyButtonClick(Sender: TObject);
|
||||||
|
procedure SpeedButton1Click(Sender: TObject);
|
||||||
|
procedure SpeedButton2Click(Sender: TObject);
|
||||||
|
procedure SpeedButton3Click(Sender: TObject);
|
||||||
|
procedure SpeedButton4Click(Sender: TObject);
|
||||||
|
procedure SpeedButton5Click(Sender: TObject);
|
||||||
|
procedure SpeedButton6Click(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure DoneButtonClick(Sender: TObject);
|
||||||
|
procedure ctlColNumberChange(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FCols : TOvcTableColumns;
|
||||||
|
FColNum : TColNum;
|
||||||
|
CurCellIndex : integer;
|
||||||
|
Cells : TStringList;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure GetCells;
|
||||||
|
procedure RefreshColData;
|
||||||
|
procedure SetColNum(C : TColNum);
|
||||||
|
|
||||||
|
procedure AddCellComponentName(const S : string);
|
||||||
|
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
Editor : TObject;
|
||||||
|
procedure SetCols(CS : TOvcTableColumns);
|
||||||
|
|
||||||
|
property Cols : TOvcTableColumns
|
||||||
|
read FCols
|
||||||
|
write SetCols;
|
||||||
|
|
||||||
|
property ColNum : TColNum
|
||||||
|
read FColNum
|
||||||
|
write SetColNum;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-A table column property editor}
|
||||||
|
TOvcTableColumnProperty = class(TClassProperty)
|
||||||
|
public
|
||||||
|
procedure Edit; override;
|
||||||
|
function GetAttributes: TPropertyAttributes; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{$R *.DFM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{===TOvcTableColumnProperty==========================================}
|
||||||
|
procedure TOvcTableColumnProperty.Edit;
|
||||||
|
var
|
||||||
|
ColEditor : TOvcfrmColEditor;
|
||||||
|
begin
|
||||||
|
ColEditor := TOvcfrmColEditor.Create(Application);
|
||||||
|
try
|
||||||
|
ColEditor.Editor := Self;
|
||||||
|
ColEditor.SetCols(TOvcTableColumns(GetOrdValue));
|
||||||
|
ColEditor.ShowModal;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Designer.Modified;
|
||||||
|
{$ELSE}
|
||||||
|
Modified;
|
||||||
|
{$ENDIF}
|
||||||
|
finally
|
||||||
|
ColEditor.Free;
|
||||||
|
end;{try..finally}
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcTableColumnProperty.GetAttributes: TPropertyAttributes;
|
||||||
|
begin
|
||||||
|
Result := [paMultiSelect, paDialog, paReadOnly];
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
|
||||||
|
{===TColEditor=======================================================}
|
||||||
|
procedure TOvcfrmColEditor.AddCellComponentName(const S : string);
|
||||||
|
begin
|
||||||
|
Cells.Add(S);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.ApplyButtonClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
NewColWidth : Integer;
|
||||||
|
begin
|
||||||
|
FCols[ColNum].Hidden := ctlHidden.Checked;
|
||||||
|
NewColWidth := StrToIntDef(ctlWidth.Text, FCols[ColNum].Width);
|
||||||
|
if (NewColWidth < 5) or (NewColWidth > 32767) then {Out of range?}
|
||||||
|
NewColWidth := FCols[ColNum].Width; {Restore previous column width}
|
||||||
|
FCols[ColNum].Width := NewColWidth;
|
||||||
|
ctlWidth.Text := IntToStr(NewColWidth);
|
||||||
|
if (ctlDefaultCell.ItemIndex <> CurCellIndex) then
|
||||||
|
begin
|
||||||
|
CurCellIndex := ctlDefaultCell.ItemIndex;
|
||||||
|
FCols[FColNum].DefaultCell := TOvcBaseTableCell(Cells.Objects[CurCellIndex]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.ctlColNumberExit(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
ColNum := StrToInt(ctlColNumber.Text);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.DoneButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
Cells.Free;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if not Assigned(Cells) then
|
||||||
|
begin
|
||||||
|
Cells := TStringList.Create;
|
||||||
|
GetCells;
|
||||||
|
end;
|
||||||
|
RefreshColData;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.GetCells;
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
{$IFDEF VERSION6}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Designer : IDesigner;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
Designer : IFormDesigner;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
Designer : TFormDesigner;
|
||||||
|
{$ENDIF}
|
||||||
|
TI : PTypeInfo;
|
||||||
|
Index: Integer;
|
||||||
|
C : TComponent;
|
||||||
|
Cell : TOvcBaseTableCell absolute C;
|
||||||
|
begin
|
||||||
|
Cells.Sorted := true;
|
||||||
|
Cells.AddObject('(None)', nil);
|
||||||
|
TI := TOvcBaseTableCell.ClassInfo;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
if (Editor is TClassProperty) then
|
||||||
|
Designer := TClassProperty(Editor).Designer
|
||||||
|
else {the editor is a TDefaultEditor}
|
||||||
|
Designer := TDefaultEditor(Editor).Designer;
|
||||||
|
Designer.GetComponentNames(GetTypeData(TI), AddCellComponentName);
|
||||||
|
for Index := 1 to pred(Cells.Count) do
|
||||||
|
Cells.Objects[Index] := Designer.GetComponent(Cells[Index]);
|
||||||
|
{$ELSE}
|
||||||
|
if (Editor is TClassProperty) then
|
||||||
|
begin
|
||||||
|
TClassProperty(Editor).PropertyHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
|
||||||
|
for Index := 1 to pred(Cells.Count) do
|
||||||
|
Cells.Objects[Index] := TClassProperty(Editor).PropertyHook.GetComponent(Cells[Index]);
|
||||||
|
end
|
||||||
|
else {the editor is a TDefaultComponentEditor}
|
||||||
|
begin
|
||||||
|
TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
|
||||||
|
for Index := 1 to pred(Cells.Count) do
|
||||||
|
Cells.Objects[Index] := TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponent(Cells[Index]);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
ctlDefaultCell.Items := Cells;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.RefreshColData;
|
||||||
|
begin
|
||||||
|
CurCellIndex := Cells.IndexOfObject(FCols[ColNum].DefaultCell);
|
||||||
|
|
||||||
|
ctlHidden.Checked := FCols[ColNum].Hidden;
|
||||||
|
ctlWidth.Text := IntToStr(FCols[ColNum].Width);
|
||||||
|
ctlDefaultCell.ItemIndex := CurCellIndex;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SetColNum(C : TColNum);
|
||||||
|
begin
|
||||||
|
if (FColNum <> C) then
|
||||||
|
begin
|
||||||
|
FColNum := C;
|
||||||
|
RefreshColData;
|
||||||
|
ctlColNumber.Text := IntToStr(C); //Do this after refresh
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SetCols(CS : TOvcTableColumns);
|
||||||
|
begin
|
||||||
|
if Assigned(FCols) then
|
||||||
|
FCols.Free;
|
||||||
|
FCols := CS;
|
||||||
|
FColNum := 0;
|
||||||
|
ctlColNumber.Text := '0';
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if (ColNum > 0) then
|
||||||
|
ColNum := ColNum - 1;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton2Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if (ColNum < pred(FCols.Count)) then
|
||||||
|
ColNum := ColNum + 1;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton3Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
ColNum := 0;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton4Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
ColNum := pred(FCols.Count);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton5Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
C : TOvcTableColumn;
|
||||||
|
begin
|
||||||
|
C := TOvcTableColumn.Create(FCols.Table);
|
||||||
|
FCols.Insert(FColNum, C);
|
||||||
|
RefreshColData;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcfrmColEditor.SpeedButton6Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if (FCols.Count > 1) then
|
||||||
|
begin
|
||||||
|
FCols.Delete(FColNum);
|
||||||
|
if (FColNum = FCols.Count) then
|
||||||
|
ColNum := pred(FColNum)
|
||||||
|
else RefreshColData;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcfrmColEditor.ctlColNumberChange(Sender: TObject);
|
||||||
|
var
|
||||||
|
NewColNum : Integer;
|
||||||
|
begin
|
||||||
|
ApplyButtonClick(Self);
|
||||||
|
if not TryStrToInt(ctlColNumber.Text, NewColNum) then {Invalid?}
|
||||||
|
ctlColNumber.Text := IntToStr(ColNum) {Restore previous column number}
|
||||||
|
else if NewColNum = -1 then {Wrap around to last column?}
|
||||||
|
ctlColNumber.Text := IntToStr(Pred(FCols.Count))
|
||||||
|
else if NewColNum = FCols.Count then {Wrap around to first column?}
|
||||||
|
ctlColNumber.Text := '0'
|
||||||
|
else if not (NewColNum in [0..Pred(FCols.Count)]) then {Out of range?}
|
||||||
|
ctlColNumber.Text := IntToStr(ColNum); {Restore previous column number}
|
||||||
|
ColNum := StrToInt(ctlColNumber.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{$I myovctbpe2.lrs} {Include form's resource file}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
450
components/orpheus/o32bordr.pas
Normal file
450
components/orpheus/o32bordr.pas
Normal file
@ -0,0 +1,450 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32BORDR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32bordr;
|
||||||
|
{New Style Border control for Orpheus 4 components.}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF}
|
||||||
|
Classes, Controls, Graphics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TO32BorderStyle = (bstyNone, bstyRaised, bstyLowered, bstyFlat, bstyChannel,
|
||||||
|
bstyRidge);
|
||||||
|
|
||||||
|
const
|
||||||
|
THiliteColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnHighlight,
|
||||||
|
clBtnShadow, clWindowFrame, clBtnShadow, clBtnHighlight);
|
||||||
|
|
||||||
|
TBaseColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnShadow,
|
||||||
|
clBtnHighlight, clWindowFrame, clBtnHighlight, clBtnShadow);
|
||||||
|
|
||||||
|
type
|
||||||
|
TO32BorderSide = (bsidLeft, bsidRight, bsidTop, bsidBottom);
|
||||||
|
|
||||||
|
TSides = (left, right, top, bottom);
|
||||||
|
|
||||||
|
TO32Borders = class;
|
||||||
|
|
||||||
|
TO32BorderSet = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FOwner : TPersistent;
|
||||||
|
FLeft : Boolean;
|
||||||
|
FTop : Boolean;
|
||||||
|
FRight : Boolean;
|
||||||
|
FBottom : Boolean;
|
||||||
|
procedure SetLeft(Value: Boolean);
|
||||||
|
procedure SetRight(Value: Boolean);
|
||||||
|
procedure SetBottom(Value: Boolean);
|
||||||
|
procedure SetTop(Value: Boolean);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TPersistent);
|
||||||
|
published
|
||||||
|
property ShowLeft : Boolean read FLeft write SetLeft
|
||||||
|
default True;
|
||||||
|
property ShowRight : Boolean read FRight write SetRight
|
||||||
|
default True;
|
||||||
|
property ShowTop : Boolean read FTop write SetTop
|
||||||
|
default True;
|
||||||
|
property ShowBottom : Boolean read FBottom write SetBottom
|
||||||
|
default True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32Borders = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
Creating : Boolean;
|
||||||
|
FControl : TWinControl;
|
||||||
|
FBorderSet : TO32BorderSet;
|
||||||
|
FActive : Boolean;
|
||||||
|
FFlatColor : TColor;
|
||||||
|
FBorderWidth : Integer;
|
||||||
|
FBorderStyle : TO32BorderStyle;
|
||||||
|
procedure SetActive (Value : Boolean);
|
||||||
|
procedure SetBorderStyle (Value : TO32BorderStyle);
|
||||||
|
procedure SetFlatColor (Value : TColor);
|
||||||
|
|
||||||
|
procedure Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
|
||||||
|
Base: TColor; DrawAllSides: Boolean);
|
||||||
|
procedure DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor{; DrawAllSides: Boolean}); {!!!}
|
||||||
|
procedure DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
|
||||||
|
BaseColor: TColor);
|
||||||
|
procedure Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
|
||||||
|
procedure EraseBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor; AllSides: Boolean);
|
||||||
|
procedure DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor; Side: TSides; Width: Integer);
|
||||||
|
public
|
||||||
|
constructor Create(Control: TWinControl);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Changed;
|
||||||
|
procedure BordersChanged;
|
||||||
|
property Control: TWinControl read FControl;
|
||||||
|
procedure DrawBorders(var Canvas: TControlCanvas; Color: TColor);
|
||||||
|
procedure RedrawControl;
|
||||||
|
published
|
||||||
|
property Active : Boolean read FActive write SetActive
|
||||||
|
default False;
|
||||||
|
property BorderSet : TO32BorderSet
|
||||||
|
read FBorderSet write FBorderSet;
|
||||||
|
property BorderStyle: TO32BorderStyle read FBorderStyle write SetBorderStyle
|
||||||
|
default bstyRidge;
|
||||||
|
property FlatColor: TColor read FFlatColor write SetFlatColor
|
||||||
|
default clLime;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{===== TO32BorderSet =================================================}
|
||||||
|
constructor TO32BorderSet.Create(AOwner: TPersistent);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FOwner := AOwner;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BorderSet.SetLeft(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FLeft then begin
|
||||||
|
FLeft := Value;
|
||||||
|
TO32Borders(FOwner).BordersChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BorderSet.SetRight(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FRight then begin
|
||||||
|
FRight := Value;
|
||||||
|
TO32Borders(FOwner).BordersChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BorderSet.SetBottom(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FBottom then begin
|
||||||
|
FBottom := Value;
|
||||||
|
TO32Borders(FOwner).BordersChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BorderSet.SetTop(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FTop then begin
|
||||||
|
FTop := Value;
|
||||||
|
TO32Borders(FOwner).BordersChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===== TO32BorderSet - End =====}
|
||||||
|
|
||||||
|
|
||||||
|
{===== TO32Borders =================================================}
|
||||||
|
constructor TO32Borders.Create(Control: TWinControl);
|
||||||
|
begin
|
||||||
|
Creating := True;
|
||||||
|
inherited Create;
|
||||||
|
FControl := Control;
|
||||||
|
FBorderSet := TO32BorderSet.Create(self);
|
||||||
|
FActive := false;
|
||||||
|
FBorderWidth := 2;
|
||||||
|
FBorderStyle := bstyRidge;
|
||||||
|
FFlatColor := clLime;
|
||||||
|
FBorderSet.ShowBottom := true;
|
||||||
|
FBorderSet.ShowLeft := true;
|
||||||
|
FBorderSet.ShowRight := true;
|
||||||
|
FBorderSet.ShowTop := true;
|
||||||
|
Creating := False;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32Borders.Destroy;
|
||||||
|
begin
|
||||||
|
FBorderSet.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.SetActive(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FActive <> Value then begin
|
||||||
|
FActive := Value;
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.SetBorderStyle(Value: TO32BorderStyle);
|
||||||
|
begin
|
||||||
|
if Value <> FBorderStyle then begin
|
||||||
|
FBorderStyle := Value;
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.SetFlatColor(Value: TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FFlatColor then begin
|
||||||
|
FFlatColor := Value;
|
||||||
|
if FBorderStyle = bstyFlat then
|
||||||
|
Changed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.DrawBorders(var Canvas: TControlCanvas; Color: TColor);
|
||||||
|
var
|
||||||
|
Rct : TRect;
|
||||||
|
begin
|
||||||
|
if not FActive then exit;
|
||||||
|
|
||||||
|
Rct := Rect(0, 0, FControl.Width, FControl.Height);
|
||||||
|
|
||||||
|
{Erase the existing border.}
|
||||||
|
EraseBorder(Canvas, Rct, Color, true);
|
||||||
|
|
||||||
|
{If the border style is bstyNone then don't do anything else.}
|
||||||
|
if FBorderStyle = bstyNone then exit;
|
||||||
|
|
||||||
|
{otherwise, draw the border.}
|
||||||
|
if FBorderStyle = bstyFlat then
|
||||||
|
DrawFlatBorder(Canvas, Rct, FFlatColor{, false})
|
||||||
|
else Draw3dBorders(Canvas, Rct);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
|
||||||
|
var
|
||||||
|
Hilite, Base: TColor;
|
||||||
|
R: TRect;
|
||||||
|
begin
|
||||||
|
Hilite := THiliteColor[FBorderStyle];
|
||||||
|
Base := TBaseColor[FBorderStyle];
|
||||||
|
|
||||||
|
if FBorderStyle in [bstyLowered, bstyRaised ] then
|
||||||
|
DrawBevel(Canvas, Rct, Hilite, Base)
|
||||||
|
|
||||||
|
else with FBorderSet do begin
|
||||||
|
R := Rct;
|
||||||
|
{Patch the border edges}
|
||||||
|
|
||||||
|
if ShowRight then
|
||||||
|
Canvas.Pixels[R.Right - 1, R.Top] := Base;
|
||||||
|
if ShowTop and not ShowRight then
|
||||||
|
Canvas.Pixels[R.Right - 1, R.Top] := Hilite;
|
||||||
|
if ShowBottom then
|
||||||
|
Canvas.Pixels[R.Left, R.Bottom - 1] := Base;
|
||||||
|
if ShowLeft and not ShowBottom then
|
||||||
|
Canvas.Pixels[R.Left, R.Bottom - 1] := Hilite;
|
||||||
|
if ShowTop and not ShowLeft then
|
||||||
|
Canvas.Pixels[R.Left, R.Top + 1] := Base;
|
||||||
|
if not ShowTop and ShowLeft then
|
||||||
|
Canvas.Pixels[R.Left + 1, R.Top] := Base;
|
||||||
|
if ShowBottom and not ShowRight then
|
||||||
|
Canvas.Pixels[R.Right - 1, R.Bottom - 2] := Hilite;
|
||||||
|
if not ShowBottom and ShowRight then
|
||||||
|
Canvas.Pixels[R.Right - 2, R.Bottom - 1] := Hilite;
|
||||||
|
|
||||||
|
Inc( R.Left );
|
||||||
|
Inc( R.Top );
|
||||||
|
Draw3dBox(Canvas, R, Base, Base, false);
|
||||||
|
OffsetRect(R, -1, -1);
|
||||||
|
Draw3dBox(Canvas, R, Hilite, Hilite, false);
|
||||||
|
|
||||||
|
{ - dead code}
|
||||||
|
// if ShowLeft then Inc(Rct.Left, 2);
|
||||||
|
// if ShowTop then Inc(Rct.Top, 2);
|
||||||
|
// if ShowRight then Dec(Rct.Right, 2);
|
||||||
|
// if ShowBottom then Dec(Rct.Bottom, 2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor; Side: TSides; Width: Integer);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
with Canvas, FBorderSet do begin
|
||||||
|
Pen.Width := 1;
|
||||||
|
Pen.Color := Color;
|
||||||
|
|
||||||
|
if Side = left then
|
||||||
|
for i := 0 to Width do begin
|
||||||
|
MoveTo(Rct.Left - 1, Rct.Top);
|
||||||
|
LineTo(Rct.Left - 1, Rct.Bottom);
|
||||||
|
Inc(Rct.Left);
|
||||||
|
end
|
||||||
|
else if Side = right then
|
||||||
|
for i := 0 to Width do begin
|
||||||
|
MoveTo(Rct.Right , Rct.Top);
|
||||||
|
LineTo(Rct.Right , Rct.Bottom);
|
||||||
|
Dec(Rct.Right);
|
||||||
|
end
|
||||||
|
else if Side = top then
|
||||||
|
for i := 0 to Width do begin
|
||||||
|
MoveTo(Rct.Left, Rct.Top - 1);
|
||||||
|
LineTo(Rct.Right, Rct.Top - 1);
|
||||||
|
Inc(Rct.Top);
|
||||||
|
end
|
||||||
|
else if Side = bottom then
|
||||||
|
for i := 0 to Width do begin
|
||||||
|
MoveTo(Rct.Left, Rct.Bottom);
|
||||||
|
LineTo(Rct.Right, Rct.Bottom);
|
||||||
|
Dec(Rct.Bottom);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
|
||||||
|
Base: TColor; DrawAllSides: Boolean);
|
||||||
|
begin
|
||||||
|
with Canvas, Rct, FBorderSet do begin
|
||||||
|
Pen.Width := 1;
|
||||||
|
Pen.Color := Hilite;
|
||||||
|
if ShowLeft or DrawAllSides then begin
|
||||||
|
MoveTo( Left, Top );
|
||||||
|
LineTo( Left, Bottom );
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ShowTop or DrawAllSides then begin
|
||||||
|
MoveTo( Left, Top );
|
||||||
|
LineTo( Right, Top );
|
||||||
|
end;
|
||||||
|
|
||||||
|
Pen.Color := Base;
|
||||||
|
if ShowRight or DrawAllSides then begin
|
||||||
|
MoveTo( Right - 1, Top );
|
||||||
|
LineTo( Right - 1, Bottom );
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ShowBottom or DrawAllSides then begin
|
||||||
|
MoveTo( Left, Bottom - 1 );
|
||||||
|
LineTo( Right, Bottom - 1 );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
|
||||||
|
BaseColor: TColor);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Width := 1;
|
||||||
|
for I := 1 to FBorderWidth do
|
||||||
|
begin
|
||||||
|
Draw3dBox(Canvas, Rct, HiliteColor, BaseColor, False);
|
||||||
|
Inc(Rct.Left);
|
||||||
|
Inc(Rct.Top);
|
||||||
|
Dec(Rct.Right);
|
||||||
|
Dec(Rct.Bottom);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor{; DrawAllSides: Boolean});
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Color := Color;
|
||||||
|
with BorderSet do begin
|
||||||
|
if ShowLeft then
|
||||||
|
DrawSingleSolidBorder(Canvas, Rct, Color, left, FBorderWidth);
|
||||||
|
if ShowRight then
|
||||||
|
DrawSingleSolidBorder(Canvas, Rct, Color, right, FBorderWidth);
|
||||||
|
if ShowTop then
|
||||||
|
DrawSingleSolidBorder(Canvas, Rct, Color, top, FBorderWidth);
|
||||||
|
if ShowBottom then
|
||||||
|
DrawSingleSolidBorder(Canvas, Rct, Color, bottom, FBorderWidth);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.EraseBorder(Canvas: TControlCanvas; Rct: TRect;
|
||||||
|
Color: TColor; AllSides: Boolean);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Color := Color;
|
||||||
|
with BorderSet do begin
|
||||||
|
for i := 1 to FBorderWidth do begin
|
||||||
|
Draw3dBox(Canvas, Rct, Color, Color, AllSides);
|
||||||
|
Inc(Rct.Left);
|
||||||
|
Inc(Rct.Top);
|
||||||
|
Dec(Rct.Right);
|
||||||
|
Dec(Rct.Bottom);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.BordersChanged;
|
||||||
|
begin
|
||||||
|
if FActive then Changed;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.RedrawControl;
|
||||||
|
var
|
||||||
|
Rct: TRect;
|
||||||
|
begin
|
||||||
|
if not Creating then begin
|
||||||
|
Rct := FControl.ClientRect;
|
||||||
|
RedrawWindow(FControl.Handle, @Rct, 0,
|
||||||
|
rdw_Invalidate or rdw_UpdateNow or rdw_Frame );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Borders.Changed;
|
||||||
|
begin
|
||||||
|
FControl.Invalidate;
|
||||||
|
RedrawControl;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===== TO32Borders - End =====}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
377
components/orpheus/o32editf.pas
Normal file
377
components/orpheus/o32editf.pas
Normal file
@ -0,0 +1,377 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32EDITF.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
{$J+} {Writable constants}
|
||||||
|
|
||||||
|
unit o32editf;
|
||||||
|
{-base FlexEdit field class w/ attached label}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, OvcBase, OvcConst, OvcData, OvcVer,
|
||||||
|
OvcMisc;
|
||||||
|
|
||||||
|
type
|
||||||
|
{base class for non-OvcController dependent edit fields...}
|
||||||
|
TO32CustomEdit = class(TCustomEdit)
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FLabelInfo : TOvcLabelInfo;
|
||||||
|
{property methods}
|
||||||
|
function GetAbout : string;
|
||||||
|
function GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
procedure SetAbout(const Value : string);
|
||||||
|
{internal methods}
|
||||||
|
procedure LabelChange(Sender : TObject);
|
||||||
|
procedure LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
procedure PositionLabel;
|
||||||
|
{VCL message methods}
|
||||||
|
procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
|
||||||
|
procedure OrAssignLabel(var Msg : TMessage); message OM_ASSIGNLABEL;
|
||||||
|
procedure OrPositionLabel(var Msg : TMessage); message OM_POSITIONLABEL;
|
||||||
|
procedure OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
message OM_RECORDLABELPOSITION;
|
||||||
|
protected
|
||||||
|
{descendants can set the value of this variable after calling inherited }
|
||||||
|
{create to set the default location and point-of-reference (POR) for the}
|
||||||
|
{attached label. if dlpTopLeft, the default location and POR will be at }
|
||||||
|
{the top left of the control. if dlpBottomLeft, the default location and}
|
||||||
|
{POR will be at the bottom left}
|
||||||
|
DefaultLabelPosition : TOvcLabelPosition;
|
||||||
|
procedure CreateWnd; override;
|
||||||
|
procedure Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
override;
|
||||||
|
property About : string read GetAbout write SetAbout stored False;
|
||||||
|
property LabelInfo : TOvcLabelInfo read FLabelInfo write FLabelInfo;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||||
|
property AttachedLabel : TOvcAttachedLabel read GetAttachedLabel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32Edit = class(TO32CustomEdit)
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property BiDiMode;
|
||||||
|
property ParentBiDiMode;
|
||||||
|
{$ENDIF}
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property About;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property AutoSelect; // Added recently to LCL, but leave out for now
|
||||||
|
{$ENDIF}
|
||||||
|
property AutoSize;
|
||||||
|
property BorderStyle;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property HideSelection;
|
||||||
|
property ImeMode;
|
||||||
|
property ImeName;
|
||||||
|
{$ENDIF}
|
||||||
|
property LabelInfo;
|
||||||
|
property MaxLength;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property OEMConvert;
|
||||||
|
{$ENDIF}
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PasswordChar;
|
||||||
|
property PopupMenu;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Text;
|
||||||
|
property Visible;
|
||||||
|
{events}
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property OnEndDock;
|
||||||
|
property OnStartDock;
|
||||||
|
{$ENDIF}
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{===== TO32CustomEdit ==============================================}
|
||||||
|
procedure TO32CustomEdit.CMVisibleChanged(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if LabelInfo.Visible then
|
||||||
|
AttachedLabel.Visible := Visible;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
constructor TO32CustomEdit.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
{set default position and reference point}
|
||||||
|
DefaultLabelPosition := lpTopLeft;
|
||||||
|
|
||||||
|
FLabelInfo := TOvcLabelInfo.Create;
|
||||||
|
FLabelInfo.OnChange := LabelChange;
|
||||||
|
FLabelInfo.OnAttach := LabelAttach;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.CreateWnd;
|
||||||
|
// OurForm : TWinControl;
|
||||||
|
begin
|
||||||
|
// OurForm := GetImmediateParentForm(Self);
|
||||||
|
inherited CreateWnd;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32CustomEdit.Destroy;
|
||||||
|
begin
|
||||||
|
{detatch and destroy label, if any}
|
||||||
|
FLabelInfo.Visible := False;
|
||||||
|
|
||||||
|
{destroy label info}
|
||||||
|
FLabelInfo.Free;
|
||||||
|
FLabelInfo := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32CustomEdit.GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
begin
|
||||||
|
if not FLabelInfo.Visible then
|
||||||
|
raise Exception.Create(GetOrphStr(SCLabelNotAttached));
|
||||||
|
|
||||||
|
Result := FLabelInfo.ALabel;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32CustomEdit.GetAbout : string;
|
||||||
|
begin
|
||||||
|
Result := OrVersionStr;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
S :string;
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Value then begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
|
||||||
|
FLabelInfo.ALabel.Parent := Parent;
|
||||||
|
|
||||||
|
S := GenerateComponentName(PF, Name + 'Label');
|
||||||
|
FLabelInfo.ALabel.Name := S;
|
||||||
|
FLabelInfo.ALabel.Caption := S;
|
||||||
|
|
||||||
|
FLabelInfo.SetOffsets(0, 0);
|
||||||
|
PositionLabel;
|
||||||
|
FLabelInfo.ALabel.BringToFront;
|
||||||
|
{turn off auto size}
|
||||||
|
TLabel(FLabelInfo.ALabel).AutoSize := False;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.LabelChange(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
|
||||||
|
if Operation = opRemove then
|
||||||
|
if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
|
||||||
|
FLabelInfo.FVisible := False;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.OrAssignLabel(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.OrPositionLabel(var Msg : TMessage);
|
||||||
|
const
|
||||||
|
DX : Integer = 0;
|
||||||
|
DY : Integer = 0;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
|
||||||
|
end else begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top - Top - Height;
|
||||||
|
end;
|
||||||
|
if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
|
||||||
|
{if the label was cut and then pasted, this will complete the reattachment}
|
||||||
|
FLabelInfo.FVisible := True;
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
|
||||||
|
else
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top - Top - Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.PositionLabel;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end else begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY + Top + Height,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
begin
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
|
||||||
|
if not HandleAllocated then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if HandleAllocated then
|
||||||
|
PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32CustomEdit.SetAbout(const Value : string);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
1584
components/orpheus/o32flxed.pas
Normal file
1584
components/orpheus/o32flxed.pas
Normal file
File diff suppressed because it is too large
Load Diff
146
components/orpheus/o32intdeq.pas
Normal file
146
components/orpheus/o32intdeq.pas
Normal file
@ -0,0 +1,146 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32INTDEQ.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{The following is a modified version of deque code, which was originally written
|
||||||
|
for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
|
||||||
|
used here with permission.}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32intdeq;
|
||||||
|
{A simple deque class for Orpheus}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TO32IntDeque = class
|
||||||
|
protected {private}
|
||||||
|
FList : TList;
|
||||||
|
FHead : integer;
|
||||||
|
FTail : integer;
|
||||||
|
procedure idGrow;
|
||||||
|
public
|
||||||
|
constructor Create(aCapacity : integer);
|
||||||
|
destructor Destroy; override;
|
||||||
|
function IsEmpty : boolean;
|
||||||
|
procedure Enqueue(aValue: integer);
|
||||||
|
procedure Push(aValue: integer);
|
||||||
|
function Pop: integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
{=== TO32IntDeque ====================================================}
|
||||||
|
constructor TO32IntDeque.Create(aCapacity : integer);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FList := TList.Create;
|
||||||
|
FList.Count := aCapacity;
|
||||||
|
{let's help out the user of the deque by putting the head and tail
|
||||||
|
pointers in the middle: it's probably more efficient}
|
||||||
|
FHead := aCapacity div 2;
|
||||||
|
FTail := FHead;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
destructor TO32IntDeque.Destroy;
|
||||||
|
begin
|
||||||
|
FList.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntDeque.Enqueue(aValue : integer);
|
||||||
|
begin
|
||||||
|
FList.List^[FTail] := pointer(aValue);
|
||||||
|
inc(FTail);
|
||||||
|
if (FTail = FList.Count) then
|
||||||
|
FTail := 0;
|
||||||
|
if (FTail = FHead) then
|
||||||
|
idGrow;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntDeque.idGrow;
|
||||||
|
var
|
||||||
|
OldCount : integer;
|
||||||
|
i, j : integer;
|
||||||
|
begin
|
||||||
|
{grow the list by 50%}
|
||||||
|
OldCount := FList.Count;
|
||||||
|
FList.Count := (OldCount * 3) div 2;
|
||||||
|
{expand the data into the increased space, maintaining the deque}
|
||||||
|
if (FHead = 0) then
|
||||||
|
FTail := OldCount
|
||||||
|
else begin
|
||||||
|
j := FList.Count;
|
||||||
|
for i := pred(OldCount) downto FHead do begin
|
||||||
|
dec(j);
|
||||||
|
FList.List^[j] := FList.List^[i]
|
||||||
|
end;
|
||||||
|
FHead := j;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TO32IntDeque.IsEmpty : boolean;
|
||||||
|
begin
|
||||||
|
Result := FHead = FTail;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntDeque.Push(aValue : integer);
|
||||||
|
begin
|
||||||
|
if (FHead = 0) then
|
||||||
|
FHead := FList.Count;
|
||||||
|
dec(FHead);
|
||||||
|
FList.List^[FHead] := pointer(aValue);
|
||||||
|
if (FTail = FHead) then
|
||||||
|
idGrow;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TO32IntDeque.Pop : integer;
|
||||||
|
begin
|
||||||
|
if FHead = FTail then
|
||||||
|
raise Exception.Create('Integer deque is empty: cannot pop');
|
||||||
|
Result := integer(FList.List^[FHead]);
|
||||||
|
inc(FHead);
|
||||||
|
if (FHead = FList.Count) then
|
||||||
|
FHead := 0;
|
||||||
|
end;
|
||||||
|
{=== TO32IntDeque - end ==============================================}
|
||||||
|
|
||||||
|
end.
|
||||||
195
components/orpheus/o32intlst.pas
Normal file
195
components/orpheus/o32intlst.pas
Normal file
@ -0,0 +1,195 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32INTLST.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
//{$APPTYPE GUI}
|
||||||
|
//{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
|
||||||
|
//{$MINSTACKSIZE $00004000}
|
||||||
|
//{$MAXSTACKSIZE $00100000}
|
||||||
|
//{$IMAGEBASE $00400000}
|
||||||
|
|
||||||
|
{The following is a modified version of stack code, which was originally written
|
||||||
|
for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
|
||||||
|
used here with permission.}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32intlst;
|
||||||
|
{Integer List class for Orpheus.}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TO32IntList = class
|
||||||
|
protected {private}
|
||||||
|
FAllowDups : boolean;
|
||||||
|
FCount : integer;
|
||||||
|
FIsSorted : boolean;
|
||||||
|
FList : TList;
|
||||||
|
function ilGetCapacity : integer;
|
||||||
|
function ilGetItem(aInx : integer) : integer;
|
||||||
|
procedure ilSetCapacity(aValue : integer);
|
||||||
|
procedure ilSetCount(aValue : integer);
|
||||||
|
procedure ilSetIsSorted(aValue : boolean);
|
||||||
|
procedure ilSetItem(aInx : integer; aValue : integer);
|
||||||
|
procedure ilSort;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function Add(aItem : integer) : integer;
|
||||||
|
procedure Clear;
|
||||||
|
procedure Insert(aInx : Integer; aItem : Pointer);
|
||||||
|
property AllowDups : boolean
|
||||||
|
read FAllowDups write FAllowDups;
|
||||||
|
property Capacity : integer
|
||||||
|
read ilGetCapacity write ilSetCapacity;
|
||||||
|
property Count : integer
|
||||||
|
read FCount write ilSetCount;
|
||||||
|
property IsSorted : boolean
|
||||||
|
read FIsSorted write ilSetIsSorted;
|
||||||
|
property Items[aInx : integer] : integer
|
||||||
|
read ilGetItem write ilSetItem; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
{===== TO32IntList ===================================================}
|
||||||
|
constructor TO32IntList.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FList := TList.Create;
|
||||||
|
FIsSorted := true;
|
||||||
|
FAllowDups := false;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
destructor TO32IntList.Destroy;
|
||||||
|
begin
|
||||||
|
FList.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TO32IntList.Add(aItem : integer) : integer;
|
||||||
|
var
|
||||||
|
L, R, M : integer;
|
||||||
|
begin
|
||||||
|
if (not IsSorted) or (Count = 0) then
|
||||||
|
Result := FList.Add(pointer(aItem))
|
||||||
|
else begin
|
||||||
|
Result := -1;
|
||||||
|
L := 0;
|
||||||
|
R := pred(Count);
|
||||||
|
while (L <= R) do begin
|
||||||
|
M := (L + R) div 2;
|
||||||
|
if (integer(FList.List^[M]) = aItem) then begin
|
||||||
|
if AllowDups then begin
|
||||||
|
FList.Insert(M, pointer(aItem));
|
||||||
|
Result := M;
|
||||||
|
end;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if (integer(FList.List^[M]) < aItem) then
|
||||||
|
L := M + 1
|
||||||
|
else
|
||||||
|
R := M - 1;
|
||||||
|
end;
|
||||||
|
FList.Insert(L, pointer(aItem));
|
||||||
|
Result := L;
|
||||||
|
end;
|
||||||
|
inc(FCount);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.Clear;
|
||||||
|
begin
|
||||||
|
FList.Clear;
|
||||||
|
FCount := 0;
|
||||||
|
FIsSorted := true;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TO32IntList.ilGetCapacity : integer;
|
||||||
|
begin
|
||||||
|
Result := FList.Capacity;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TO32IntList.ilGetItem(aInx : integer) : integer;
|
||||||
|
begin
|
||||||
|
Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
|
||||||
|
Result := integer(FList.List^[aInx]);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.ilSetCapacity(aValue : integer);
|
||||||
|
begin
|
||||||
|
FList.Capacity := aValue;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.ilSetCount(aValue : integer);
|
||||||
|
begin
|
||||||
|
FList.Count := aValue;
|
||||||
|
FCount := FList.Count;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.ilSetIsSorted(aValue : boolean);
|
||||||
|
begin
|
||||||
|
if (aValue <> FIsSorted) then begin
|
||||||
|
FIsSOrted := aValue;
|
||||||
|
if FIsSorted then
|
||||||
|
ilSort;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.ilSetItem(aInx : integer; aValue : integer);
|
||||||
|
begin
|
||||||
|
Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
|
||||||
|
FList.List^[aInx] := pointer(aValue);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.ilSort;
|
||||||
|
begin
|
||||||
|
Assert(false, 'TO32IntList.ilSort has not been implemented yet');
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TO32IntList.Insert(aInx : Integer; aItem : Pointer);
|
||||||
|
begin
|
||||||
|
FIsSorted := false;
|
||||||
|
FList.Insert(aInx, pointer(aItem));
|
||||||
|
inc(FCount);
|
||||||
|
end;
|
||||||
|
{===== TO32IntList - end =============================================}
|
||||||
|
|
||||||
|
end.
|
||||||
365
components/orpheus/o32ovldr.pas
Normal file
365
components/orpheus/o32ovldr.pas
Normal file
@ -0,0 +1,365 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32OVLDR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
unit o32ovldr;
|
||||||
|
{Orpheus Mask Validator}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, O32VlDtr;
|
||||||
|
|
||||||
|
const
|
||||||
|
OrpheusMaskCount = 17;
|
||||||
|
OrpheusMaskLength = 11;
|
||||||
|
|
||||||
|
{ Sample Orpheus Masks }
|
||||||
|
OrpheusMaskLookup : array [1..OrpheusMaskCount] of string =
|
||||||
|
('XXXXXXXXXX any character',
|
||||||
|
'!!!!!!!!!! any char (upper)',
|
||||||
|
'LLLLLLLLLL any char (lower)',
|
||||||
|
'xxxxxxxxxx any char (mixed)',
|
||||||
|
'aaaaaaaaaa alphas only',
|
||||||
|
'AAAAAAAAAA alphas (upper)',
|
||||||
|
'llllllllll alphas (lower)',
|
||||||
|
'9999999999 0-9',
|
||||||
|
'iiiiiiiiii 0-9, -',
|
||||||
|
'########## 0-9, -, .',
|
||||||
|
'EEEEEEEEEE 0-9, E, -, .',
|
||||||
|
'KKKK Hexadecimal (1F3E) Allows 0-9, A-F, uppercase Alpha characters',
|
||||||
|
'KK Hexadecimal (FF) Allows 0-9, A-F, uppercase Alpha characters',
|
||||||
|
'OOOOOOOOOO 0-7 (octal)',
|
||||||
|
'bbbbbbbbbb 0, 1 (binary)',
|
||||||
|
'B T or F (upper)',
|
||||||
|
'Y Y or N (upper)');
|
||||||
|
|
||||||
|
|
||||||
|
{Validation Error Codes}
|
||||||
|
vecNotAnyOrUpperChar = 1;
|
||||||
|
vecNotAnyOrLowerChar = 2;
|
||||||
|
vecNotAlphaChar = 3;
|
||||||
|
vecNotUpperAlpha = 4;
|
||||||
|
vecNotLowerAlpha = 5;
|
||||||
|
vecNotDS = 6;
|
||||||
|
vecNotDSM = 9;
|
||||||
|
vecNotDSMP = 10;
|
||||||
|
vecNotDSMPE = 11;
|
||||||
|
vecNotHexadecimal = 12;
|
||||||
|
vecNotBinary = 13;
|
||||||
|
vecNotOctal = 14;
|
||||||
|
vecNotTrueFalse = 15;
|
||||||
|
vecNotYesNo = 16;
|
||||||
|
|
||||||
|
type
|
||||||
|
{class - TO32OrMaskValidator}
|
||||||
|
TO32OrMaskValidator = class(TO32BaseValidator)
|
||||||
|
protected {private}
|
||||||
|
FMaskBlank: Char;
|
||||||
|
|
||||||
|
procedure SetInput(const Value: string); override;
|
||||||
|
procedure SetMask(const Value: string); override;
|
||||||
|
function GetValid: Boolean; override;
|
||||||
|
function GetSampleMasks: TStringList; override;
|
||||||
|
function Validate(const Value: string; var ErrorPos: Integer): Boolean;
|
||||||
|
public
|
||||||
|
function IsValid: Boolean; override;
|
||||||
|
property Valid;
|
||||||
|
property Input;
|
||||||
|
published
|
||||||
|
{Properties}
|
||||||
|
property Mask;
|
||||||
|
{Events}
|
||||||
|
property BeforeValidation;
|
||||||
|
property AfterValidation;
|
||||||
|
property OnValidationError;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, OvcData, O32VlReg;
|
||||||
|
|
||||||
|
|
||||||
|
{===== TO32OrMaskValidator ===========================================}
|
||||||
|
|
||||||
|
function TO32OrMaskValidator.GetSampleMasks: TStringList;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
{ Set the length of the mask portion of the string }
|
||||||
|
FSampleMaskLength := OrpheusMaskLength;
|
||||||
|
|
||||||
|
FSampleMasks.Clear;
|
||||||
|
|
||||||
|
{ Load the string list }
|
||||||
|
for I := 1 to OrpheusMaskCount do
|
||||||
|
FSampleMasks.Add(OrpheusMaskLookup[I]);
|
||||||
|
result := FSampleMasks;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32OrMaskValidator.GetValid: Boolean;
|
||||||
|
begin
|
||||||
|
result := IsValid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32OrMaskValidator.IsValid: Boolean;
|
||||||
|
var
|
||||||
|
ErrorStr: string;
|
||||||
|
ErrorPos: Integer;
|
||||||
|
begin
|
||||||
|
DoBeforeValidation;
|
||||||
|
|
||||||
|
{assume the worst}
|
||||||
|
FValid := false;
|
||||||
|
|
||||||
|
{Set up validation and execute it against the input}
|
||||||
|
FValid := Validate(FInput, ErrorPos);
|
||||||
|
|
||||||
|
DoAfterValidation;
|
||||||
|
|
||||||
|
if not FValid then begin
|
||||||
|
case FErrorCode of
|
||||||
|
vecNotAnyOrUpperChar :
|
||||||
|
ErrorStr := 'Lowercase characters not allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotAnyOrLowerChar :
|
||||||
|
ErrorStr := 'Uppercase characters not allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotAlphaChar :
|
||||||
|
ErrorStr := 'Non-Alpha characters not allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotUpperAlpha :
|
||||||
|
ErrorStr := 'Non-Uppercase Alpha characters not allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotLowerAlpha :
|
||||||
|
ErrorStr := 'Non-Lowercase Alpha characters not allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotDS :
|
||||||
|
ErrorStr := 'Digits and spaces only allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotDSM :
|
||||||
|
ErrorStr := 'Digits, spaces and ''-'' only allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotDSMP :
|
||||||
|
ErrorStr := 'Digits, spaces ''-'', and ''.'' only allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotDSMPE :
|
||||||
|
ErrorStr := 'Digits, spaces ''-'', ''.'', and ''e/E'' only allowed '
|
||||||
|
+ 'in position ' + IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotHexadecimal :
|
||||||
|
ErrorStr := 'Hexadecimal characters only (0-F) allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotBinary :
|
||||||
|
ErrorStr := 'Binary characters only (0, 1, and space) allowed in '
|
||||||
|
+ 'position ' + IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotOctal :
|
||||||
|
ErrorStr := 'Octal characters only (0-7) allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotTrueFalse :
|
||||||
|
ErrorStr := 'Only True/false characters (T, t, F, f) allowed in '
|
||||||
|
+ 'position ' + IntToStr(ErrorPos) + '.';
|
||||||
|
vecNotYesNo :
|
||||||
|
ErrorStr := 'Only Yes/No characters (Y, y, N, n) allowed in position '
|
||||||
|
+ IntToStr(ErrorPos) + '.';
|
||||||
|
end;
|
||||||
|
DoOnError(self, 'Invalid match at character position ' + IntToStr(ErrorPos));
|
||||||
|
end;
|
||||||
|
result := FValid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32OrMaskValidator.SetInput(const Value: string);
|
||||||
|
begin
|
||||||
|
if FInput <> Value then
|
||||||
|
FInput := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32OrMaskValidator.SetMask(const Value: string);
|
||||||
|
begin
|
||||||
|
if FMask <> Value then
|
||||||
|
FMask := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32OrMaskValidator.Validate(const Value: string;
|
||||||
|
var ErrorPos: Integer): Boolean;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
ErrorPos := 0;
|
||||||
|
result := true;
|
||||||
|
if Length(Input) > Length(FMask) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := Length(FMask) + 1;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for I := 1 to Length(Input) do begin
|
||||||
|
case FMask[I] of
|
||||||
|
{pmAnyChar : 'X' allows any character}
|
||||||
|
{ do nothing here - All entry is OK.}
|
||||||
|
|
||||||
|
pmForceUpper : {'!' allows any uppercase character}
|
||||||
|
if (ord(Input[I]) in [97..122]{lowercase characters}) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotAnyOrUpperChar;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmForceLower : {'L' allows any lowercase character}
|
||||||
|
if (ord(Input[I]) in [65..90]{uppercase characters}) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotAnyOrLowerChar;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{pmForceMixed : 'x' allows any character. Just like 'X'}
|
||||||
|
{ do nothing here - All entry is ok, no way to force mixed case without }
|
||||||
|
{ back tracking }
|
||||||
|
|
||||||
|
pmAlpha : {'a' allows alphas only}
|
||||||
|
if not (ord(Input[I]) in [65..90, 97..122]{any alpha}) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotAlphaChar;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmUpperAlpha : {'A' allows uppercase alphas only}
|
||||||
|
if not (ord(Input[I]) in [65..90]{uppercase alpha}) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotUpperAlpha;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmLowerAlpha : {'l' allows lowercase alphas only}
|
||||||
|
if not (ord(Input[I]) in [97..122]{lowercase alpha}) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotLowerAlpha;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmPositive : {'9' allows numbers and spaces only}
|
||||||
|
if not (ord(Input[I]) in [48..57, 32]) then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotDS;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmWhole : {'i' allows numbers, spaces, minus}
|
||||||
|
if not (ord(Input[I]) in [48..57, 32, 45]) then
|
||||||
|
begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotDSM;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmDecimal : {'#' allows numbers, spaces, minus, period}
|
||||||
|
if not (ord(Input[I]) in [48..57, 32, 45, 46])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotDSMP;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmScientific : {'E' allows numbers, spaces, minus, period, 'e'}
|
||||||
|
if not (ord(Input[I]) in [48..57, 32, 45, 46, 101, 69])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotDSMPE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmHexadecimal : {'K' allows 0-9 and uppercase A-F}
|
||||||
|
if not (ord(Input[I]) in [48..57, 65..70])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotHexadecimal;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmBinary : {'b' allows 0-1, space}
|
||||||
|
if not (ord(Input[I]) in [48, 49, 32])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotBinary;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmOctal : {'O' allows 0-7, space}
|
||||||
|
if not (ord(Input[I]) in [48..55, 32])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotOctal;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmTrueFalse : {'B' allows T, t, F, f}
|
||||||
|
if not (ord(Input[I]) in [84, 116, 70, 102])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotTrueFalse;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
pmYesNo : {'Y' allows Y, y, N, n}
|
||||||
|
if not (ord(Input[I]) in [89, 121, 78, 110])
|
||||||
|
then begin
|
||||||
|
result := false;
|
||||||
|
ErrorPos := I;
|
||||||
|
FErrorCode := vecNotYesNo;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterValidator(TO32OrMaskValidator);
|
||||||
|
|
||||||
|
finalization
|
||||||
|
UnRegisterValidator(TO32OrMaskValidator);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
446
components/orpheus/o32pvldr.pas
Normal file
446
components/orpheus/o32pvldr.pas
Normal file
@ -0,0 +1,446 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32PVLDR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC} {-Defines}
|
||||||
|
|
||||||
|
unit o32pvldr;
|
||||||
|
{Paradox Mask Validator}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} O32Vldtr, Classes;
|
||||||
|
|
||||||
|
const
|
||||||
|
ParadoxMaskCount = 8;
|
||||||
|
ParadoxMaskLength = 25;
|
||||||
|
|
||||||
|
{Sample Paradox Masks}
|
||||||
|
ParadoxMaskLookup : array [1..ParadoxMaskCount] of string =
|
||||||
|
('!\(999\)000-0000;1;_ Phone (415)555-1212',
|
||||||
|
'!99999;1;_ Extension 15450',
|
||||||
|
'000\-00\-0000;1;_ Social Security 555-55-5555',
|
||||||
|
'00000;1;_ Short Zip Code 90504',
|
||||||
|
'00000\-9999;1;_ Long Zip Code 90504-0000',
|
||||||
|
'!99/99/00;1;_ Date 06/27/01',
|
||||||
|
'!90:00:00>LL;1;_ Long Time 09:05:15PM',
|
||||||
|
'!90:00;1;_ Short Time 13:45');
|
||||||
|
|
||||||
|
type
|
||||||
|
{class - TO32ParadoxValidator}
|
||||||
|
TO32ParadoxValidator = class(TO32BaseValidator)
|
||||||
|
protected {private}
|
||||||
|
FMaskBlank: Char;
|
||||||
|
|
||||||
|
procedure SetInput(const Value: string); override;
|
||||||
|
procedure SetMask(const Value: string); override;
|
||||||
|
function GetValid: Boolean; override;
|
||||||
|
function GetSampleMasks: TStringList; override;
|
||||||
|
function Validate(const Value: string; var Pos: Integer): Boolean;
|
||||||
|
function DoValidateChar(NewChar: Char;
|
||||||
|
MaskOffset: Integer): Boolean;
|
||||||
|
function ValidateChar(NewChar: Char;
|
||||||
|
Offset: Integer): Boolean;
|
||||||
|
function FindLiteralChar(MaskOffset: Integer; InChar: Char): Integer;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
function IsValid: Boolean; override;
|
||||||
|
property Valid;
|
||||||
|
property Input;
|
||||||
|
published
|
||||||
|
{Properties}
|
||||||
|
property Mask;
|
||||||
|
{Events}
|
||||||
|
property BeforeValidation;
|
||||||
|
property AfterValidation;
|
||||||
|
property OnValidationError;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Mask, {$IFDEF VERSION6} MaskUtils, {$ENDIF} {$ELSE} MaskEdit, {$ENDIF}
|
||||||
|
SysUtils, O32VlReg;
|
||||||
|
|
||||||
|
// Note commented out IFNDEF in order to use these functions with LCL.
|
||||||
|
// This means this unit can't be compiled by Delphi 5 and earlier.
|
||||||
|
//{$IFNDEF VERSION6}
|
||||||
|
{ These are declared in the implementation section of the VCL unit Mask.pas, }
|
||||||
|
{ so I had to copy them here so that I could use it. Delphi 6 has made them }
|
||||||
|
{ available by moving them to MaskUtils.pas and making them globally }
|
||||||
|
{ available }
|
||||||
|
function MaskGetCharType(const EditMask: string;
|
||||||
|
MaskOffset: Integer): TMaskCharType;
|
||||||
|
var
|
||||||
|
MaskChar: Char;
|
||||||
|
begin
|
||||||
|
Result := mcLiteral;
|
||||||
|
MaskChar := #0;
|
||||||
|
if MaskOffset <= Length(EditMask) then
|
||||||
|
MaskChar := EditMask[MaskOffset];
|
||||||
|
if MaskOffset > Length(EditMask) then
|
||||||
|
Result := mcNone
|
||||||
|
|
||||||
|
else if ByteType(EditMask, MaskOffset) <> mbSingleByte then
|
||||||
|
Result := mcLiteral
|
||||||
|
|
||||||
|
else if (MaskOffset > 1) and (EditMask[MaskOffset - 1] = mDirLiteral) and
|
||||||
|
(ByteType(EditMask, MaskOffset - 1) = mbSingleByte) and
|
||||||
|
not ((MaskOffset > 2) and (EditMask[MaskOffset - 2] = mDirLiteral) and
|
||||||
|
(ByteType(EditMask, MaskOffset - 2) = mbSingleByte)) then
|
||||||
|
Result := mcLiteral
|
||||||
|
|
||||||
|
else if (MaskChar = MaskFieldSeparator) and
|
||||||
|
(Length(EditMask) >= 4) and
|
||||||
|
(MaskOffset > Length(EditMask) - 4) then
|
||||||
|
Result := mcFieldSeparator
|
||||||
|
|
||||||
|
else if (Length(EditMask) >= 4) and
|
||||||
|
(MaskOffset > (Length(EditMask) - 4)) and
|
||||||
|
(EditMask[MaskOffset - 1] = MaskFieldSeparator) and
|
||||||
|
not ((MaskOffset > 2) and (EditMask[MaskOffset - 2] = mDirLiteral) and
|
||||||
|
(ByteType(EditMask, MaskOffset - 2) <> mbTrailByte)) then
|
||||||
|
Result := mcField
|
||||||
|
|
||||||
|
else if MaskChar in [mMskTimeSeparator, mMskDateSeparator] then
|
||||||
|
Result := mcIntlLiteral
|
||||||
|
|
||||||
|
else if MaskChar in [mDirReverse, mDirUpperCase, mDirLowerCase,
|
||||||
|
mDirLiteral] then
|
||||||
|
Result := mcDirective
|
||||||
|
|
||||||
|
else if MaskChar in [mMskAlphaOpt, mMskAlphaNumOpt, mMskAsciiOpt,
|
||||||
|
mMskNumSymOpt, mMskNumericOpt] then
|
||||||
|
Result := mcMaskOpt
|
||||||
|
|
||||||
|
else if MaskChar in [mMskAlpha, mMskAlphaNum, mMskAscii, mMskNumeric] then
|
||||||
|
Result := mcMask;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function MaskOffsetToOffset(const EditMask: String; MaskOffset: Integer): Integer;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
CType: TMaskCharType;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
for I := 1 to MaskOffset do
|
||||||
|
begin
|
||||||
|
CType := MaskGetCharType(EditMask, I);
|
||||||
|
if not (CType in [mcDirective, mcField, mcFieldSeparator]) then
|
||||||
|
Inc(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function OffsetToMaskOffset(const EditMask: string; Offset: Integer): Integer;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
Count: Integer;
|
||||||
|
MaxChars: Integer;
|
||||||
|
begin
|
||||||
|
MaxChars := MaskOffsetToOffset(EditMask, Length(EditMask));
|
||||||
|
if Offset > MaxChars then
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := 0;
|
||||||
|
Count := Offset;
|
||||||
|
for I := 1 to Length(EditMask) do
|
||||||
|
begin
|
||||||
|
if not (mcDirective = MaskGetCharType(EditMask, I)) then begin
|
||||||
|
Dec(Count);
|
||||||
|
if Count < 0 then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Inc(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function MaskIntlLiteralToChar(IChar: Char): Char;
|
||||||
|
begin
|
||||||
|
Result := IChar;
|
||||||
|
case IChar of
|
||||||
|
mMskTimeSeparator: Result := TimeSeparator;
|
||||||
|
mMskDateSeparator: Result := DateSeparator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function MaskGetCurrentDirectives(const EditMask: string;
|
||||||
|
MaskOffset: Integer): TMaskDirectives;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
MaskChar: Char;
|
||||||
|
begin
|
||||||
|
Result := [];
|
||||||
|
for I := 1 to Length(EditMask) do
|
||||||
|
begin
|
||||||
|
MaskChar := EditMask[I];
|
||||||
|
if (MaskChar = mDirReverse) then
|
||||||
|
Include(Result, mdReverseDir)
|
||||||
|
else if (MaskChar = mDirUpperCase) and (I < MaskOffset) then
|
||||||
|
begin
|
||||||
|
Exclude(Result, mdLowerCase);
|
||||||
|
if not ((I > 1) and (EditMask[I-1] = mDirLowerCase)) then
|
||||||
|
Include(Result, mdUpperCase);
|
||||||
|
end
|
||||||
|
else if (MaskChar = mDirLowerCase) and (I < MaskOffset) then
|
||||||
|
begin
|
||||||
|
Exclude(Result, mdUpperCase);
|
||||||
|
Include(Result, mdLowerCase);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if MaskGetCharType(EditMask, MaskOffset) = mcLiteral then
|
||||||
|
Include(Result, mdLiteralChar);
|
||||||
|
end;
|
||||||
|
//{$ENDIF}
|
||||||
|
|
||||||
|
{===== TO32ParadoxValidator ==========================================}
|
||||||
|
|
||||||
|
constructor TO32ParadoxValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FMaskBlank := DefaultBlank;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.GetValid: Boolean;
|
||||||
|
begin
|
||||||
|
result := IsValid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.GetSampleMasks: TStringList;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
{ Set the length of the mask portion of the string }
|
||||||
|
FSampleMaskLength := ParadoxMaskLength;
|
||||||
|
|
||||||
|
FSampleMasks.Clear;
|
||||||
|
|
||||||
|
{ Load the string list }
|
||||||
|
for I := 1 to ParadoxMaskCount do
|
||||||
|
FSampleMasks.Add(ParadoxMaskLookup[I]);
|
||||||
|
result := FSampleMasks;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.IsValid: Boolean;
|
||||||
|
var
|
||||||
|
ErrorPos: Integer;
|
||||||
|
begin
|
||||||
|
DoBeforeValidation;
|
||||||
|
|
||||||
|
{assume the worst}
|
||||||
|
FValid := false;
|
||||||
|
|
||||||
|
{Set up validation and execute it against the input}
|
||||||
|
FValid := Validate(FInput, ErrorPos);
|
||||||
|
|
||||||
|
DoAfterValidation;
|
||||||
|
|
||||||
|
if not FValid then begin
|
||||||
|
DoOnError(self, 'Validation Error Encountered at string position '
|
||||||
|
+ IntToStr(ErrorPos));
|
||||||
|
end;
|
||||||
|
|
||||||
|
result := FValid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ParadoxValidator.SetInput(const Value: string);
|
||||||
|
begin
|
||||||
|
if FInput <> Value then
|
||||||
|
FInput := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ParadoxValidator.SetMask(const Value: string);
|
||||||
|
begin
|
||||||
|
if FMask <> Value then
|
||||||
|
FMask := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.Validate(const Value: string; var Pos: Integer): Boolean;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
result := true;
|
||||||
|
Pos := 0;
|
||||||
|
for I := 1 to Length(Value) do begin
|
||||||
|
if not ValidateChar(Value[I], I) then begin
|
||||||
|
result := false;
|
||||||
|
Pos := I;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.ValidateChar(NewChar: Char;
|
||||||
|
Offset: Integer): Boolean;
|
||||||
|
var
|
||||||
|
MaskOffset: Integer;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
if FMask <> '' then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
MaskOffset := OffsetToMaskOffset(FMask, Offset);
|
||||||
|
if MaskOffset >= 0 then
|
||||||
|
begin
|
||||||
|
Result := DoValidateChar(NewChar, MaskOffset);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.FindLiteralChar(MaskOffset: Integer;
|
||||||
|
InChar: Char): Integer;
|
||||||
|
var
|
||||||
|
CType: TMaskCharType;
|
||||||
|
LitChar: Char;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
while MaskOffset < Length(Mask) do
|
||||||
|
begin
|
||||||
|
Inc(MaskOffset);
|
||||||
|
CType := MaskGetCharType(Mask, MaskOffset);
|
||||||
|
if CType in [mcLiteral, mcIntlLiteral] then
|
||||||
|
begin
|
||||||
|
LitChar := Mask[MaskOffset];
|
||||||
|
if CType = mcIntlLiteral then
|
||||||
|
LitChar := MaskIntlLiteralToChar(LitChar);
|
||||||
|
if LitChar = InChar then
|
||||||
|
Result := MaskOffset;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ParadoxValidator.DoValidateChar(NewChar: Char;
|
||||||
|
MaskOffset: Integer): Boolean;
|
||||||
|
var
|
||||||
|
Dir: TMaskDirectives;
|
||||||
|
Str: string;
|
||||||
|
CType: TMaskCharType;
|
||||||
|
|
||||||
|
function IsKatakana(const Chr: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TestChar(NewChar: Char): Boolean;
|
||||||
|
var
|
||||||
|
Offset: Integer;
|
||||||
|
begin
|
||||||
|
Offset := MaskOffsetToOffset(FMask, MaskOffset);
|
||||||
|
Result := not ((MaskOffset < Length(FMask)) and
|
||||||
|
(UpCase(FMask[MaskOffset]) = UpCase(Mask[MaskOffset+1]))) or
|
||||||
|
(ByteType(FMask, Offset) = mbTrailByte) or
|
||||||
|
(ByteType(FMask, Offset+1) = mbLeadByte);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
CType := MaskGetCharType(FMask, MaskOffset);
|
||||||
|
if not (CType in [mcLiteral, mcIntlLiteral]) then begin
|
||||||
|
Dir := MaskGetCurrentDirectives(FMask, MaskOffset);
|
||||||
|
case FMask[MaskOffset] of
|
||||||
|
mMskNumeric, mMskNumericOpt:
|
||||||
|
begin
|
||||||
|
if not ((NewChar >= '0') and (NewChar <= '9')) then
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
mMskNumSymOpt:
|
||||||
|
begin
|
||||||
|
if not (((NewChar >= '0') and (NewChar <= '9')) or
|
||||||
|
(NewChar = ' ') or(NewChar = '+') or(NewChar = '-')) then
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
mMskAscii, mMskAsciiOpt:
|
||||||
|
begin
|
||||||
|
if (NewChar in LeadBytes) and TestChar(NewChar) then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if IsCharAlpha(NewChar) then
|
||||||
|
begin
|
||||||
|
Str := ' ';
|
||||||
|
Str[1] := NewChar;
|
||||||
|
if (mdUpperCase in Dir) then
|
||||||
|
Str := AnsiUpperCase(Str)
|
||||||
|
else if mdLowerCase in Dir then
|
||||||
|
Str := AnsiLowerCase(Str);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
mMskAlpha, mMskAlphaOpt, mMskAlphaNum, mMskAlphaNumOpt:
|
||||||
|
begin
|
||||||
|
if (NewChar in LeadBytes) then
|
||||||
|
begin
|
||||||
|
if TestChar(NewChar) then
|
||||||
|
Result := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Str := ' ';
|
||||||
|
Str[1] := NewChar;
|
||||||
|
if IsKatakana(Byte(NewChar)) then
|
||||||
|
Exit;
|
||||||
|
if not IsCharAlpha(NewChar) then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if ((FMask[MaskOffset] = mMskAlphaNum) or
|
||||||
|
(FMask[MaskOffset] = mMskAlphaNumOpt)) and
|
||||||
|
(IsCharAlphaNumeric(NewChar)) then
|
||||||
|
Result := True;
|
||||||
|
end
|
||||||
|
else if mdUpperCase in Dir then
|
||||||
|
Str := AnsiUpperCase(Str)
|
||||||
|
else if mdLowerCase in Dir then
|
||||||
|
Str := AnsiLowerCase(Str);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterValidator(TO32ParadoxValidator);
|
||||||
|
|
||||||
|
finalization
|
||||||
|
UnRegisterValidator(TO32ParadoxValidator);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
1063
components/orpheus/o32rxngn.pas
Normal file
1063
components/orpheus/o32rxngn.pas
Normal file
File diff suppressed because it is too large
Load Diff
294
components/orpheus/o32rxvld.pas
Normal file
294
components/orpheus/o32rxvld.pas
Normal file
@ -0,0 +1,294 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32RXVLD.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32rxvld;
|
||||||
|
{Unit for the Orpheus RegEx Validator}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Classes, O32Vldtr, O32RxNgn, SysUtils;
|
||||||
|
|
||||||
|
const
|
||||||
|
RXMaskCount = 13;
|
||||||
|
RXMaskLength = 80;
|
||||||
|
|
||||||
|
{Sample Regular Expressions for the Regex validator Property editor...}
|
||||||
|
RXMaskLookup : array [1..RXMaskCount] of string =
|
||||||
|
('.+ 1 or more of any characters allowed. Minimum of 1 character required. Note: This is the default behavior. No expression is needed.',
|
||||||
|
'.* Any number of any character allowed. Note: Although This expression allows an empty string, The RegexEngine will fail an empty string.',
|
||||||
|
'(1[012]|[1-9]):[0-5][0-9] (am|pm) Time of day: Standard AM/PM time display (9:17 am) or (12:30 pm)',
|
||||||
|
'(1[012]|[1-9]):[0-5][0-9]:[0-5][0-9] (am|pm) Time of day: Standard AM/PM time diplay with seconds. (9:17:22 am)',
|
||||||
|
'(([01]?[0-9])|(2[0-3])):[0-5][0-9] Time of day: 24 hour clock (15:22).',
|
||||||
|
'(([01]?[0-9])|(2[0-3])):[0-5][0-9]:[0-5][0-9] Time of day: 24 hour clock with seconds (15:22:07).',
|
||||||
|
'(\(?[1-9][0-9][0-9]\)? )?[1-9][0-9][0-9]\-[0-9][0-9][0-9][0-9] Telephone Number: Optional area-code with optional parenthesis',
|
||||||
|
'(0?[1-9]|1[012])(\\|/|\-)([012]?[1-9]|[123]0|31)(\\|/|\-)([123][0-9])?[0-9][0-9] Date: (mm\dd\yy) or (mm\dd\yyyy) formats. Also accepts / and - separators. Note: Only covers years from 1000-3999',
|
||||||
|
'(y(es)?)|(no?) Boolean: Y, y, N, n, Yes, yes, No or no',
|
||||||
|
'(t(rue)?)|(f(alse)?) Boolean: T, t, F, f, True, False, true or false',
|
||||||
|
'([0-9]|[A-F])+ Hexadecimal: Allows any number of characters in the range 0-9 and A-F',
|
||||||
|
'[0-7]+ Octal: Allows any number of characters in the range 0-7.',
|
||||||
|
'[01]+ Binary:Allows any number of binary characters (0 and 1).');
|
||||||
|
|
||||||
|
{Error Codes}
|
||||||
|
EC_NO_ERROR = 0;
|
||||||
|
EC_INVALID_EXPR = 1;
|
||||||
|
EC_INVALID_INPUT = 2;
|
||||||
|
EC_NO_MATCH = 3;
|
||||||
|
|
||||||
|
type
|
||||||
|
{class - TO32RegExValidator}
|
||||||
|
TO32RegExValidator = class(TO32BaseValidator)
|
||||||
|
protected {private}
|
||||||
|
FLogging : Boolean; {Log validator parsing?}
|
||||||
|
FLogFile : String; {Logging file name}
|
||||||
|
FRegexEngine : TO32RegExEngine; {Regex engine used by the validator}
|
||||||
|
FExprErrorPos : Integer; {Error position in the Regex string}
|
||||||
|
FExprErrorCode : TO32RegexError; {Regex string error code}
|
||||||
|
FIgnoreCase : Boolean; {Case sensitive matching}
|
||||||
|
procedure SetIgnoreCase(const Value: Boolean);
|
||||||
|
procedure SetLogging(const Value: Boolean);
|
||||||
|
procedure SetLogFile(const Value: String);
|
||||||
|
procedure SetMask(const Value: String); override;
|
||||||
|
function GetValid: Boolean; override;
|
||||||
|
function GetSampleMasks: TStringList; override;
|
||||||
|
procedure SetInput(const Value: string); override;
|
||||||
|
function CheckExpression(var ErrorPos: Integer): Boolean;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function IsValid: Boolean; override;
|
||||||
|
function GetExprError: String;
|
||||||
|
property Valid;
|
||||||
|
property ExprErrorPos: Integer read FExprErrorPos write FExprErrorPos;
|
||||||
|
published
|
||||||
|
property Input;
|
||||||
|
{ Surfaced the Mask property as "Expression" for the Regex validator
|
||||||
|
Left Mask exposed as public for automated use such as the ValidatorPool}
|
||||||
|
property Expression: string read FMask write SetMask stored true;
|
||||||
|
property Logging: Boolean read FLogging write SetLogging
|
||||||
|
default False;
|
||||||
|
property LogFile: String read FLogFile write SetLogFile;
|
||||||
|
property IgnoreCase: Boolean read FIgnoreCase write SetIgnoreCase stored true
|
||||||
|
default True;
|
||||||
|
{Events}
|
||||||
|
property BeforeValidation;
|
||||||
|
property AfterValidation;
|
||||||
|
property OnValidationError;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
O32VlReg;
|
||||||
|
|
||||||
|
{=== TO32RegExValidator ==============================================}
|
||||||
|
constructor TO32RegExValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
FLogging := false;
|
||||||
|
FLogFile := 'parse.log';
|
||||||
|
FIgnoreCase := true;
|
||||||
|
|
||||||
|
FRegexEngine := TO32RegExEngine.Create('');
|
||||||
|
FRegexEngine.Logging := FLogging;
|
||||||
|
FRegexEngine.LogFile := FLogFile;
|
||||||
|
FRegexEngine.IgnoreCase := FIgnoreCase;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32RegExValidator.Destroy;
|
||||||
|
begin
|
||||||
|
FRegexEngine.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32RegExValidator.GetSampleMasks: TStringList;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
{ Set the length of the mask portion of the string }
|
||||||
|
FSampleMaskLength := RXMaskLength;
|
||||||
|
|
||||||
|
FSampleMasks.Clear;
|
||||||
|
|
||||||
|
{ Load the string list }
|
||||||
|
for I := 1 to RXMaskCount do
|
||||||
|
FSampleMasks.Add(RXMaskLookup[I]);
|
||||||
|
result := FSampleMasks;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32RegExValidator.SetMask(const Value: String);
|
||||||
|
var
|
||||||
|
OldExpression: String;
|
||||||
|
begin
|
||||||
|
OldExpression := FMask;
|
||||||
|
FMask := Value;
|
||||||
|
if not CheckExpression(FExprErrorPos) then
|
||||||
|
FMask := OldExpression;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32RegExValidator.SetInput(const Value: string);
|
||||||
|
begin
|
||||||
|
if FInput <> Value then
|
||||||
|
FInput := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32RegExValidator.CheckExpression(var ErrorPos: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
if (FMask <> '') then begin
|
||||||
|
FRegexEngine.RegexString := FMask;
|
||||||
|
if not FRegexEngine.Parse(FExprErrorPos, FExprErrorCode) then begin
|
||||||
|
result := false;
|
||||||
|
FErrorCode := EC_INVALID_EXPR;
|
||||||
|
DoOnError(self, GetExprError);
|
||||||
|
end else
|
||||||
|
result := true;
|
||||||
|
end else begin
|
||||||
|
{Allow the user to initialize the Validator with an empty string}
|
||||||
|
result := true;
|
||||||
|
ErrorPos := 0;
|
||||||
|
FExprErrorPos := 0;
|
||||||
|
FErrorCode := EC_NO_ERROR;
|
||||||
|
FExprErrorCode := recNone;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32RegExValidator.GetValid: Boolean;
|
||||||
|
begin
|
||||||
|
result := IsValid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32RegExValidator.IsValid: Boolean;
|
||||||
|
var
|
||||||
|
RegExStr: String;
|
||||||
|
begin
|
||||||
|
DoBeforeValidation;
|
||||||
|
|
||||||
|
{assume the worst}
|
||||||
|
FValid := false;
|
||||||
|
|
||||||
|
{Create a copy of the Expression and then enclose it in anchor operators so
|
||||||
|
that the RegexEngine only matches the whole string...}
|
||||||
|
RegExStr := FMask;
|
||||||
|
{Check for Anchor operator ^}
|
||||||
|
if (Pos('^', RegExStr) <> 1) then
|
||||||
|
Insert('^', RegExStr, 1);
|
||||||
|
{Check for Anchor operator $}
|
||||||
|
if (Pos('$', RegExStr) <> Length(RegExStr)) then
|
||||||
|
RegexStr := RegExStr + '$';
|
||||||
|
|
||||||
|
{Pass the RegexStr into the RegexEngine}
|
||||||
|
FRegexEngine.RegexString := RegExStr;
|
||||||
|
|
||||||
|
if (RegExStr = '') then begin
|
||||||
|
FErrorCode := EC_INVALID_EXPR;
|
||||||
|
FValid := false;
|
||||||
|
end else if (FInput = '') then begin
|
||||||
|
FErrorCode := EC_INVALID_INPUT;
|
||||||
|
FValid := false;
|
||||||
|
end else begin
|
||||||
|
if (FRegexEngine.MatchString(FInput) = 1) then begin
|
||||||
|
FValid := true;
|
||||||
|
FErrorCode := 0;
|
||||||
|
end else begin
|
||||||
|
FValid := false;
|
||||||
|
FErrorCode := EC_NO_MATCH;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
result := FValid;
|
||||||
|
|
||||||
|
DoAfterValidation
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32RegExValidator.SetLogging(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
if (FLogging <> Value) then begin
|
||||||
|
FLogging := Value;
|
||||||
|
FRegexEngine.Logging := FLogging;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32RegExValidator.SetIgnoreCase(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
if (FIgnoreCase <> Value) then begin
|
||||||
|
FIgnoreCase := Value;
|
||||||
|
FRegexEngine.IgnoreCase := FIgnoreCase;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32RegExValidator.SetLogFile(const Value: String);
|
||||||
|
begin
|
||||||
|
if (FLogFile <> Value) then begin
|
||||||
|
FLogFile := Value;
|
||||||
|
FRegexEngine.LogFile := FLogFile;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32RegExValidator.GetExprError: String;
|
||||||
|
begin
|
||||||
|
case FExprErrorCode of
|
||||||
|
recNone : result := '';
|
||||||
|
recSuddenEnd : result := 'Incomplete Expression';
|
||||||
|
recMetaChar : result := 'Read a metacharacter where there should have'
|
||||||
|
+ ' been a normal character';
|
||||||
|
recNoCloseParen : result := 'Missing closing parenthesis';
|
||||||
|
recExtraChars : result := 'Unrecognizable text at the end of the'
|
||||||
|
+ ' expression';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
RegisterValidator(TO32RegexValidator);
|
||||||
|
|
||||||
|
finalization
|
||||||
|
|
||||||
|
UnRegisterValidator(TO32RegexValidator);
|
||||||
|
|
||||||
|
end.
|
||||||
253
components/orpheus/o32sr.inc
Normal file
253
components/orpheus/o32sr.inc
Normal file
@ -0,0 +1,253 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32SR.INC *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{Orhpheus String Resources - To create language specific versions of Orpheus
|
||||||
|
controls, translate these strings to the desired language and re-compile.}
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
RSNoneStr = '(None)';
|
||||||
|
RSccUser = 'ccUser';
|
||||||
|
RSccUserNum = 'ccUser%d';
|
||||||
|
RSDeleteTable = 'Delete the %s table?';
|
||||||
|
RSRenameTable = 'Rename Table';
|
||||||
|
RSEnterTableName = 'Enter new table name for %s:';
|
||||||
|
RSNewTable = 'NewTable';
|
||||||
|
RSDefaultTableName = 'Default';
|
||||||
|
RSWordStarTableName = 'WordStar';
|
||||||
|
RSGridTableName = 'Grid';
|
||||||
|
RSUnknownTable = '(Unknown)';
|
||||||
|
RSDefaultEntryErrorText = 'Entry Error';
|
||||||
|
RSGotItemWarning = '%d. *** Warning *** OnGetItem not assigned!';
|
||||||
|
RSSampleListItem = '%d. - Sample virtual list box item';
|
||||||
|
RSAlphaString = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
||||||
|
RSTallLowChars = 'Wy';
|
||||||
|
RSDefault = 'Default';
|
||||||
|
RSYes = 'Y';
|
||||||
|
RSNo = 'N';
|
||||||
|
RSTrue = 'T';
|
||||||
|
RSFalse = 'F';
|
||||||
|
RSDescending = ' - Desc';
|
||||||
|
RSDefaultIndex = '(Default)';
|
||||||
|
RSDuplicateCommand = 'Duplicate command found while adding a new command to the table';
|
||||||
|
RSTableNotFound = 'Command table not found or command table index out of range';
|
||||||
|
RSNotDoneYet = 'This feature is not implemented at this time';
|
||||||
|
RSNoControllerAssigned = 'No Controller assigned';
|
||||||
|
RSCantCreateCommandTable = 'Unable to create command table';
|
||||||
|
RSCantDelete = 'Can''t delete this table. Must have at least one command table defined';
|
||||||
|
RSInvalidKeySequence = 'Invalid or no key sequence entered';
|
||||||
|
RSNotWordStarCommands = 'Keys entered are not WordStar style commands';
|
||||||
|
RSNoCommandSelected = 'No command selected';
|
||||||
|
RSDuplicateKeySequence = 'Duplicate key sequence';
|
||||||
|
RSRangeError = 'Value is not within required range';
|
||||||
|
RSInvalidNumber = 'Value is not valid for this field type';
|
||||||
|
RSRequiredField = 'A value is required in this field';
|
||||||
|
RSInvalidDate = 'Value is not a valid date';
|
||||||
|
RSInvalidTime = 'Value is not a valid time';
|
||||||
|
RSBlanksInField = 'This field should contain no blanks';
|
||||||
|
RSPartialEntry = 'This field should be either empty or completely full';
|
||||||
|
RSRegionTooLarge = 'Region is too large (> 64K)';
|
||||||
|
RSOutOfMemoryForCopy = 'Could not allocate memory for clipboard copy';
|
||||||
|
RSInvalidParamValue = 'Parameter value is invalid';
|
||||||
|
RSNoTimersAvail = 'No Window''s timers are available';
|
||||||
|
RSTooManyEvents = 'Too many trigger events';
|
||||||
|
RSBadTriggerHandle = 'Invalid trigger handle';
|
||||||
|
RSOnSelectNotAssigned = 'OnSelect event is not assigned';
|
||||||
|
RSInvalidPageIndex = 'Invalid page index value';
|
||||||
|
RSInvalidDataType = 'Invalid data type for this field';
|
||||||
|
RSInvalidTabFont = 'Invalid font. Non toTop oriented tabs require a True-Type font';
|
||||||
|
RSInvalidLabelFont = 'Invalid font. Rotated text requires a True-Type font';
|
||||||
|
RSOutOfMemory = 'insufficient memory for requested operation';
|
||||||
|
RSTooManyParas = 'Current operation will exceed the maximum number of allowed paragraphs';
|
||||||
|
RSCannotJoin = 'Cannot join paragraphs. New paragraph size exceeds maximum paragraph size';
|
||||||
|
RSTooManyBytes = 'Current operation will exceed the maximum text size';
|
||||||
|
RSParaTooLong = 'Current operation will exceed the maximum paragraph size';
|
||||||
|
RSUnknownError = 'Unknown Error condition';
|
||||||
|
RSInvalidPictureMask = 'Invalid picture mask: %s';
|
||||||
|
RSInvalidRange = 'Invalid range. Enter a value between (%d) and (%d)';
|
||||||
|
RSInvalidRealRange = 'Invalid range. Enter a value between (-1.7e+38) and (+1.7e+38)';
|
||||||
|
RSInvalidExtendedRange = 'Invalid range. Enter a value between (-1.1e+4932) and (+1.1e+4932)';
|
||||||
|
RSInvalidDoubleRange = 'Invalid range. Enter a value between (-1.7e+308) and (+1.7e+308)';
|
||||||
|
RSInvalidSingleRange = 'Invalid range. Enter a value between (-3.4e+38) and (+3.4e+38)';
|
||||||
|
RSInvalidCompRange = 'Invalid range. Enter a value between (-9.2e+18) and (+9.2e+18)';
|
||||||
|
RSInvalidDateRange = 'Invalid date range. Enter a value using ''%s'' as the format';
|
||||||
|
RSInvalidTimeRange = 'Invalid time range. Enter a value using ''%s'' as the format';
|
||||||
|
RSInvalidRangeValue = 'Invalid range value';
|
||||||
|
RSInvalidMinMaxValue = 'Invalid value - Maximum must always be greater than Minimum';
|
||||||
|
RSRangeNotSupported = 'Range limits for the currently selected data type are not supported';
|
||||||
|
RSInvalidLineOrParaIndex = 'Invalid line or paragraph index';
|
||||||
|
RSNonFixedFont = 'Invalid font assignment. Font must be a fixed font';
|
||||||
|
RSInvalidFontParam = 'Invalid font assignemnt. Font must be a TFont or TOvcFixedFont';
|
||||||
|
RSInvalidLineOrColumn = 'Invalid line or column';
|
||||||
|
RSSAEGeneral = 'Unknown sparse array error';
|
||||||
|
RSSAEAtMaxSize = 'Sparse array is at the maximum size';
|
||||||
|
RSInvalidXMLFile = 'Invalid XMLStore File Format';
|
||||||
|
RSUnterminatedElement = 'Improperly terminated element';
|
||||||
|
RSBadColorConstant = 'Invalid color constant';
|
||||||
|
RSBadColorValue = 'Invalid color value';
|
||||||
|
RSSAEOutOfBounds = 'Index is out of bounds for sparse array';
|
||||||
|
RSInvalidFieldType = 'Requested field type is not supported';
|
||||||
|
RSBadAlarmHandle = 'Invalid alarm handle';
|
||||||
|
RSOnIsSelectedNotAssigned = 'OnIsSelected event is not assigned';
|
||||||
|
RSInvalidDateForMask = 'Invalid date value for picture mask. (Year is outside the Epoch range)';
|
||||||
|
RSViewerIOError = 'Viewer triggered I/O error %d';
|
||||||
|
RSViewerFileNotFound = 'Viewer: file not found';
|
||||||
|
RSViewerPathNotFound = 'Viewer: path not found or invalid file name';
|
||||||
|
RSViewerTooManyOpenFiles = 'Viewer: too many open files';
|
||||||
|
RSViewerFileAccessDenied = 'Viewer: file access denied';
|
||||||
|
RSControlAttached = 'This control is already attached to %s';
|
||||||
|
RSCantEdit = 'Could not enter edit mode';
|
||||||
|
RSChildTableError = 'Data Source can not be a child table. Component %s has a MasterSource defined';
|
||||||
|
RSNoTableAttached = 'DataSource must be attached to a TTable (or compatible) source';
|
||||||
|
RSNoCollection = 'No collection exists in the owner component';
|
||||||
|
RSNotOvcDescendant = 'Owner must be a TOvcComponent or TOvcCustomComponent descendant';
|
||||||
|
RSItemIncompatible = 'Item incompatible with collection';
|
||||||
|
RSLabelNotAttached = 'Label not attached';
|
||||||
|
RSClassNotSet = 'Item class not set';
|
||||||
|
RSCollectionNotFound = 'No collection found for this type';
|
||||||
|
RSDayConvertError = 'Error converting day';
|
||||||
|
RSMonthConvertError = 'Error converting month';
|
||||||
|
RSMonthNameConvertError = 'Error converting month name';
|
||||||
|
RSYearConvertError = 'Error converting year';
|
||||||
|
RSInvalidDay = 'Invalid day';
|
||||||
|
RSInvalidMonth = 'Invalid month';
|
||||||
|
RSInvalidMonthName = 'Invalid month name';
|
||||||
|
RSInvalidYear = 'Invalid year';
|
||||||
|
RSDayRequired = 'Day is required';
|
||||||
|
RSMonthRequired = 'Month is required';
|
||||||
|
RSYearRequired = 'Year is required';
|
||||||
|
RSOwnerMustBeForm = 'Owner must be a TForm or descendant';
|
||||||
|
RSTimeConvertError = 'Error converting time value';
|
||||||
|
RSCancelQuery = 'Cancel and lose changes?';
|
||||||
|
RSNoPagesAssigned = 'No notebook pages assigned';
|
||||||
|
RSRestoreMI = '&Restore';
|
||||||
|
RSCutMI = 'Cu&t';
|
||||||
|
RSCopyMI = '&Copy';
|
||||||
|
RSPasteMI = '&Paste';
|
||||||
|
RSDeleteMI = '&Delete';
|
||||||
|
RSSelectAllMI = 'Select &All';
|
||||||
|
RSTableRowOutOfBounds = 'Table row out of bounds';
|
||||||
|
RSTableMaxRows = 'Table max rows error';
|
||||||
|
RSTableMaxColumns = 'Table max columns error';
|
||||||
|
RSTableGeneral = 'Table general error';
|
||||||
|
RSTableToManyColumns = 'Too many columns';
|
||||||
|
RSTableInvalidFieldIndex = 'Invalid field index';
|
||||||
|
RSTableHeaderNotAssigned = 'Header not assigned';
|
||||||
|
RSTableInvalidHeaderCell = 'Invalid header cell';
|
||||||
|
RSCalcBack = 'Back';
|
||||||
|
RSCalcMC = 'MC';
|
||||||
|
RSCalcMR = 'MR';
|
||||||
|
RSCalcMS = 'MS';
|
||||||
|
RSCalcMPlus = 'M+';
|
||||||
|
RSCalcMMinus = 'M-';
|
||||||
|
RSCalcCT = 'CT';
|
||||||
|
RSCalcCE = 'CE';
|
||||||
|
RSCalcC = 'C';
|
||||||
|
RSCalcSqrt = 'Sqrt';
|
||||||
|
RSCalNext = 'NEXT';
|
||||||
|
RSCalLast = 'LAST';
|
||||||
|
RSCalPrev = 'PREV';
|
||||||
|
RSCalFirst = 'FIRST';
|
||||||
|
RSCal1st = '1ST';
|
||||||
|
RSCalSecond = 'SECOND';
|
||||||
|
RSCal2nd = '2ND';
|
||||||
|
RSCalThird = 'THIRD';
|
||||||
|
RSCal3rd = '3RD';
|
||||||
|
RSCalFourth = 'FOURTH';
|
||||||
|
RSCal4th = '4TH';
|
||||||
|
RSCalFinal = 'FINAL';
|
||||||
|
RSCalBOM = 'BOM';
|
||||||
|
RSCalBegin = 'BEGIN';
|
||||||
|
RSCalEOM = 'EOM';
|
||||||
|
RSCalEnd = 'END';
|
||||||
|
RSCalYesterday = 'YESTERDAY';
|
||||||
|
RSCalToday = 'TODAY';
|
||||||
|
RSCalTomorrow = 'TOMORROW';
|
||||||
|
RSEditingSections = 'Header Sections Editor';
|
||||||
|
RSEditingItems = 'Folder Items Editor';
|
||||||
|
RSEditingFolders = 'Folder Editor';
|
||||||
|
RSEditingPages = 'Tab Pages Editor';
|
||||||
|
RSEditingImages = 'Image List Editor';
|
||||||
|
RSSectionBaseName = 'Section';
|
||||||
|
RSItemBaseName = 'Item';
|
||||||
|
RSFolderBaseName = 'Folder';
|
||||||
|
RSPageBaseName = 'Page';
|
||||||
|
RSImageBaseName = 'Image';
|
||||||
|
RSHoursName = 'Hours';
|
||||||
|
RSMinutesName = 'Minutes';
|
||||||
|
RSSecondsName = 'Seconds';
|
||||||
|
RSCloseCaption = 'Close';
|
||||||
|
RSViewFieldNotFound = 'The view field %s was not found';
|
||||||
|
RSCantResolveField = 'Unable to resolve view field %s';
|
||||||
|
RSItemAlreadyExists = 'Can''t add item %p - it already exists in the index';
|
||||||
|
RSAlreadyInTempMode = 'The view is already in temporary index mode';
|
||||||
|
RSItemNotFound = 'Specified report view data item %p was not found';
|
||||||
|
RSUpdatePending = 'This report view operation is invalid while updates are pending';
|
||||||
|
RSOnCompareNotAssigned = 'OnCompareFields not assigned';
|
||||||
|
RSOnFilterNotAssigned = 'OnFilter not assigned';
|
||||||
|
RSGetAsFloatNotAssigned = 'GetAsFloat not assigned';
|
||||||
|
RSNotInTempMode = 'Report view is not in temporary index mode';
|
||||||
|
RSItemNotInIndex = 'The specified data item (%p) is not in the index';
|
||||||
|
RSNoActiveView = 'No active view';
|
||||||
|
RSItemIsNotGroup = 'Item at line %d is not a group';
|
||||||
|
RSNotMultiSelect = 'This report view operation is only allowed when multiselect is enabled';
|
||||||
|
RSLineNoOutOfRange = 'Invalid index %d';
|
||||||
|
RSUnknownView = 'Unknown view: %s';
|
||||||
|
RSOnKeySearchNotAssigned = 'The OnKeySearch event is not assigned';
|
||||||
|
RSOnEnumNotAssigned = 'The OnEnum event is not assigned';
|
||||||
|
RSOnEnumSelectedNA = 'OnEnumSelected not assigned';
|
||||||
|
RSNoMenuAssigned = 'No menu item assigned';
|
||||||
|
RSNoAnchorAssigned = 'No anchor item assigned';
|
||||||
|
RSInvalidParameter = 'Invalid parameter: mpAnchor';
|
||||||
|
RSInvalidOperation = 'Invalid operation: Call AddSplit for split menus';
|
||||||
|
RSFormUseOnly = 'This component can only be used on forms';
|
||||||
|
RSColorBlack = 'Black';
|
||||||
|
RSColorMaroon = 'Maroon';
|
||||||
|
RSColorGreen = 'Green';
|
||||||
|
RSColorOlive = 'Olive';
|
||||||
|
RSColorNavy = 'Navy';
|
||||||
|
RSColorPurple = 'Purple';
|
||||||
|
RSColorTeal = 'Teal';
|
||||||
|
RSColorGray = 'Gray';
|
||||||
|
RSColorSilver = 'Silver';
|
||||||
|
RSColorRed = 'Red';
|
||||||
|
RSColorLime = 'Lime';
|
||||||
|
RSColorYellow = 'Yellow';
|
||||||
|
RSColorBlue = 'Blue';
|
||||||
|
RSColorFuchsia = 'Fuchsia';
|
||||||
|
RSColorAqua = 'Aqua';
|
||||||
|
RSColorWhite = 'White';
|
||||||
|
RSColorLightGray = 'Light Gray';
|
||||||
|
RSColorMediumGray = 'Medium Gray';
|
||||||
|
RSColorDarkGray = 'Dark Gray';
|
||||||
|
RSColorMoneyGreen = 'Money Green';
|
||||||
|
RSColorSkyBlue = 'Sky Blue';
|
||||||
|
RSColorCream = 'Cream';
|
||||||
|
|
||||||
|
{end - Index based resource strings}
|
||||||
|
|
||||||
|
|
||||||
661
components/orpheus/o32sr.pas
Normal file
661
components/orpheus/o32sr.pas
Normal file
@ -0,0 +1,661 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32SR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
(* Replaces the old String Resource Manager from Orpheus versions 3.x and
|
||||||
|
below. The string resource is broken into 3 parts.
|
||||||
|
Part 1: The actual string resources contained in O32***RS.inc
|
||||||
|
(O32ENGRS.inc for English). (Translate these strings and define the
|
||||||
|
language below to create new language versions of Orpheus.)
|
||||||
|
Part 2: The index constants defined in OvcConst.pas.
|
||||||
|
Part 3: The cross reference array (SrMsgNumLookup) used to convert an
|
||||||
|
index into the corresponding string.
|
||||||
|
It is very important that the cross reference array be kept in numerical
|
||||||
|
order. The lookup is performed by a binary search and if any of the items
|
||||||
|
are out of order, the lookup will fail some or all strings. *)
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32sr;
|
||||||
|
{- Orpheus String Resources
|
||||||
|
Replaces the String Resource Manager from the olden days...}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ovcconst;
|
||||||
|
|
||||||
|
{$I O32SR.inc}
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
|
||||||
|
{Orpheus Internal and Design-time resource strings...}
|
||||||
|
|
||||||
|
{!!!! - These should not be translated as they are used internally - !!!!}
|
||||||
|
{!!!! - See O32SR.INC for the user visible resource strings - !!!!}
|
||||||
|
|
||||||
|
{Navigation Commands}
|
||||||
|
ccNoneStr = 'ccNone';
|
||||||
|
ccBackStr = 'ccBack';
|
||||||
|
ccBotOfPageStr = 'ccBotOfPage';
|
||||||
|
ccBotRightCellStr = 'ccBotRightCell';
|
||||||
|
ccCompleteDateStr = 'ccCompleteDate';
|
||||||
|
ccCompleteTimeStr = 'ccCompleteTime';
|
||||||
|
ccCopyStr = 'ccCopy';
|
||||||
|
ccCtrlCharStr = 'ccCtrlChar';
|
||||||
|
ccCutStr = 'ccCut';
|
||||||
|
ccDecStr = 'ccDec';
|
||||||
|
ccDelStr = 'ccDel';
|
||||||
|
ccDelBolStr = 'ccDelBol';
|
||||||
|
ccDelEolStr = 'ccDelEol';
|
||||||
|
ccDelLineStr = 'ccDelLine';
|
||||||
|
ccDelWordStr = 'ccDelWord';
|
||||||
|
ccDownStr = 'ccDown';
|
||||||
|
ccEndStr = 'ccEnd';
|
||||||
|
ccExtendDownStr = 'ccExtendDown';
|
||||||
|
ccExtendEndStr = 'ccExtendEnd';
|
||||||
|
ccExtendHomeStr = 'ccExtendHome';
|
||||||
|
ccExtendLeftStr = 'ccExtendLeft';
|
||||||
|
ccExtendPgDnStr = 'ccExtendPgDn';
|
||||||
|
ccExtendPgUpStr = 'ccExtendPgUp';
|
||||||
|
ccExtendRightStr = 'ccExtendRight';
|
||||||
|
ccExtendUpStr = 'ccExtendUp';
|
||||||
|
ccExtBotOfPageStr = 'ccExtBotOfPage';
|
||||||
|
ccExtFirstPageStr = 'ccExtFirstPage';
|
||||||
|
ccExtLastPageStr = 'ccExtLastPage';
|
||||||
|
ccExtTopOfPageStr = 'ccExtTopOfPage';
|
||||||
|
ccExtWordLeftStr = 'ccExtWordLeft';
|
||||||
|
ccExtWordRightStr = 'ccExtWordRight';
|
||||||
|
ccFirstPageStr = 'ccFirstPage';
|
||||||
|
ccGotoMarker0Str = 'ccGotoMarker0';
|
||||||
|
ccGotoMarker1Str = 'ccGotoMarker1';
|
||||||
|
ccGotoMarker2Str = 'ccGotoMarker2';
|
||||||
|
ccGotoMarker3Str = 'ccGotoMarker3';
|
||||||
|
ccGotoMarker4Str = 'ccGotoMarker4';
|
||||||
|
ccGotoMarker5Str = 'ccGotoMarker5';
|
||||||
|
ccGotoMarker6Str = 'ccGotoMarker6';
|
||||||
|
ccGotoMarker7Str = 'ccGotoMarker7';
|
||||||
|
ccGotoMarker8Str = 'ccGotoMarker8';
|
||||||
|
ccGotoMarker9Str = 'ccGotoMarker9';
|
||||||
|
ccHomeStr = 'ccHome';
|
||||||
|
ccIncStr = 'ccInc';
|
||||||
|
ccInsStr = 'ccIns';
|
||||||
|
ccLastPageStr = 'ccLastPage';
|
||||||
|
ccLeftStr = 'ccLeft';
|
||||||
|
ccNewLineStr = 'ccNewLine';
|
||||||
|
ccNextPageStr = 'ccNextPage';
|
||||||
|
ccPageLeftStr = 'ccPageLeft';
|
||||||
|
ccPageRightStr = 'ccPageRight';
|
||||||
|
ccPasteStr = 'ccPaste';
|
||||||
|
ccPrevPageStr = 'ccPrevPage';
|
||||||
|
ccRedoStr = 'ccRedo';
|
||||||
|
ccRestoreStr = 'ccRestore';
|
||||||
|
ccRightStr = 'ccRight';
|
||||||
|
ccScrollDownStr = 'ccScrollDown';
|
||||||
|
ccScrollUpStr = 'ccScrollUp';
|
||||||
|
ccSetMarker0Str = 'ccSetMarker0';
|
||||||
|
ccSetMarker1Str = 'ccSetMarker1';
|
||||||
|
ccSetMarker2Str = 'ccSetMarker2';
|
||||||
|
ccSetMarker3Str = 'ccSetMarker3';
|
||||||
|
ccSetMarker4Str = 'ccSetMarker4';
|
||||||
|
ccSetMarker5Str = 'ccSetMarker5';
|
||||||
|
ccSetMarker6Str = 'ccSetMarker6';
|
||||||
|
ccSetMarker7Str = 'ccSetMarker7';
|
||||||
|
ccSetMarker8Str = 'ccSetMarker8';
|
||||||
|
ccSetMarker9Str = 'ccSetMarker9';
|
||||||
|
ccTabStr = 'ccTab';
|
||||||
|
ccTableEditStr = 'ccTableEdit';
|
||||||
|
ccTopLeftCellStr = 'ccTopLeftCell';
|
||||||
|
ccTopOfPageStr = 'ccTopOfPage';
|
||||||
|
ccUndoStr = 'ccUndo';
|
||||||
|
ccUpStr = 'ccUp';
|
||||||
|
ccWordLeftStr = 'ccWordLeft';
|
||||||
|
ccWordRightStr = 'ccWordRight';
|
||||||
|
|
||||||
|
{DataType strings}
|
||||||
|
StringStr = 'String';
|
||||||
|
CharStr = 'Char';
|
||||||
|
BooleanStr = 'Boolean';
|
||||||
|
YesNoStr = 'YesNo';
|
||||||
|
LongIntStr = 'LongInt';
|
||||||
|
WordStr = 'Word';
|
||||||
|
SmallIntStr = 'SmallInt';
|
||||||
|
ByteStr = 'Byte';
|
||||||
|
ShortIntStr = 'ShortInt';
|
||||||
|
RealStr = 'Real';
|
||||||
|
ExtendedStr = 'Extended';
|
||||||
|
DoubleStr = 'Double';
|
||||||
|
SingleStr = 'Single';
|
||||||
|
CompStr = 'Comp';
|
||||||
|
DateStr = 'Date';
|
||||||
|
TimeStr = 'Time';
|
||||||
|
|
||||||
|
{Sample masks for the EditField's property editors}
|
||||||
|
CharMask1Str = 'X any character';
|
||||||
|
CharMask2Str = '! any char (upper)';
|
||||||
|
CharMask3Str = 'L any char (lower)';
|
||||||
|
CharMask4Str = 'x any char (mixed)';
|
||||||
|
CharMask5Str = 'a alphas only';
|
||||||
|
CharMask6Str = 'A alphas (upper)';
|
||||||
|
CharMask7Str = 'l alphas (lower)';
|
||||||
|
CharMask8Str = '9 0-9';
|
||||||
|
CharMask9Str = 'i 0-9, -';
|
||||||
|
CharMask10Str = '# 0-9, -, .';
|
||||||
|
CharMask11Str = 'E 0-9, E, -, .';
|
||||||
|
CharMask12Str = 'K 0-9, A-F (hex)';
|
||||||
|
CharMask14Str = 'O 0-7 (octal)';
|
||||||
|
CharMask15Str = 'b 0, 1 (binary)';
|
||||||
|
CharMask16Str = 'B T or F (upper)';
|
||||||
|
CharMask17Str = 'Y Y or N (upper)';
|
||||||
|
CharMask18Str = '1 User 1';
|
||||||
|
CharMask19Str = '2 User 2';
|
||||||
|
CharMask20Str = '3 User 3';
|
||||||
|
CharMask21Str = '4 User 4';
|
||||||
|
CharMask22Str = '5 User 5';
|
||||||
|
CharMask23Str = '6 User 6';
|
||||||
|
CharMask24Str = '7 User 7';
|
||||||
|
CharMask25Str = '8 User 8';
|
||||||
|
|
||||||
|
FieldMask1Str = '$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol';
|
||||||
|
FieldMask2Str = '9999999999 Allows entry of 0 through 9, and space';
|
||||||
|
FieldMask3Str = 'iiiiiiiiii Allows entry of 0 through 9, space, and minus';
|
||||||
|
FieldMask4Str = 'ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed';
|
||||||
|
FieldMask5Str = '$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol';
|
||||||
|
FieldMask6Str = '########## Allows entry of 0 through 9, space, minus, and period';
|
||||||
|
FieldMask7Str = '#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position';
|
||||||
|
FieldMask8Str = '###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed';
|
||||||
|
FieldMask9Str = '$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol';
|
||||||
|
FieldMask10Str = '##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()';
|
||||||
|
FieldMask11Str = '###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right';
|
||||||
|
FieldMask12Str = 'KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case';
|
||||||
|
FieldMask13Str = 'KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case';
|
||||||
|
FieldMask14Str = 'KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case';
|
||||||
|
FieldMask15Str = 'OOOOOOOO Octal (45135677) Allows entry of 0 through 7 ';
|
||||||
|
FieldMask16Str = 'OOOO Octal (5677) Allows entry of 0 through 7 ';
|
||||||
|
FieldMask17Str = 'bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1';
|
||||||
|
FieldMask18Str = 'bbbbbbbb Binary (10010100) Allows entry of 0 and 1';
|
||||||
|
FieldMask19Str = 'XXXXXXXXXX Any character can be entered';
|
||||||
|
FieldMask20Str = '!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case';
|
||||||
|
FieldMask21Str = 'LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case';
|
||||||
|
FieldMask22Str = 'xxxxxxxxxx Any character can be entered Uses mixed case';
|
||||||
|
FieldMask23Str = 'aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma';
|
||||||
|
FieldMask24Str = 'AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case';
|
||||||
|
FieldMask25Str = 'llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case';
|
||||||
|
FieldMask26Str = '(999) 999-9999 Phone number mask Allows 0 through 9 and space';
|
||||||
|
FieldMask27Str = '999-999-9999 Phone number mask Allows 0 through 9 and space';
|
||||||
|
FieldMask28Str = '99999-9999 US Zip Code mask Allows 0 through 9 and space';
|
||||||
|
FieldMask29Str = 'B Boolean mask Allows T, t, F, f Forces input to upper case';
|
||||||
|
FieldMask30Str = 'Y Boolean mask Allows Y, y, N, n Forces input to upper case';
|
||||||
|
FieldMask31Str = 'mm/dd/yy Date mask (01/05/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
|
||||||
|
FieldMask32Str = 'mm/dd/yyyy Date mask (01/05/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
|
||||||
|
FieldMask33Str = 'dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros';
|
||||||
|
FieldMask34Str = 'MM/DD/yy Date mask ( 1/ 5/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
|
||||||
|
FieldMask35Str = 'MM/DD/yyyy Date mask ( 1/ 5/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
|
||||||
|
FieldMask36Str = 'DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces';
|
||||||
|
FieldMask37Str = 'hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)';
|
||||||
|
FieldMask38Str = 'hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros';
|
||||||
|
FieldMask39Str = 'hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros';
|
||||||
|
FieldMask40Str = 'HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)';
|
||||||
|
FieldMask41Str = 'HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces';
|
||||||
|
FieldMask42Str = 'HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces';
|
||||||
|
|
||||||
|
const
|
||||||
|
{Change this when new strings are added.}
|
||||||
|
SrMaxMessages = 375;
|
||||||
|
|
||||||
|
type
|
||||||
|
SrMsgNumLookupRec = record
|
||||||
|
MessageNum : integer;
|
||||||
|
MessageStr : string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
{Matches the index numbers to their associated Strings}
|
||||||
|
|
||||||
|
{WARNING! When adding to or deleting from this array, make sure you keep the
|
||||||
|
items in ascending numerical order by the value of the MessageNum constants.
|
||||||
|
Otherwise, the Lookup will fail some or all strings...}
|
||||||
|
|
||||||
|
SrMsgNumLookup : array [1..SrMaxMessages] of SrMsgNumLookupRec =
|
||||||
|
{External Resource String Mapping. External resource strings are contained in
|
||||||
|
O32SR.INC...}
|
||||||
|
((MessageNum : SCUnknownError; MessageStr : RSUnknownError),
|
||||||
|
(MessageNum : SCDuplicateCommand; MessageStr : RSDuplicateCommand),
|
||||||
|
(MessageNum : SCTableNotFound; MessageStr : RSTableNotFound),
|
||||||
|
(MessageNum : SCNotDoneYet; MessageStr : RSNotDoneYet),
|
||||||
|
(MessageNum : SCNoControllerAssigned; MessageStr : RSNoControllerAssigned),
|
||||||
|
(MessageNum : SCCantCreateCommandTable; MessageStr : RSCantCreateCommandTable),
|
||||||
|
(MessageNum : SCCantDelete; MessageStr : RSCantDelete),
|
||||||
|
(MessageNum : SCInvalidKeySequence; MessageStr : RSInvalidKeySequence),
|
||||||
|
(MessageNum : SCNotWordStarCommands; MessageStr : RSNotWordStarCommands),
|
||||||
|
(MessageNum : SCNoCommandSelected; MessageStr : RSNoCommandSelected),
|
||||||
|
(MessageNum : SCDuplicateKeySequence; MessageStr : RSDuplicateKeySequence),
|
||||||
|
(MessageNum : SCRangeError; MessageStr : RSRangeError),
|
||||||
|
(MessageNum : SCInvalidNumber; MessageStr : RSInvalidNumber),
|
||||||
|
(MessageNum : SCRequiredField; MessageStr : RSRequiredField),
|
||||||
|
(MessageNum : SCInvalidDate; MessageStr : RSInvalidDate),
|
||||||
|
(MessageNum : SCInvalidTime; MessageStr : RSInvalidTime),
|
||||||
|
(MessageNum : SCBlanksInField; MessageStr : RSBlanksInField),
|
||||||
|
(MessageNum : SCPartialEntry; MessageStr : RSPartialEntry),
|
||||||
|
(MessageNum : SCRegionTooLarge; MessageStr : RSRegionTooLarge),
|
||||||
|
(MessageNum : SCOutOfMemoryForCopy; MessageStr : RSOutOfMemoryForCopy),
|
||||||
|
(MessageNum : SCInvalidParamValue; MessageStr : RSInvalidParamValue),
|
||||||
|
(MessageNum : SCNoTimersAvail; MessageStr : RSNoTimersAvail),
|
||||||
|
(MessageNum : SCTooManyEvents; MessageStr : RSTooManyEvents),
|
||||||
|
(MessageNum : SCBadTriggerHandle; MessageStr : RSBadTriggerHandle),
|
||||||
|
(MessageNum : SCOnSelectNotAssigned; MessageStr : RSOnSelectNotAssigned),
|
||||||
|
(MessageNum : SCInvalidPageIndex; MessageStr : RSInvalidPageIndex),
|
||||||
|
(MessageNum : SCInvalidDataType; MessageStr : RSInvalidDataType),
|
||||||
|
(MessageNum : SCInvalidTabFont; MessageStr : RSInvalidTabFont),
|
||||||
|
(MessageNum : SCInvalidLabelFont; MessageStr : RSInvalidLabelFont),
|
||||||
|
(MessageNum : SCOutOfMemory; MessageStr : RSOutOfMemory),
|
||||||
|
(MessageNum : SCTooManyParas; MessageStr : RSTooManyParas),
|
||||||
|
(MessageNum : SCCannotJoin; MessageStr : RSCannotJoin),
|
||||||
|
(MessageNum : SCTooManyBytes; MessageStr : RSTooManyBytes),
|
||||||
|
(MessageNum : SCParaTooLong; MessageStr : RSParaTooLong),
|
||||||
|
(MessageNum : SCInvalidPictureMask; MessageStr : RSInvalidPictureMask),
|
||||||
|
(MessageNum : SCInvalidRange; MessageStr : RSInvalidRange),
|
||||||
|
(MessageNum : SCInvalidRealRange; MessageStr : RSInvalidRealRange),
|
||||||
|
(MessageNum : SCInvalidExtendedRange; MessageStr : RSInvalidExtendedRange),
|
||||||
|
(MessageNum : SCInvalidDoubleRange; MessageStr : RSInvalidDoubleRange),
|
||||||
|
(MessageNum : SCInvalidSingleRange; MessageStr : RSInvalidSingleRange),
|
||||||
|
(MessageNum : SCInvalidCompRange; MessageStr : RSInvalidCompRange),
|
||||||
|
(MessageNum : SCInvalidDateRange; MessageStr : RSInvalidDateRange),
|
||||||
|
(MessageNum : SCInvalidTimeRange; MessageStr : RSInvalidTimeRange),
|
||||||
|
(MessageNum : SCInvalidRangeValue; MessageStr : RSInvalidRangeValue),
|
||||||
|
(MessageNum : SCRangeNotSupported; MessageStr : RSRangeNotSupported),
|
||||||
|
(MessageNum : SCInvalidLineOrParaIndex; MessageStr : RSInvalidLineOrParaIndex),
|
||||||
|
(MessageNum : SCNonFixedFont; MessageStr : RSNonFixedFont),
|
||||||
|
(MessageNum : SCInvalidFontParam; MessageStr : RSInvalidFontParam),
|
||||||
|
(MessageNum : SCInvalidLineOrColumn; MessageStr : RSInvalidLineOrColumn),
|
||||||
|
(MessageNum : SCSAEGeneral; MessageStr : RSSAEGeneral),
|
||||||
|
(MessageNum : SCSAEAtMaxSize; MessageStr : RSSAEAtMaxSize),
|
||||||
|
(MessageNum : SCInvalidXMLFile; MessageStr : RSInvalidXMLFile),
|
||||||
|
(MessageNum : SCUnterminatedElement; MessageStr : RSUnterminatedElement),
|
||||||
|
(MessageNum : SCBadColorConst; MessageStr : RSBadColorConstant),
|
||||||
|
(MessageNum : SCBadColorValue; MessageStr : RSBadColorValue),
|
||||||
|
(MessageNum : SCSAEOutOfBounds; MessageStr : RSSAEOutOfBounds),
|
||||||
|
(MessageNum : SCInvalidFieldType; MessageStr : RSInvalidFieldType),
|
||||||
|
(MessageNum : SCBadAlarmHandle; MessageStr : RSBadAlarmHandle),
|
||||||
|
(MessageNum : SCOnIsSelectedNotAssigned; MessageStr : RSOnIsSelectedNotAssigned),
|
||||||
|
(MessageNum : SCInvalidDateForMask; MessageStr : RSInvalidDateForMask),
|
||||||
|
(MessageNum : SCNoTableAttached; MessageStr : RSNoTableAttached),
|
||||||
|
(MessageNum : SCViewerIOError; MessageStr : RSViewerIOError),
|
||||||
|
(MessageNum : SCViewerFileNotFound; MessageStr : RSViewerFileNotFound),
|
||||||
|
(MessageNum : SCViewerPathNotFound; MessageStr : RSViewerPathNotFound),
|
||||||
|
(MessageNum : SCViewerTooManyOpenFiles; MessageStr : RSViewerTooManyOpenFiles),
|
||||||
|
(MessageNum : SCViewerFileAccessDenied; MessageStr : RSViewerFileAccessDenied),
|
||||||
|
(MessageNum : SCControlAttached; MessageStr : RSControlAttached),
|
||||||
|
(MessageNum : SCCantEdit; MessageStr : RSCantEdit),
|
||||||
|
(MessageNum : SCChildTableError; MessageStr : RSChildTableError),
|
||||||
|
(MessageNum : SCNoCollection; MessageStr : RSNoCollection),
|
||||||
|
(MessageNum : SCNotOvcDescendant; MessageStr : RSNotOvcDescendant),
|
||||||
|
(MessageNum : SCItemIncompatible; MessageStr : RSItemIncompatible),
|
||||||
|
(MessageNum : SCLabelNotAttached; MessageStr : RSLabelNotAttached),
|
||||||
|
(MessageNum : SCClassNotSet; MessageStr : RSClassNotSet),
|
||||||
|
(MessageNum : SCCollectionNotFound; MessageStr : RSCollectionNotFound),
|
||||||
|
(MessageNum : SCDayConvertError; MessageStr : RSDayConvertError),
|
||||||
|
(MessageNum : SCMonthConvertError; MessageStr : RSMonthConvertError),
|
||||||
|
(MessageNum : SCMonthNameConvertError; MessageStr : RSMonthNameConvertError),
|
||||||
|
(MessageNum : SCYearConvertError; MessageStr : RSYearConvertError),
|
||||||
|
(MessageNum : SCDayRequired; MessageStr : RSDayRequired),
|
||||||
|
(MessageNum : SCMonthRequired; MessageStr : RSMonthRequired),
|
||||||
|
(MessageNum : SCYearRequired; MessageStr : RSYearRequired),
|
||||||
|
(MessageNum : SCInvalidDay; MessageStr : RSInvalidDay),
|
||||||
|
(MessageNum : SCInvalidMonth; MessageStr : RSInvalidMonth),
|
||||||
|
(MessageNum : SCInvalidMonthName; MessageStr : RSInvalidMonthName),
|
||||||
|
(MessageNum : SCInvalidYear; MessageStr : RSInvalidYear),
|
||||||
|
(MessageNum : SCTableRowOutOfBounds; MessageStr : RSTableRowOutOfBounds),
|
||||||
|
(MessageNum : SCTableMaxRows; MessageStr : RSTableMaxRows),
|
||||||
|
(MessageNum : SCTableMaxColumns; MessageStr : RSTableMaxColumns),
|
||||||
|
(MessageNum : SCTableGeneral; MessageStr : RSTableGeneral),
|
||||||
|
(MessageNum : SCTableToManyColumns; MessageStr : RSTableToManyColumns),
|
||||||
|
(MessageNum : SCTableInvalidFieldIndex; MessageStr : RSTableInvalidFieldIndex),
|
||||||
|
(MessageNum : SCTableHeaderNotAssigned; MessageStr : RSTableHeaderNotAssigned),
|
||||||
|
(MessageNum : SCTableInvalidHeaderCell; MessageStr : RSTableInvalidHeaderCell),
|
||||||
|
(MessageNum : SCGridTableName; MessageStr : RSGridTableName),
|
||||||
|
(MessageNum : SCNoneStr; MessageStr : RSNoneStr),
|
||||||
|
(MessageNum : SCccUser; MessageStr : RSccUser),
|
||||||
|
(MessageNum : SCccUserNum; MessageStr : RSccUserNum),
|
||||||
|
(MessageNum : SCDeleteTable; MessageStr : RSDeleteTable),
|
||||||
|
(MessageNum : SCRenameTable; MessageStr : RSRenameTable),
|
||||||
|
(MessageNum : SCEnterTableName; MessageStr : RSEnterTableName),
|
||||||
|
(MessageNum : SCNewTable; MessageStr : RSNewTable),
|
||||||
|
(MessageNum : SCDefaultTableName; MessageStr : RSDefaultTableName),
|
||||||
|
(MessageNum : SCWordStarTableName; MessageStr : RSWordStarTableName ),
|
||||||
|
(MessageNum : SCUnknownTable; MessageStr : RSUnknownTable),
|
||||||
|
(MessageNum : SCDefaultEntryErrorText; MessageStr : RSDefaultEntryErrorText),
|
||||||
|
(MessageNum : SCGotItemWarning; MessageStr : RSGotItemWarning),
|
||||||
|
(MessageNum : SCSampleListItem; MessageStr : RSSampleListItem),
|
||||||
|
(MessageNum : SCAlphaString; MessageStr : RSAlphaString),
|
||||||
|
(MessageNum : SCTallLowChars; MessageStr : RSTallLowChars),
|
||||||
|
(MessageNum : SCDefault; MessageStr : RSDefault),
|
||||||
|
(MessageNum : SCDescending; MessageStr : RSDescending),
|
||||||
|
(MessageNum : SCDefaultIndex; MessageStr : RSDefaultIndex),
|
||||||
|
(MessageNum : SCRestoreMI; MessageStr : RSRestoreMI),
|
||||||
|
(MessageNum : SCCutMI; MessageStr : RSCutMI),
|
||||||
|
(MessageNum : SCCopyMI; MessageStr : RSCopyMI),
|
||||||
|
(MessageNum : SCPasteMI; MessageStr : RSPasteMI),
|
||||||
|
(MessageNum : SCDeleteMI; MessageStr : RSDeleteMI),
|
||||||
|
(MessageNum : SCSelectAllMI; MessageStr : RSSelectAllMI),
|
||||||
|
(MessageNum : SCCalcBack; MessageStr : RSCalcBack),
|
||||||
|
(MessageNum : SCCalcMC; MessageStr : RSCalcMC),
|
||||||
|
(MessageNum : SCCalcMR; MessageStr : RSCalcMR),
|
||||||
|
(MessageNum : SCCalcMS; MessageStr : RSCalcMS),
|
||||||
|
(MessageNum : SCCalcMPlus; MessageStr : RSCalcMPlus),
|
||||||
|
(MessageNum : SCCalcMMinus; MessageStr : RSCalcMMinus),
|
||||||
|
(MessageNum : SCCalcCT; MessageStr : RSCalcCT),
|
||||||
|
(MessageNum : SCCalcCE; MessageStr : RSCalcCE),
|
||||||
|
(MessageNum : SCCalcC; MessageStr : RSCalcC),
|
||||||
|
(MessageNum : SCCalcSqrt; MessageStr : RSCalcSqrt),
|
||||||
|
(MessageNum : SCCalNext; MessageStr : RSCalNext),
|
||||||
|
(MessageNum : SCCalLast; MessageStr : RSCalLast),
|
||||||
|
(MessageNum : SCCalFirst; MessageStr : RSCalFirst),
|
||||||
|
(MessageNum : SCCal1st; MessageStr : RSCal1st),
|
||||||
|
(MessageNum : SCCalSecond; MessageStr : RSCalSecond),
|
||||||
|
(MessageNum : SCCal2nd; MessageStr : RSCal2nd),
|
||||||
|
(MessageNum : SCCalThird; MessageStr : RSCalThird),
|
||||||
|
(MessageNum : SCCal3rd; MessageStr : RSCal3rd),
|
||||||
|
(MessageNum : SCCalFourth; MessageStr : RSCalFourth),
|
||||||
|
(MessageNum : SCCal4th; MessageStr : RSCal4th),
|
||||||
|
(MessageNum : SCCalFinal; MessageStr : RSCalFinal),
|
||||||
|
(MessageNum : SCCalBOM; MessageStr : RSCalBOM),
|
||||||
|
(MessageNum : SCCalEnd; MessageStr : RSCalEnd),
|
||||||
|
(MessageNum : SCCalEOM; MessageStr : RSCalEOM),
|
||||||
|
(MessageNum : SCCalYesterday; MessageStr : RSCalYesterday),
|
||||||
|
(MessageNum : SCCalToday; MessageStr : RSCalToday),
|
||||||
|
(MessageNum : SCCalTomorrow; MessageStr : RSCalTomorrow),
|
||||||
|
(MessageNum : SCEditingSections; MessageStr : RSEditingSections),
|
||||||
|
(MessageNum : SCEditingItems; MessageStr : RSEditingItems),
|
||||||
|
(MessageNum : SCEditingFolders; MessageStr : RSEditingFolders),
|
||||||
|
(MessageNum : SCEditingPages; MessageStr : RSEditingPages),
|
||||||
|
(MessageNum : SCEditingImages; MessageStr : RSEditingImages),
|
||||||
|
(MessageNum : SCSectionBaseName; MessageStr : RSSectionBaseName),
|
||||||
|
(MessageNum : SCItemBaseName; MessageStr : RSItemBaseName),
|
||||||
|
(MessageNum : SCFolderBaseName; MessageStr : RSFolderBaseName),
|
||||||
|
(MessageNum : SCPageBaseName; MessageStr : RSPageBaseName),
|
||||||
|
(MessageNum : SCImageBaseName; MessageStr : RSImageBaseName),
|
||||||
|
(MessageNum : SCOwnerMustBeForm; MessageStr : RSOwnerMustBeForm),
|
||||||
|
(MessageNum : SCTimeConvertError; MessageStr : RSTimeConvertError),
|
||||||
|
(MessageNum : SCCancelQuery; MessageStr : RSCancelQuery),
|
||||||
|
(MessageNum : SCNoPagesAssigned; MessageStr : RSNoPagesAssigned),
|
||||||
|
(MessageNum : SCCalPrev; MessageStr : RSCalPrev),
|
||||||
|
(MessageNum : SCCalBegin; MessageStr : RSCalBegin),
|
||||||
|
(MessageNum : SCInvalidMinMaxValue; MessageStr : RSInvalidMinMaxValue),
|
||||||
|
(MessageNum : SCFormUseOnly; MessageStr : RSFormUseOnly),
|
||||||
|
(MessageNum : SCYes; MessageStr : RSYes),
|
||||||
|
(MessageNum : SCNo; MessageStr : RSNo),
|
||||||
|
(MessageNum : SCTrue; MessageStr : RSTrue),
|
||||||
|
(MessageNum : SCFalse; MessageStr : RSFalse),
|
||||||
|
(MessageNum : SCHoursName; MessageStr : RSHoursName),
|
||||||
|
(MessageNum : SCMinutesName; MessageStr : RSMinutesName),
|
||||||
|
(MessageNum : SCSecondsName; MessageStr : RSSecondsName),
|
||||||
|
(MessageNum : SCCloseCaption; MessageStr : RSCloseCaption),
|
||||||
|
(MessageNum : SCViewFieldNotFound; MessageStr : RSViewFieldNotFound),
|
||||||
|
(MessageNum : SCCantResolveField; MessageStr : RSCantResolveField),
|
||||||
|
(MessageNum : SCItemAlreadyExists; MessageStr : RSItemAlreadyExists),
|
||||||
|
(MessageNum : SCAlreadyInTempMode; MessageStr : RSAlreadyInTempMode),
|
||||||
|
(MessageNum : SCItemNotFound; MessageStr : RSItemNotFound),
|
||||||
|
(MessageNum : SCUpdatePending; MessageStr : RSUpdatePending),
|
||||||
|
(MessageNum : SCOnCompareNotAssigned; MessageStr : RSOnCompareNotAssigned),
|
||||||
|
(MessageNum : SCOnFilterNotAssigned; MessageStr : RSOnFilterNotAssigned),
|
||||||
|
(MessageNum : SCGetAsFloatNotAssigned; MessageStr : RSGetAsFloatNotAssigned),
|
||||||
|
(MessageNum : SCNotInTempMode; MessageStr : RSNotInTempMode),
|
||||||
|
(MessageNum : SCItemNotInIndex; MessageStr : RSItemNotInIndex),
|
||||||
|
(MessageNum : SCNoActiveView; MessageStr : RSNoActiveView),
|
||||||
|
(MessageNum : SCItemIsNotGroup; MessageStr : RSItemIsNotGroup),
|
||||||
|
(MessageNum : SCNotMultiSelect; MessageStr : RSNotMultiSelect),
|
||||||
|
(MessageNum : SCLineNoOutOfRange; MessageStr : RSLineNoOutOfRange),
|
||||||
|
(MessageNum : SCUnknownView; MessageStr : RSUnknownView),
|
||||||
|
(MessageNum : SCOnKeySearchNotAssigned; MessageStr : RSOnKeySearchNotAssigned),
|
||||||
|
(MessageNum : SCOnEnumNotAssigned; MessageStr : RSOnEnumNotAssigned),
|
||||||
|
(MessageNum : SCOnEnumSelectedNA; MessageStr : RSOnEnumSelectedNA),
|
||||||
|
(MessageNum : SCNoMenuAssigned; MessageStr : RSNoMenuAssigned),
|
||||||
|
(MessageNum : SCNoAnchorAssigned; MessageStr : RSNoAnchorAssigned),
|
||||||
|
(MessageNum : SCInvalidParameter; MessageStr : RSInvalidParameter),
|
||||||
|
(MessageNum : SCInvalidOperation; MessageStr : RSInvalidOperation),
|
||||||
|
(MessageNum : SCColorBlack; MessageStr : RSColorBlack),
|
||||||
|
(MessageNum : SCColorMaroon; MessageStr : RSColorMaroon),
|
||||||
|
(MessageNum : SCColorGreen; MessageStr : RSColorGreen),
|
||||||
|
(MessageNum : SCColorOlive; MessageStr : RSColorOlive),
|
||||||
|
(MessageNum : SCColorNavy; MessageStr : RSColorNavy),
|
||||||
|
(MessageNum : SCColorPurple; MessageStr : RSColorPurple),
|
||||||
|
(MessageNum : SCColorTeal; MessageStr : RSColorTeal),
|
||||||
|
(MessageNum : SCColorGray; MessageStr : RSColorGray),
|
||||||
|
(MessageNum : SCColorSilver; MessageStr : RSColorSilver),
|
||||||
|
(MessageNum : SCColorRed; MessageStr : RSColorRed),
|
||||||
|
(MessageNum : SCColorLime; MessageStr : RSColorLime),
|
||||||
|
(MessageNum : SCColorYellow; MessageStr : RSColorYellow),
|
||||||
|
(MessageNum : SCColorBlue; MessageStr : RSColorBlue),
|
||||||
|
(MessageNum : SCColorFuchsia; MessageStr : RSColorFuchsia),
|
||||||
|
(MessageNum : SCColorAqua; MessageStr : RSColorAqua),
|
||||||
|
(MessageNum : SCColorWhite; MessageStr : RSColorWhite),
|
||||||
|
(MessageNum : SCColorLightGray; MessageStr : RSColorLightGray),
|
||||||
|
(MessageNum : SCColorMediumGray; MessageStr : RSColorMediumGray),
|
||||||
|
(MessageNum : SCColorDarkGray; MessageStr : RSColorDarkGray),
|
||||||
|
(MessageNum : SCColorMoneyGreen; MessageStr : RSColorMoneyGreen),
|
||||||
|
(MessageNum : SCColorSkyBlue; MessageStr : RSColorSkyBlue),
|
||||||
|
(MessageNum : SCColorCream; MessageStr : RSColorCream),
|
||||||
|
|
||||||
|
{End - Resource String Mapping...}
|
||||||
|
|
||||||
|
{Internal Strings}
|
||||||
|
(MessageNum : IccNone; MessageStr : ccNoneStr),
|
||||||
|
(MessageNum : IccBack; MessageStr : ccBackStr),
|
||||||
|
(MessageNum : IccBotOfPage; MessageStr : ccBotOfPageStr),
|
||||||
|
(MessageNum : IccBotRightCell; MessageStr : ccBotRightCellStr),
|
||||||
|
(MessageNum : IccCompleteDate; MessageStr : ccCompleteDateStr),
|
||||||
|
(MessageNum : IccCompleteTime; MessageStr : ccCompleteTimeStr),
|
||||||
|
(MessageNum : IccCopy; MessageStr : ccCopyStr),
|
||||||
|
(MessageNum : IccCtrlChar; MessageStr : ccCtrlCharStr),
|
||||||
|
(MessageNum : IccCut; MessageStr : ccCutStr),
|
||||||
|
(MessageNum : IccDec; MessageStr : ccDecStr),
|
||||||
|
(MessageNum : IccDel; MessageStr : ccDelStr),
|
||||||
|
(MessageNum : IccDelBol; MessageStr : ccDelBolStr),
|
||||||
|
(MessageNum : IccDelEol; MessageStr : ccDelEolStr),
|
||||||
|
(MessageNum : IccDelLine; MessageStr : ccDelLineStr),
|
||||||
|
(MessageNum : IccDelWord; MessageStr : ccDelWordStr),
|
||||||
|
(MessageNum : IccDown; MessageStr : ccDownStr),
|
||||||
|
(MessageNum : IccEnd; MessageStr : ccEndStr),
|
||||||
|
(MessageNum : IccExtendDown; MessageStr : ccExtendDownStr),
|
||||||
|
(MessageNum : IccExtendEnd; MessageStr : ccExtendEndStr),
|
||||||
|
(MessageNum : IccExtendHome; MessageStr : ccExtendHomeStr),
|
||||||
|
(MessageNum : IccExtendLeft; MessageStr : ccExtendLeftStr),
|
||||||
|
(MessageNum : IccExtendPgDn; MessageStr : ccExtendPgDnStr),
|
||||||
|
(MessageNum : IccExtendPgUp; MessageStr : ccExtendPgUpStr),
|
||||||
|
(MessageNum : IccExtendRight; MessageStr : ccExtendRightStr),
|
||||||
|
(MessageNum : IccExtendUp; MessageStr : ccExtendUpStr),
|
||||||
|
(MessageNum : IccExtBotOfPage; MessageStr : ccExtBotOfPageStr),
|
||||||
|
(MessageNum : IccExtFirstPage; MessageStr : ccExtFirstPageStr),
|
||||||
|
(MessageNum : IccExtLastPage; MessageStr : ccExtLastPageStr),
|
||||||
|
(MessageNum : IccExtTopOfPage; MessageStr : ccExtTopOfPageStr),
|
||||||
|
(MessageNum : IccExtWordLeft; MessageStr : ccExtWordLeftStr),
|
||||||
|
(MessageNum : IccExtWordRight; MessageStr : ccExtWordRightStr),
|
||||||
|
(MessageNum : IccFirstPage; MessageStr : ccFirstPageStr),
|
||||||
|
(MessageNum : IccGotoMarker0; MessageStr : ccGotoMarker0Str),
|
||||||
|
(MessageNum : IccGotoMarker1; MessageStr : ccGotoMarker1Str),
|
||||||
|
(MessageNum : IccGotoMarker2; MessageStr : ccGotoMarker2Str),
|
||||||
|
(MessageNum : IccGotoMarker3; MessageStr : ccGotoMarker3Str),
|
||||||
|
(MessageNum : IccGotoMarker4; MessageStr : ccGotoMarker4Str),
|
||||||
|
(MessageNum : IccGotoMarker5; MessageStr : ccGotoMarker5Str),
|
||||||
|
(MessageNum : IccGotoMarker6; MessageStr : ccGotoMarker6Str),
|
||||||
|
(MessageNum : IccGotoMarker7; MessageStr : ccGotoMarker7Str),
|
||||||
|
(MessageNum : IccGotoMarker8; MessageStr : ccGotoMarker8Str),
|
||||||
|
(MessageNum : IccGotoMarker9; MessageStr : ccGotoMarker9Str),
|
||||||
|
(MessageNum : IccHome; MessageStr : ccHomeStr),
|
||||||
|
(MessageNum : IccInc; MessageStr : ccIncStr),
|
||||||
|
(MessageNum : IccIns; MessageStr : ccInsStr),
|
||||||
|
(MessageNum : IccLastPage; MessageStr : ccLastPageStr),
|
||||||
|
(MessageNum : IccLeft; MessageStr : ccLeftStr),
|
||||||
|
(MessageNum : IccNewLine; MessageStr : ccNewLineStr),
|
||||||
|
(MessageNum : IccNextPage; MessageStr : ccNextPageStr),
|
||||||
|
(MessageNum : IccPageLeft; MessageStr : ccPageLeftStr),
|
||||||
|
(MessageNum : IccPageRight; MessageStr : ccPageRightStr),
|
||||||
|
(MessageNum : IccPaste; MessageStr : ccPasteStr),
|
||||||
|
(MessageNum : IccPrevPage; MessageStr : ccPrevPageStr),
|
||||||
|
(MessageNum : IccRedo; MessageStr : ccRedoStr),
|
||||||
|
(MessageNum : IccRestore; MessageStr : ccRestoreStr),
|
||||||
|
(MessageNum : IccRight; MessageStr : ccRightStr),
|
||||||
|
(MessageNum : IccScrollDown; MessageStr : ccScrollDownStr),
|
||||||
|
(MessageNum : IccScrollUp; MessageStr : ccScrollUpStr),
|
||||||
|
(MessageNum : IccSetMarker0; MessageStr : ccSetMarker0Str),
|
||||||
|
(MessageNum : IccSetMarker1; MessageStr : ccSetMarker1Str),
|
||||||
|
(MessageNum : IccSetMarker2; MessageStr : ccSetMarker2Str),
|
||||||
|
(MessageNum : IccSetMarker3; MessageStr : ccSetMarker3Str),
|
||||||
|
(MessageNum : IccSetMarker4; MessageStr : ccSetMarker4Str),
|
||||||
|
(MessageNum : IccSetMarker5; MessageStr : ccSetMarker5Str),
|
||||||
|
(MessageNum : IccSetMarker6; MessageStr : ccSetMarker6Str),
|
||||||
|
(MessageNum : IccSetMarker7; MessageStr : ccSetMarker7Str),
|
||||||
|
(MessageNum : IccSetMarker8; MessageStr : ccSetMarker8Str),
|
||||||
|
(MessageNum : IccSetMarker9; MessageStr : ccSetMarker9Str),
|
||||||
|
(MessageNum : IccTab; MessageStr : ccTabStr),
|
||||||
|
(MessageNum : IccTableEdit; MessageStr : ccTableEditStr),
|
||||||
|
(MessageNum : IccTopLeftCell; MessageStr : ccTopLeftCellStr),
|
||||||
|
(MessageNum : IccTopOfPage; MessageStr : ccTopOfPageStr),
|
||||||
|
(MessageNum : IccUndo; MessageStr : ccUndoStr),
|
||||||
|
(MessageNum : IccUp; MessageStr : ccUpStr),
|
||||||
|
(MessageNum : IccWordLeft; MessageStr : ccWordLeftStr),
|
||||||
|
(MessageNum : IccWordRight; MessageStr : ccWordRightStr),
|
||||||
|
(MessageNum : IString; MessageStr : StringStr),
|
||||||
|
(MessageNum : IChar; MessageStr : CharStr),
|
||||||
|
(MessageNum : IBoolean; MessageStr : BooleanStr),
|
||||||
|
(MessageNum : IYesNo; MessageStr : YesNoStr),
|
||||||
|
(MessageNum : ILongInt; MessageStr : LongIntStr),
|
||||||
|
(MessageNum : IWord; MessageStr : WordStr),
|
||||||
|
(MessageNum : ISmallInt; MessageStr : SmallIntStr),
|
||||||
|
(MessageNum : IByte; MessageStr : ByteStr),
|
||||||
|
(MessageNum : IShortInt; MessageStr : ShortIntStr),
|
||||||
|
(MessageNum : IReal; MessageStr : RealStr),
|
||||||
|
(MessageNum : IExtended; MessageStr : ExtendedStr),
|
||||||
|
(MessageNum : IDouble; MessageStr : DoubleStr),
|
||||||
|
(MessageNum : ISingle; MessageStr : SingleStr),
|
||||||
|
(MessageNum : IComp; MessageStr : CompStr),
|
||||||
|
(MessageNum : IDate; MessageStr : DateStr),
|
||||||
|
(MessageNum : ITime; MessageStr : TimeStr),
|
||||||
|
(MessageNum : ICharMask1; MessageStr : CharMask1Str),
|
||||||
|
(MessageNum : ICharMask2; MessageStr : CharMask2Str),
|
||||||
|
(MessageNum : ICharMask3; MessageStr : CharMask3Str),
|
||||||
|
(MessageNum : ICharMask4; MessageStr : CharMask4Str),
|
||||||
|
(MessageNum : ICharMask5; MessageStr : CharMask5Str),
|
||||||
|
(MessageNum : ICharMask6; MessageStr : CharMask6Str),
|
||||||
|
(MessageNum : ICharMask7; MessageStr : CharMask7Str),
|
||||||
|
(MessageNum : ICharMask8; MessageStr : CharMask8Str),
|
||||||
|
(MessageNum : ICharMask9; MessageStr : CharMask9Str),
|
||||||
|
(MessageNum : ICharMask10; MessageStr : CharMask10Str),
|
||||||
|
(MessageNum : ICharMask11; MessageStr : CharMask11Str),
|
||||||
|
(MessageNum : ICharMask12; MessageStr : CharMask12Str),
|
||||||
|
(MessageNum : ICharMask13; MessageStr : CharMask14Str),
|
||||||
|
(MessageNum : ICharMask14; MessageStr : CharMask15Str),
|
||||||
|
(MessageNum : ICharMask15; MessageStr : CharMask16Str),
|
||||||
|
(MessageNum : ICharMask16; MessageStr : CharMask17Str),
|
||||||
|
(MessageNum : ICharMask17; MessageStr : CharMask18Str),
|
||||||
|
(MessageNum : ICharMask18; MessageStr : CharMask19Str),
|
||||||
|
(MessageNum : ICharMask19; MessageStr : CharMask20Str),
|
||||||
|
(MessageNum : ICharMask20; MessageStr : CharMask21Str),
|
||||||
|
(MessageNum : ICharMask21; MessageStr : CharMask22Str),
|
||||||
|
(MessageNum : ICharMask22; MessageStr : CharMask23Str),
|
||||||
|
(MessageNum : ICharMask23; MessageStr : CharMask24Str),
|
||||||
|
(MessageNum : ICharMask24; MessageStr : CharMask25Str),
|
||||||
|
(MessageNum : IFieldMask1; MessageStr : FieldMask1Str),
|
||||||
|
(MessageNum : IFieldMask2; MessageStr : FieldMask2Str),
|
||||||
|
(MessageNum : IFieldMask3; MessageStr : FieldMask3Str),
|
||||||
|
(MessageNum : IFieldMask4; MessageStr : FieldMask4Str),
|
||||||
|
(MessageNum : IFieldMask5; MessageStr : FieldMask5Str),
|
||||||
|
(MessageNum : IFieldMask6; MessageStr : FieldMask6Str),
|
||||||
|
(MessageNum : IFieldMask7; MessageStr : FieldMask7Str),
|
||||||
|
(MessageNum : IFieldMask8; MessageStr : FieldMask8Str),
|
||||||
|
(MessageNum : IFieldMask9; MessageStr : FieldMask9Str),
|
||||||
|
(MessageNum : IFieldMask10; MessageStr : FieldMask10Str),
|
||||||
|
(MessageNum : IFieldMask11; MessageStr : FieldMask11Str),
|
||||||
|
(MessageNum : IFieldMask12; MessageStr : FieldMask12Str),
|
||||||
|
(MessageNum : IFieldMask13; MessageStr : FieldMask13Str),
|
||||||
|
(MessageNum : IFieldMask14; MessageStr : FieldMask14Str),
|
||||||
|
(MessageNum : IFieldMask15; MessageStr : FieldMask15Str),
|
||||||
|
(MessageNum : IFieldMask16; MessageStr : FieldMask16Str),
|
||||||
|
(MessageNum : IFieldMask17; MessageStr : FieldMask17Str),
|
||||||
|
(MessageNum : IFieldMask18; MessageStr : FieldMask18Str),
|
||||||
|
(MessageNum : IFieldMask19; MessageStr : FieldMask19Str),
|
||||||
|
(MessageNum : IFieldMask20; MessageStr : FieldMask20Str),
|
||||||
|
(MessageNum : IFieldMask21; MessageStr : FieldMask21Str),
|
||||||
|
(MessageNum : IFieldMask22; MessageStr : FieldMask22Str),
|
||||||
|
(MessageNum : IFieldMask23; MessageStr : FieldMask23Str),
|
||||||
|
(MessageNum : IFieldMask24; MessageStr : FieldMask24Str),
|
||||||
|
(MessageNum : IFieldMask25; MessageStr : FieldMask25Str),
|
||||||
|
(MessageNum : IFieldMask26; MessageStr : FieldMask26Str),
|
||||||
|
(MessageNum : IFieldMask27; MessageStr : FieldMask27Str),
|
||||||
|
(MessageNum : IFieldMask28; MessageStr : FieldMask28Str),
|
||||||
|
(MessageNum : IFieldMask29; MessageStr : FieldMask29Str),
|
||||||
|
(MessageNum : IFieldMask30; MessageStr : FieldMask30Str),
|
||||||
|
(MessageNum : IFieldMask31; MessageStr : FieldMask31Str),
|
||||||
|
(MessageNum : IFieldMask32; MessageStr : FieldMask32Str),
|
||||||
|
(MessageNum : IFieldMask33; MessageStr : FieldMask33Str),
|
||||||
|
(MessageNum : IFieldMask34; MessageStr : FieldMask34Str),
|
||||||
|
(MessageNum : IFieldMask35; MessageStr : FieldMask35Str),
|
||||||
|
(MessageNum : IFieldMask36; MessageStr : FieldMask36Str),
|
||||||
|
(MessageNum : IFieldMask37; MessageStr : FieldMask37Str),
|
||||||
|
(MessageNum : IFieldMask38; MessageStr : FieldMask38Str),
|
||||||
|
(MessageNum : IFieldMask39; MessageStr : FieldMask39Str),
|
||||||
|
(MessageNum : IFieldMask40; MessageStr : FieldMask40Str),
|
||||||
|
(MessageNum : IFieldMask41; MessageStr : FieldMask41Str),
|
||||||
|
(MessageNum : IFieldMask42; MessageStr : FieldMask42Str));
|
||||||
|
|
||||||
|
{End - Internal Strings...}
|
||||||
|
|
||||||
|
function ResourceStrByNumber(Num: Word): String;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function ResourceStrByNumber(Num: Word): String;
|
||||||
|
{Implements a simple binary search through the SrMsgNumLookup array.
|
||||||
|
Returns an empty string is a match isn't found.}
|
||||||
|
var
|
||||||
|
Mid, Min, Max : integer;
|
||||||
|
begin
|
||||||
|
result := '';
|
||||||
|
Min := 0;
|
||||||
|
Max := SrMaxMessages;
|
||||||
|
while (Min <= Max) do begin
|
||||||
|
Mid := (Min + Max) div 2;
|
||||||
|
if SrMsgNumLookup[Mid].MessageNum = Num then begin
|
||||||
|
result := SrMsgNumLookup[Mid].MessageStr;
|
||||||
|
exit;
|
||||||
|
end else begin
|
||||||
|
if Num < SrMsgNumLookup[Mid].MessageNum
|
||||||
|
then Max := Mid - 1
|
||||||
|
else Min := Mid + 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
708
components/orpheus/o32tcflx.pas
Normal file
708
components/orpheus/o32tcflx.pas
Normal file
@ -0,0 +1,708 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCTCFLX.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32tcflx;
|
||||||
|
{Orpheus Table Cell version of the FlexEdit}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
|
||||||
|
SysUtils, Graphics, Classes, Controls, Forms, StdCtrls,
|
||||||
|
Menus, OvcTCmmn, OvcTCell,
|
||||||
|
OvcTCStr, O32FlxEd, O32bordr, OvcEf, OvcCmd, O32VlOp1, O32Vldtr;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ Event for the TCFlexEdit User Validation }
|
||||||
|
TTCFEUserValidationEvent =
|
||||||
|
procedure(Sender : TObject; Value: string;
|
||||||
|
var ValidEntry : Boolean) of object;
|
||||||
|
|
||||||
|
|
||||||
|
{Class for storing the validation properties. These properties will be
|
||||||
|
loaded dynamically when the editor is created.}
|
||||||
|
TO32TCValidatorOptions = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FValidationType : TValidationType;
|
||||||
|
FValidatorType : String;
|
||||||
|
FValidatorClass : TValidatorClass;
|
||||||
|
FMask : String;
|
||||||
|
FLastValid : Boolean;
|
||||||
|
FLastErrorCode : Word;
|
||||||
|
FBeepOnError : Boolean;
|
||||||
|
FInputRequired : Boolean;
|
||||||
|
|
||||||
|
procedure SetValidatorType(const VType: String);
|
||||||
|
procedure AssignValidator;
|
||||||
|
public
|
||||||
|
constructor Create; dynamic;
|
||||||
|
property LastValid: Boolean
|
||||||
|
read FLastValid write FLastValid;
|
||||||
|
property LastErrorCode: Word
|
||||||
|
read FLastErrorCode write FLastErrorCode;
|
||||||
|
|
||||||
|
{ - Moved from published}
|
||||||
|
property ValidatorClass: TValidatorClass
|
||||||
|
read FValidatorClass write FValidatorClass stored true;
|
||||||
|
published
|
||||||
|
property BeepOnError: Boolean
|
||||||
|
read FBeepOnError write FBeepOnError stored true;
|
||||||
|
property InputRequired: Boolean
|
||||||
|
read FInputRequired write FInputRequired stored true;
|
||||||
|
property ValidatorType : string
|
||||||
|
read FValidatorType write SetValidatorType stored true;
|
||||||
|
property ValidationType: TValidationType
|
||||||
|
read FValidationType write FValidationType stored true;
|
||||||
|
property Mask: String
|
||||||
|
read FMask write FMask stored true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TO32TCFlexEditEditor = class(TO32CustomFlexEdit)
|
||||||
|
protected {private}
|
||||||
|
FCell : TOvcBaseTableCell;
|
||||||
|
procedure WMChar(var Msg : TWMKey); message WM_CHAR;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
|
||||||
|
{$ELSE}
|
||||||
|
procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE;
|
||||||
|
{$ENDIF}
|
||||||
|
procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
|
||||||
|
procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
|
||||||
|
procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
|
||||||
|
|
||||||
|
function ValidateSelf: Boolean; override;
|
||||||
|
|
||||||
|
// TurboPower bug? CellOwner property wasn't published.
|
||||||
|
published //Added
|
||||||
|
property CellOwner : TOvcBaseTableCell read FCell write FCell; //Moved to here
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32TCBorderProperties = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FActive : Boolean;
|
||||||
|
FFlatColor : TColor;
|
||||||
|
FBorderStyle : TO32BorderStyle;
|
||||||
|
public
|
||||||
|
constructor Create; virtual;
|
||||||
|
published
|
||||||
|
property Active: Boolean read FActive write FActive;
|
||||||
|
property FlatColor: TColor read FFlatColor write FFlatColor;
|
||||||
|
property BorderStyle: TO32BorderStyle read FBorderStyle write FBorderStyle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32TCEditorProperties = class(TPersistent)
|
||||||
|
protected
|
||||||
|
FAlignment : TAlignment;
|
||||||
|
FBorders : TO32Borders;
|
||||||
|
FButtonGlyph : TBitmap;
|
||||||
|
FColor : TColor;
|
||||||
|
FCursor : TCursor;
|
||||||
|
FMaxLines : Integer;
|
||||||
|
FShowButton : Boolean;
|
||||||
|
FPasswordChar : Char;
|
||||||
|
FReadOnly : Boolean;
|
||||||
|
procedure SetButtonGlyph(Value :TBitmap);
|
||||||
|
function GetButtonGlyph :TBitmap;
|
||||||
|
public
|
||||||
|
constructor Create; virtual;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
property Borders: TO32Borders read FBorders write FBorders;
|
||||||
|
|
||||||
|
published
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Alignment: TAlignment read FAlignment write FAlignment;
|
||||||
|
{$ENDIF}
|
||||||
|
property ButtonGlyph: TBitmap
|
||||||
|
read GetButtonGlyph write SetButtonGlyph;
|
||||||
|
|
||||||
|
property Color: TColor Read FColor write FColor;
|
||||||
|
property Cursor: TCursor read FCursor write FCursor;
|
||||||
|
property MaxLines: Integer read FMaxLines write FMaxLines;
|
||||||
|
property PasswordChar: Char read FPasswordChar write FPasswordChar;
|
||||||
|
property ReadOnly: Boolean Read FReadOnly write FReadOnly;
|
||||||
|
property ShowButton: Boolean read FShowButton write FShowButton;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32TCCustomFlexEdit = class(TOvcTCBaseString)
|
||||||
|
protected {private}
|
||||||
|
FBorderProps : TO32TCBorderProperties;
|
||||||
|
FEdit : TO32TCFlexEditEditor;
|
||||||
|
FEditorOptions : TO32TCEditorProperties;
|
||||||
|
FMaxLength : word;
|
||||||
|
FValidation : TO32TCValidatorOptions;
|
||||||
|
FWantReturns : Boolean;
|
||||||
|
FWantTabs : Boolean;
|
||||||
|
FWordWrap : Boolean;
|
||||||
|
|
||||||
|
FOnError : TValidationErrorEvent;
|
||||||
|
FOnUserCommand : TUserCommandEvent;
|
||||||
|
FOnUserValidation : TTCFEUserValidationEvent;
|
||||||
|
|
||||||
|
FOnButtonClick : TO32feButtonClickEvent;
|
||||||
|
|
||||||
|
protected
|
||||||
|
function GetCellEditor : TControl; override;
|
||||||
|
function GetModified : boolean;
|
||||||
|
|
||||||
|
property MaxLength : word
|
||||||
|
read FMaxLength write FMaxLength stored true;
|
||||||
|
property WantReturns : boolean
|
||||||
|
read FWantReturns write FWantReturns stored true;
|
||||||
|
property WantTabs : boolean
|
||||||
|
read FWantTabs write FWantTabs stored true;
|
||||||
|
property WordWrap: Boolean
|
||||||
|
read FWordWrap write FWordWrap stored true;
|
||||||
|
property EditorBorders: TO32TCBorderProperties
|
||||||
|
read FBorderProps write FBorderProps;
|
||||||
|
property OnButtonClick: TO32feButtonClickEvent
|
||||||
|
read FOnButtonClick write FOnButtonClick;
|
||||||
|
property Validation: TO32TCValidatorOptions
|
||||||
|
read FValidation write FValidation;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function CreateEditControl(AOwner : TComponent) : TO32TCFlexEditEditor; virtual;
|
||||||
|
function EditHandle : THandle; override;
|
||||||
|
procedure EditHide; override;
|
||||||
|
procedure EditMove(CellRect : TRect); override;
|
||||||
|
|
||||||
|
function CanSaveEditedData(SaveValue : boolean) : boolean; override;
|
||||||
|
procedure SaveEditedData(Data : pointer); override;
|
||||||
|
function ValidateEntry: Boolean;
|
||||||
|
procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
|
||||||
|
CellRect : TRect;
|
||||||
|
const CellAttr : TOvcCellAttributes;
|
||||||
|
CellStyle: TOvcTblEditorStyle;
|
||||||
|
Data : pointer); override;
|
||||||
|
procedure StopEditing(SaveValue : boolean;
|
||||||
|
Data : pointer); override;
|
||||||
|
property Modified : boolean
|
||||||
|
read GetModified;
|
||||||
|
property EditorOptions: TO32TCEditorProperties
|
||||||
|
read FEditorOptions write FEditorOptions;
|
||||||
|
property OnUserValidation: TTCFEUserValidationEvent
|
||||||
|
read FOnUserValidation write FOnUserValidation;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32TCFlexEdit = class(TO32TCCustomFlexEdit)
|
||||||
|
published
|
||||||
|
{properties inherited from custom ancestor}
|
||||||
|
property Access default otxDefault;
|
||||||
|
property Adjust default otaDefault;
|
||||||
|
property EditorBorders;
|
||||||
|
property Color;
|
||||||
|
property EditorOptions;
|
||||||
|
property Font;
|
||||||
|
property Hint;
|
||||||
|
property Margin default 4;
|
||||||
|
property MaxLength default 255;
|
||||||
|
property ShowHint default False;
|
||||||
|
property Table;
|
||||||
|
property TableColor default True;
|
||||||
|
property TableFont default True;
|
||||||
|
property TextHiColor default clBtnHighlight;
|
||||||
|
property TextStyle default tsFlat;
|
||||||
|
property Validation;
|
||||||
|
property WantReturns default False;
|
||||||
|
property WantTabs default False;
|
||||||
|
property WordWrap default False;
|
||||||
|
{events inherited from custom ancestor}
|
||||||
|
property OnButtonClick;
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnOwnerDraw;
|
||||||
|
property OnUserValidation;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{===== TO32TCValidatorOptions ========================================}
|
||||||
|
|
||||||
|
constructor TO32TCValidatorOptions.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FValidationType := vtNone;
|
||||||
|
FValidatorType := 'None';
|
||||||
|
FValidatorClass := nil;
|
||||||
|
FMask := '';
|
||||||
|
FLastValid := false;
|
||||||
|
FLastErrorCode := 0;
|
||||||
|
FBeepOnError := true;
|
||||||
|
FInputRequired := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TO32TCValidatorOptions.AssignValidator;
|
||||||
|
begin
|
||||||
|
if (FValidatorType = 'None') or (FValidatorType = '')then
|
||||||
|
FValidatorClass := nil
|
||||||
|
else try
|
||||||
|
FValidatorClass := TValidatorClass(FindClass(FValidatorType));
|
||||||
|
except
|
||||||
|
FValidatorClass := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCValidatorOptions.SetValidatorType(const VType: String);
|
||||||
|
begin
|
||||||
|
if FValidatorType <> VType then begin
|
||||||
|
FValidatorType := VType;
|
||||||
|
AssignValidator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{===== TO32TCFlexEditEditor ==========================================}
|
||||||
|
|
||||||
|
procedure TO32TCFlexEditEditor.WMChar(var Msg : TWMKey);
|
||||||
|
begin
|
||||||
|
if (not CellOwner.TableWantsTab) or (Msg.CharCode <> 9) then
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TMessage);
|
||||||
|
{$ELSE}
|
||||||
|
procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TWMGetDlgCode);
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if CellOwner.TableWantsTab then
|
||||||
|
Msg.Result := Msg.Result or DLGC_WANTTAB;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCFlexEditEditor.WMKeyDown(var Msg : TWMKey);
|
||||||
|
{Local Method}
|
||||||
|
procedure GetSelection(var S, E : word);
|
||||||
|
type
|
||||||
|
LH = packed record L, H : word; end;
|
||||||
|
var
|
||||||
|
GetSel : longint;
|
||||||
|
begin
|
||||||
|
GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
|
||||||
|
S := LH(GetSel).L;
|
||||||
|
E := LH(GetSel).H;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
GridReply : TOvcTblKeyNeeds;
|
||||||
|
GridUsedIt : boolean;
|
||||||
|
SStart, SEnd : word;
|
||||||
|
begin
|
||||||
|
GridUsedIt := false;
|
||||||
|
GridReply := otkDontCare;
|
||||||
|
if (CellOwner <> nil) then
|
||||||
|
GridReply := CellOwner.FilterTableKey(Msg);
|
||||||
|
case GridReply of
|
||||||
|
otkMustHave :
|
||||||
|
begin
|
||||||
|
CellOwner.SendKeyToTable(Msg);
|
||||||
|
GridUsedIt := true;
|
||||||
|
end;
|
||||||
|
otkWouldLike :
|
||||||
|
case Msg.CharCode of
|
||||||
|
VK_RETURN :
|
||||||
|
if not WantReturns then
|
||||||
|
begin
|
||||||
|
CellOwner.SendKeyToTable(Msg);
|
||||||
|
GridUsedIt := true;
|
||||||
|
end;
|
||||||
|
VK_LEFT :
|
||||||
|
begin
|
||||||
|
GetSelection(SStart, SEnd);
|
||||||
|
if (SStart = SEnd) and (SStart = 0) then
|
||||||
|
begin
|
||||||
|
CellOwner.SendKeyToTable(Msg);
|
||||||
|
GridUsedIt := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
VK_RIGHT :
|
||||||
|
begin
|
||||||
|
GetSelection(SStart, SEnd);
|
||||||
|
if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
|
||||||
|
begin
|
||||||
|
CellOwner.SendKeyToTable(Msg);
|
||||||
|
GridUsedIt := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT : //TurboPower bug? left out this case
|
||||||
|
begin
|
||||||
|
CellOwner.SendKeyToTable(Msg);
|
||||||
|
GridUsedIt := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;{case}
|
||||||
|
|
||||||
|
if not GridUsedIt then
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCFlexEditEditor.WMKillFocus(var Msg : TWMKillFocus);
|
||||||
|
begin
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
inherited;
|
||||||
|
{$ELSE}
|
||||||
|
inherited WMKillFocus(Msg);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
// Apparent TurboPower bug: change of focus with tab or mouse doesn't
|
||||||
|
// trigger validation, so do it here and don't change focus if invalid.
|
||||||
|
if not TO32TCCustomFlexEdit(CellOwner).ValidateEntry then //These lines added
|
||||||
|
begin
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
SetFocus;
|
||||||
|
{$ENDIF}
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCFlexEditEditor.WMSetFocus(var Msg : TWMSetFocus);
|
||||||
|
begin
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
inherited;
|
||||||
|
{$ELSE}
|
||||||
|
inherited WMSetFocus(Msg);
|
||||||
|
{$ENDIF}
|
||||||
|
CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCFlexEditEditor.ValidateSelf;
|
||||||
|
begin
|
||||||
|
result := inherited ValidateSelf;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===== TO32TCBorderProperties ========================================}
|
||||||
|
constructor TO32TCBorderProperties.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FActive := False;
|
||||||
|
FFlatColor := clBlack;
|
||||||
|
FBorderStyle := bstyRaised;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===== TO32TCEditorProperties ========================================}
|
||||||
|
constructor TO32TCEditorProperties.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FAlignment := taLeftJustify;
|
||||||
|
FButtonGlyph := TBitmap.Create;
|
||||||
|
FColor := clWindow;
|
||||||
|
FCursor := crDefault;
|
||||||
|
FMaxLines := 3;
|
||||||
|
FShowButton := false;
|
||||||
|
// TurboPower bug: No default efoPasswordMode=False like TOvcTCSimpleField,
|
||||||
|
// so '*' means TO32TCFlexEdit would be in password mode by default.
|
||||||
|
// FPasswordChar := '*';
|
||||||
|
FPasswordChar := #0; //Fixed
|
||||||
|
FReadOnly := false;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32TCEditorProperties.Destroy;
|
||||||
|
begin
|
||||||
|
FButtonGlyph.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
{ - begin}
|
||||||
|
procedure TO32TCEditorProperties.SetButtonGlyph(Value :TBitmap);
|
||||||
|
begin
|
||||||
|
FButtonGlyph.Assign(Value);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCEditorProperties.GetButtonGlyph :TBitmap;
|
||||||
|
begin
|
||||||
|
Result := FButtonGlyph;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
{ - end}
|
||||||
|
|
||||||
|
{===== TO32TCCustomFlexEdit ==========================================}
|
||||||
|
constructor TO32TCCustomFlexEdit.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
UseASCIIZStrings := true;
|
||||||
|
UseWordWrap := true;
|
||||||
|
FEditorOptions := TO32TCEditorProperties.Create;
|
||||||
|
FBorderProps := TO32TCBorderProperties.Create;
|
||||||
|
FValidation := TO32TCValidatorOptions.Create;
|
||||||
|
MaxLength := 255;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32TCCustomFlexEdit.Destroy;
|
||||||
|
begin
|
||||||
|
FEditorOptions.Free;
|
||||||
|
FBorderProps.Free;
|
||||||
|
FValidation.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.GetCellEditor : TControl;
|
||||||
|
begin
|
||||||
|
Result := FEdit;
|
||||||
|
FEditorOptions.Free;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.GetModified : boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FEdit) then
|
||||||
|
Result := FEdit.Modified
|
||||||
|
else
|
||||||
|
Result := false;
|
||||||
|
end ;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.CreateEditControl(AOwner : TComponent):
|
||||||
|
TO32TCFlexEditEditor;
|
||||||
|
begin
|
||||||
|
Result := TO32TCFlexEditEditor.Create(AOwner);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.EditHandle : THandle;
|
||||||
|
begin
|
||||||
|
if Assigned(FEdit) then
|
||||||
|
Result := FEdit.Handle
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCCustomFlexEdit.EditHide;
|
||||||
|
begin
|
||||||
|
if Assigned(FEdit) then
|
||||||
|
// with FEdit do
|
||||||
|
SetWindowPos(FEdit.Handle, HWND_TOP, 0, 0, 0, 0, SWP_HIDEWINDOW
|
||||||
|
or SWP_NOREDRAW or SWP_NOZORDER);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCCustomFlexEdit.EditMove(CellRect : TRect);
|
||||||
|
begin
|
||||||
|
if Assigned(FEdit) then
|
||||||
|
begin
|
||||||
|
with CellRect do
|
||||||
|
SetWindowPos(FEdit.Handle, HWND_TOP,
|
||||||
|
Left, Top, Right-Left, Bottom-Top,
|
||||||
|
SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
|
||||||
|
InvalidateRect(FEdit.Handle, nil, false);
|
||||||
|
UpdateWindow(FEdit.Handle);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.CanSaveEditedData(SaveValue : boolean) : boolean;
|
||||||
|
begin
|
||||||
|
Result := true;
|
||||||
|
if Validation.InputRequired and (FEdit.Text = '') then begin
|
||||||
|
result := false;
|
||||||
|
FEdit.Restore;
|
||||||
|
end
|
||||||
|
|
||||||
|
else if (Validation.FValidationType <> vtNone) then
|
||||||
|
if Assigned(FEdit) then
|
||||||
|
if SaveValue then
|
||||||
|
Result := ValidateEntry
|
||||||
|
else begin
|
||||||
|
FEdit.Restore;
|
||||||
|
result := false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32TCCustomFlexEdit.ValidateEntry: Boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnUserValidation) then begin
|
||||||
|
FOnUserValidation(FEdit, FEdit.Text, result);
|
||||||
|
// if Validation.BeepOnError then MessageBeep(0); <== TurboPower bug? not checking result
|
||||||
|
if (not result) and Validation.BeepOnError then MessageBeep(0); //Fixed
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
result := FEdit.ValidateSelf;
|
||||||
|
Validation.LastValid := FEdit.Validation.LastValid;
|
||||||
|
Validation.LastErrorCode := FEdit.Validation.LastErrorCode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TO32TCCustomFlexEdit.SaveEditedData(Data : pointer);
|
||||||
|
begin
|
||||||
|
{Abstract method does nothing.
|
||||||
|
It is stubbed out so that BCB doesn't think this as an abstract class}
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCCustomFlexEdit.StartEditing(RowNum : TRowNum; ColNum : TColNum;
|
||||||
|
CellRect : TRect;
|
||||||
|
const CellAttr : TOvcCellAttributes;
|
||||||
|
CellStyle: TOvcTblEditorStyle;
|
||||||
|
Data : pointer);
|
||||||
|
{var
|
||||||
|
Str: String;}
|
||||||
|
begin
|
||||||
|
FEdit := TO32TCFlexEditEditor.Create(FTable);
|
||||||
|
|
||||||
|
FEdit.Validation.EnableHooking := false;
|
||||||
|
FEdit.Validation.InputRequired := Validation.InputRequired;
|
||||||
|
FEdit.Validation.ValidationType := Validation.ValidationType;
|
||||||
|
FEdit.Validation.ValidatorType := Validation.ValidatorType;
|
||||||
|
FEdit.Validation.ValidatorClass := Validation.ValidatorClass;
|
||||||
|
FEdit.Validation.Mask := Validation.Mask;
|
||||||
|
FEdit.Validation.BeepOnError := Validation.BeepOnError;
|
||||||
|
FEdit.Validation.InputRequired := Validation.InputRequired;
|
||||||
|
FEdit.Validation.ValidationEvent := veOnExit;
|
||||||
|
|
||||||
|
|
||||||
|
FEdit.ShowButton := FEditorOptions.ShowButton;
|
||||||
|
if FEdit.ShowButton then begin
|
||||||
|
FEdit.ButtonGlyph := FEditorOptions.ButtonGlyph;
|
||||||
|
if Assigned(OnButtonClick) then
|
||||||
|
FEdit.OnButtonClick := OnButtonClick;
|
||||||
|
end;
|
||||||
|
|
||||||
|
with FEdit do begin
|
||||||
|
Parent := FTable;
|
||||||
|
|
||||||
|
Borders.Active := FBorderProps.FActive;
|
||||||
|
|
||||||
|
if Borders.Active then begin
|
||||||
|
Borders.BorderStyle := FBorderProps.FBorderStyle;
|
||||||
|
Borders.FlatColor := FBorderProps.FFlatColor;
|
||||||
|
BorderStyle := bsSingle;
|
||||||
|
Ctl3D := true;
|
||||||
|
end else begin
|
||||||
|
BorderStyle := bsNone;
|
||||||
|
Ctl3D := false;
|
||||||
|
case CellStyle of
|
||||||
|
tesBorder : BorderStyle := bsSingle;
|
||||||
|
tes3D : Ctl3D := true;
|
||||||
|
end;{case}
|
||||||
|
end;
|
||||||
|
|
||||||
|
Color := FEditorOptions.Color;
|
||||||
|
Font := CellAttr.caFont;
|
||||||
|
Font.Color := CellAttr.caFontColor;
|
||||||
|
MaxLength := Self.MaxLength;
|
||||||
|
WantReturns := Self.WantReturns;
|
||||||
|
WantTabs := Self.WantTabs;
|
||||||
|
WordWrap := Self.WordWrap;
|
||||||
|
EditLines.MaxLines := FEditorOptions.MaxLines;
|
||||||
|
EditLines.DefaultLines := 1;
|
||||||
|
EditLines.FocusedLines := 3;
|
||||||
|
EditLines.MouseOverLines := 3;
|
||||||
|
Cursor := FEditorOptions.Cursor;
|
||||||
|
PasswordChar := FEditorOptions.PasswordChar;
|
||||||
|
ReadOnly := FEditorOptions.ReadOnly;
|
||||||
|
Left := CellRect.Left;
|
||||||
|
Top := CellRect.Top;
|
||||||
|
Width := CellRect.Right - CellRect.Left;
|
||||||
|
Height := CellRect.Bottom - CellRect.Top;
|
||||||
|
Visible := true;
|
||||||
|
TabStop := false;
|
||||||
|
CellOwner := Self;
|
||||||
|
Hint := Self.Hint;
|
||||||
|
ShowHint := Self.ShowHint;
|
||||||
|
|
||||||
|
{Str := PAnsiChar(Data);} {!!!}
|
||||||
|
if (Data = nil) then
|
||||||
|
SetTextBuf('')
|
||||||
|
else begin
|
||||||
|
SetTextBuf(PAnsiChar(Data));
|
||||||
|
end;
|
||||||
|
|
||||||
|
OnChange := Self.OnChange;
|
||||||
|
OnClick := Self.OnClick;
|
||||||
|
OnDblClick := Self.OnDblClick;
|
||||||
|
OnDragDrop := Self.OnDragDrop;
|
||||||
|
OnDragOver := Self.OnDragOver;
|
||||||
|
OnEndDrag := Self.OnEndDrag;
|
||||||
|
OnEnter := Self.OnEnter;
|
||||||
|
OnExit := Self.OnExit;
|
||||||
|
OnKeyDown := Self.OnKeyDown;
|
||||||
|
OnKeyPress := Self.OnKeyPress;
|
||||||
|
OnKeyUp := Self.OnKeyUp;
|
||||||
|
OnMouseDown := Self.OnMouseDown;
|
||||||
|
OnMouseMove := Self.OnMouseMove;
|
||||||
|
OnMouseUp := Self.OnMouseUp;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32TCCustomFlexEdit.StopEditing(SaveValue : boolean;
|
||||||
|
Data : pointer);
|
||||||
|
{var
|
||||||
|
Str: String;}
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
if SaveValue and Assigned(Data) then begin
|
||||||
|
FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
|
||||||
|
{Str := PAnsiChar(Data);} {!!!}
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FEdit.Free;
|
||||||
|
FEdit := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
193
components/orpheus/o32vldtr.pas
Normal file
193
components/orpheus/o32vldtr.pas
Normal file
@ -0,0 +1,193 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32VLDTR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32vldtr;
|
||||||
|
{-Base classes for the TO32Validator and descendant components}
|
||||||
|
|
||||||
|
{
|
||||||
|
TO32BaseValidator is the abstract ancestor for all Orpheus Validator components
|
||||||
|
Descendants must override SetInput, SetMask, GetValid and IsValid plus define
|
||||||
|
the validation to provide full functionality.
|
||||||
|
|
||||||
|
Descendant classes which call the RegisterValidator and UnRegisterValidator
|
||||||
|
procedures in their unit's Initialization and Finalization sections will be
|
||||||
|
available as a selection in the ValidatorType property of components that use
|
||||||
|
validators internally.
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} Classes, OvcBase;
|
||||||
|
|
||||||
|
type
|
||||||
|
TValidationEvent = (veOnChange, veOnEnter, veOnExit);
|
||||||
|
|
||||||
|
TValidatorErrorEvent =
|
||||||
|
procedure(Sender: TObject; const ErrorMsg: string) of object;
|
||||||
|
|
||||||
|
TValidatorClass = class of TO32BaseValidator;
|
||||||
|
|
||||||
|
TO32BaseValidator = class(TO32Component)
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FBeforeValidation : TNotifyEvent;
|
||||||
|
FAfterValidation : TNotifyEvent;
|
||||||
|
FOnUserValidation : TNotifyEvent;
|
||||||
|
FOnErrorEvent : TValidatorErrorEvent;
|
||||||
|
|
||||||
|
FInput : string;
|
||||||
|
FMask : string;
|
||||||
|
FValid : boolean ;
|
||||||
|
FErrorCode : Word;
|
||||||
|
FSampleMaskLength : Word;
|
||||||
|
FSampleMasks : TStringList;
|
||||||
|
|
||||||
|
procedure SetAbout(const Value: string);
|
||||||
|
procedure SetInput(const Value: string); virtual; abstract;
|
||||||
|
procedure SetMask(const Value: string); virtual; abstract;
|
||||||
|
procedure SetValid(Value: boolean);
|
||||||
|
function GetAbout: string;
|
||||||
|
function GetValid: Boolean; virtual; abstract;
|
||||||
|
function GetSampleMasks: TStringList; virtual; abstract;
|
||||||
|
procedure DoOnUserValidation;
|
||||||
|
procedure DoBeforeValidation;
|
||||||
|
procedure DoAfterValidation;
|
||||||
|
procedure DoOnError(Sender: TObject; const ErrorMsg: string);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
{Public Methods}
|
||||||
|
function IsValid: Boolean; virtual; abstract;
|
||||||
|
function SampleMaskLength: integer;
|
||||||
|
|
||||||
|
{Public Properties}
|
||||||
|
property Input : string read FInput
|
||||||
|
write SetInput;
|
||||||
|
property Mask : string read FMask write SetMask;
|
||||||
|
property Valid : boolean read GetValid;
|
||||||
|
property ErrorCode: Word read FErrorCode;
|
||||||
|
property SampleMasks: TStringList read GetSampleMasks;
|
||||||
|
|
||||||
|
{Public Events}
|
||||||
|
property BeforeValidation : TNotifyEvent
|
||||||
|
read FBeforeValidation write FBeforeValidation;
|
||||||
|
property AfterValidation : TNotifyEvent
|
||||||
|
read FAfterValidation write FAfterValidation;
|
||||||
|
property OnValidationError : TValidatorErrorEvent
|
||||||
|
read FOnErrorEvent write FOnErrorEvent;
|
||||||
|
|
||||||
|
published
|
||||||
|
property About : string read GetAbout write SetAbout
|
||||||
|
stored False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
OvcVer;
|
||||||
|
|
||||||
|
{===== TO32BaseValidator ===========================================}
|
||||||
|
constructor TO32BaseValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FSampleMaskLength := 0;
|
||||||
|
FSampleMasks := TStringList.Create;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32BaseValidator.Destroy;
|
||||||
|
begin
|
||||||
|
FSampleMasks.Clear;
|
||||||
|
FSampleMasks.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32BaseValidator.SampleMaskLength: integer;
|
||||||
|
begin
|
||||||
|
result := FSampleMaskLength;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32BaseValidator.GetAbout : string;
|
||||||
|
begin
|
||||||
|
Result := OrVersionStr;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.SetAbout(const Value : string);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.SetValid(Value: boolean);
|
||||||
|
begin
|
||||||
|
if FValid <> Value then
|
||||||
|
FValid := Value;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.DoOnUserValidation;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnUserValidation) then
|
||||||
|
FOnUserValidation(Self);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.DoBeforeValidation;
|
||||||
|
begin
|
||||||
|
if Assigned(FBeforeValidation) then
|
||||||
|
FBeforeValidation(Self);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.DoAfterValidation;
|
||||||
|
begin
|
||||||
|
if Assigned(FAfterValidation) then
|
||||||
|
FAfterValidation(Self);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32BaseValidator.DoOnError(Sender: TObject; const ErrorMsg: string);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnErrorEvent) then
|
||||||
|
FOnErrorEvent(Self, ErrorMsg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
339
components/orpheus/o32vlop1.pas
Normal file
339
components/orpheus/o32vlop1.pas
Normal file
@ -0,0 +1,339 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32VLOP1.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32vlop1;
|
||||||
|
{-ValidatorOptions class for use in components and classes which contain
|
||||||
|
their own validator objects, like the ValidatorPool, FlexEdit, Etc...}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
|
||||||
|
Controls, Classes, Forms, SysUtils,
|
||||||
|
O32Vldtr, OvcData, OvcExcpt, OvcConst;
|
||||||
|
|
||||||
|
type
|
||||||
|
TValidationType = (vtNone, vtUser, vtValidator);
|
||||||
|
|
||||||
|
TProtectedControl = class(TWinControl);
|
||||||
|
|
||||||
|
TValidatorOptions = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FOwner : TWinControl;
|
||||||
|
FHookedControl : TWinControl;
|
||||||
|
FValidationType : TValidationType;
|
||||||
|
FValidatorType : String;
|
||||||
|
FValidatorClass : TValidatorClass;
|
||||||
|
FSoftValidation : Boolean;
|
||||||
|
FMask : String;
|
||||||
|
FLastValid : Boolean;
|
||||||
|
FLastErrorCode : Word;
|
||||||
|
FBeepOnError : Boolean;
|
||||||
|
FInputRequired : Boolean;
|
||||||
|
FEnableHooking : Boolean;
|
||||||
|
FUpdating : Integer;
|
||||||
|
|
||||||
|
{Event for which this object will execute a validation}
|
||||||
|
FEvent : TValidationEvent;
|
||||||
|
|
||||||
|
{WndProc Pointers}
|
||||||
|
NewWndProc : Pointer;
|
||||||
|
PrevWndProc : Pointer;
|
||||||
|
|
||||||
|
procedure HookControl;
|
||||||
|
procedure UnHookControl;
|
||||||
|
procedure voWndProc(var Msg : TMessage);
|
||||||
|
|
||||||
|
procedure RecreateHookedWnd;
|
||||||
|
function Validate: Boolean;
|
||||||
|
|
||||||
|
procedure AssignValidator;
|
||||||
|
procedure SetValidatorType(const VType: String);
|
||||||
|
procedure SetEvent(Event: TValidationEvent);
|
||||||
|
procedure SetEnableHooking(Value: Boolean);
|
||||||
|
|
||||||
|
property InputRequired: Boolean read FInputRequired write FInputRequired;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TWinControl); dynamic;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure AttachTo(Value : TWinControl);
|
||||||
|
procedure SetLastErrorCode(Code: Word);
|
||||||
|
procedure SetLastValid(Valid: Boolean);
|
||||||
|
|
||||||
|
procedure BeginUpdate;
|
||||||
|
procedure EndUpdate;
|
||||||
|
|
||||||
|
property LastValid: Boolean read FLastValid;
|
||||||
|
property LastErrorCode: Word read FLastErrorCode;
|
||||||
|
property EnableHooking: Boolean read FEnableHooking write SetEnableHooking;
|
||||||
|
property ValidatorClass: TValidatorClass read FValidatorClass
|
||||||
|
write FValidatorClass;
|
||||||
|
published
|
||||||
|
property BeepOnError: Boolean read FBeepOnError write FBeepOnError;
|
||||||
|
|
||||||
|
|
||||||
|
property SoftValidation: Boolean read FSoftValidation write FSoftValidation;
|
||||||
|
|
||||||
|
property ValidationEvent: TValidationEvent read FEvent write SetEvent
|
||||||
|
stored true;
|
||||||
|
property ValidatorType : string
|
||||||
|
read FValidatorType write SetValidatorType stored true;
|
||||||
|
property ValidationType: TValidationType
|
||||||
|
read FValidationType write FValidationType stored true;
|
||||||
|
property Mask: String read FMask write FMask stored true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{===== TValidatorOptions =============================================}
|
||||||
|
constructor TValidatorOptions.Create(AOwner: TWinControl);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FOwner := AOwner;
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{create a callable window proc pointer}
|
||||||
|
{$IFDEF VERSION6}
|
||||||
|
NewWndProc := Classes.MakeObjectInstance(voWndProc);
|
||||||
|
{$ELSE}
|
||||||
|
NewWndProc := MakeObjectInstance(voWndProc);
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
ValidatorType := 'None';
|
||||||
|
FSoftValidation := false;
|
||||||
|
ValidationType := vtNone;
|
||||||
|
ValidationEvent := veOnExit;
|
||||||
|
FInputRequired := false;
|
||||||
|
FEnableHooking := true;
|
||||||
|
BeepOnError := true;
|
||||||
|
FValidatorClass := nil;
|
||||||
|
FMask := '';
|
||||||
|
FLastValid := false;
|
||||||
|
FLastErrorCode := 0;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TValidatorOptions.Destroy;
|
||||||
|
begin
|
||||||
|
UnhookControl;
|
||||||
|
FValidatorClass := nil;
|
||||||
|
inherited destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.HookControl;
|
||||||
|
var
|
||||||
|
P : Pointer;
|
||||||
|
begin
|
||||||
|
if not FEnableHooking then exit;
|
||||||
|
{hook into owner's window procedure}
|
||||||
|
if (FHookedControl <> nil) then begin
|
||||||
|
if not FHookedControl.HandleAllocated then FHookedControl.HandleNeeded;
|
||||||
|
{save original window procedure if not already saved}
|
||||||
|
P := Pointer(GetWindowLong(FHookedControl.Handle, GWL_WNDPROC));
|
||||||
|
if (P <> NewWndProc) then begin
|
||||||
|
PrevWndProc := P;
|
||||||
|
{redirect message handling to ours}
|
||||||
|
SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LongInt(NewWndProc));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.UnHookControl;
|
||||||
|
begin
|
||||||
|
if (FHookedControl <> nil) then begin
|
||||||
|
if Assigned(PrevWndProc) and FHookedControl.HandleAllocated then
|
||||||
|
SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LongInt(PrevWndProc));
|
||||||
|
end;
|
||||||
|
PrevWndProc := nil;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.AttachTo(Value : TWinControl);
|
||||||
|
var
|
||||||
|
WC : TWinControl;
|
||||||
|
begin
|
||||||
|
if not FEnableHooking then Exit;
|
||||||
|
|
||||||
|
FHookedControl := Value;
|
||||||
|
|
||||||
|
{unhook from attached control's window procedure}
|
||||||
|
UnHookControl;
|
||||||
|
|
||||||
|
{insure that we are the only one to hook to this control}
|
||||||
|
if not (csLoading in FOwner.ComponentState) and Assigned(Value) then begin
|
||||||
|
{send message asking if this control is attached to anything}
|
||||||
|
{the control itself won't be able to respond unless it is attached}
|
||||||
|
{in which case, it will be our hook into the window procedure that}
|
||||||
|
{is actually responding}
|
||||||
|
|
||||||
|
if not Value.HandleAllocated then
|
||||||
|
Value.HandleNeeded;
|
||||||
|
|
||||||
|
if Value.HandleAllocated then begin
|
||||||
|
WC := TWinControl(SendMessage(Value.Handle, OM_ISATTACHED, 0, 0));
|
||||||
|
if Assigned(WC) then
|
||||||
|
raise EOvcException.CreateFmt(GetOrphStr(SCControlAttached),
|
||||||
|
[WC.Name])
|
||||||
|
else
|
||||||
|
HookControl;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.SetEvent(Event: TValidationEvent);
|
||||||
|
begin
|
||||||
|
if Event <> FEvent then
|
||||||
|
FEvent := Event;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.SetEnableHooking(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FEnableHooking <> Value then begin
|
||||||
|
FEnableHooking := Value;
|
||||||
|
if FEnableHooking and (FHookedControl <> nil) then
|
||||||
|
AttachTo(FHookedControl);
|
||||||
|
end else
|
||||||
|
UnHookControl;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.RecreateHookedWnd;
|
||||||
|
begin
|
||||||
|
if not (csDestroying in FHookedControl.ComponentState) then
|
||||||
|
PostMessage(FHookedControl.Handle, OM_RECREATEWND, 0, 0);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.voWndProc(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
with Msg do begin
|
||||||
|
case FEvent of
|
||||||
|
veOnEnter : if Msg = CM_ENTER then
|
||||||
|
Validate;
|
||||||
|
|
||||||
|
veOnExit : if Msg = CM_EXIT then
|
||||||
|
if (not Validate) and (not FSoftValidation) then
|
||||||
|
FHookedControl.SetFocus;
|
||||||
|
|
||||||
|
{TextChanged}
|
||||||
|
veOnChange : if Msg = 48435 then
|
||||||
|
Validate;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Pass the message on...}
|
||||||
|
if PrevWndProc <> nil then
|
||||||
|
Result := CallWindowProc(PrevWndProc, FHookedControl.Handle, Msg,
|
||||||
|
WParam, LParam)
|
||||||
|
else
|
||||||
|
Result := CallWindowProc(TProtectedControl(FHookedControl).DefWndProc,
|
||||||
|
FHookedControl.Handle, Msg, wParam, lParam);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.AssignValidator;
|
||||||
|
begin
|
||||||
|
if (FValidatorType = 'None') or (FValidatorType = '')then
|
||||||
|
FValidatorClass := nil
|
||||||
|
else try
|
||||||
|
FValidatorClass := TValidatorClass(FindClass(FValidatorType));
|
||||||
|
except
|
||||||
|
FValidatorClass := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.SetLastErrorCode(Code: Word);
|
||||||
|
begin
|
||||||
|
FLastErrorCode := Code;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TValidatorOptions.Validate: Boolean;
|
||||||
|
begin
|
||||||
|
{Don't validate if we're in the middle of updates.}
|
||||||
|
if FUpdating > 0 then begin
|
||||||
|
result := true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Send a Validate message to the Owner}
|
||||||
|
SetLastErrorCode(SendMessage(FOwner.Handle, OM_VALIDATE, 0, 0));
|
||||||
|
SetLastValid(FLastErrorCode = 0);
|
||||||
|
result := FLastValid;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TValidatorOptions.SetLastValid(Valid: Boolean);
|
||||||
|
begin
|
||||||
|
FLastValid := Valid;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.BeginUpdate;
|
||||||
|
begin
|
||||||
|
Inc(FUpdating);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.EndUpdate;
|
||||||
|
begin
|
||||||
|
Dec(FUpdating);
|
||||||
|
if FUpdating < 0 then
|
||||||
|
FUpdating := 0;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TValidatorOptions.SetValidatorType(const VType: String);
|
||||||
|
begin
|
||||||
|
if FValidatorType <> VType then begin
|
||||||
|
FValidatorType := VType;
|
||||||
|
AssignValidator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
99
components/orpheus/o32vlreg.pas
Normal file
99
components/orpheus/o32vlreg.pas
Normal file
@ -0,0 +1,99 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32VLREG.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32vlreg;
|
||||||
|
{Registration unit for the Orpheus Validator components.}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, O32Vldtr;
|
||||||
|
|
||||||
|
var
|
||||||
|
ValidatorList: TStrings;
|
||||||
|
|
||||||
|
procedure RegisterValidator(ValidatorClass: TValidatorClass);
|
||||||
|
procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
|
||||||
|
procedure GetRegisteredValidators(aList: TStrings);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure RegisterValidator(ValidatorClass: TValidatorClass);
|
||||||
|
begin
|
||||||
|
if ValidatorClass.InheritsFrom(TO32BaseValidator) then begin
|
||||||
|
if ValidatorList.IndexOf(ValidatorClass.ClassName) = -1 then begin
|
||||||
|
RegisterClass(TPersistentClass(ValidatorClass));
|
||||||
|
ValidatorList.Add(ValidatorClass.ClassName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
i := ValidatorList.IndexOf(ValidatorClass.ClassName);
|
||||||
|
if i > -1 then begin
|
||||||
|
ValidatorList.Delete(i);
|
||||||
|
UnRegisterClass(TPersistentClass(ValidatorClass));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure GetRegisteredValidators(aList: TStrings);
|
||||||
|
begin
|
||||||
|
Assert(Assigned(ValidatorList));
|
||||||
|
Assert(Assigned(aList));
|
||||||
|
|
||||||
|
aList.Clear;
|
||||||
|
aList.BeginUpdate;
|
||||||
|
aList.Assign(ValidatorList);
|
||||||
|
aList.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
ValidatorList := TStringList.Create;
|
||||||
|
ValidatorList.Add('None');
|
||||||
|
|
||||||
|
|
||||||
|
finalization
|
||||||
|
|
||||||
|
ValidatorList.Free;
|
||||||
|
|
||||||
|
end.
|
||||||
312
components/orpheus/o32vpool.pas
Normal file
312
components/orpheus/o32vpool.pas
Normal file
@ -0,0 +1,312 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* O32VPOOL.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit o32vpool;
|
||||||
|
{O32ValidatorPool component classes}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
OvcBase, Classes, Graphics, stdctrls, O32Vldtr, o32ovldr, o32pvldr, o32rxvld;
|
||||||
|
|
||||||
|
type
|
||||||
|
TO32ValidatorPool = class;
|
||||||
|
|
||||||
|
TVPoolNotifyEvent =
|
||||||
|
procedure (Sender: TObject; ValidatorItem: Integer) of object;
|
||||||
|
|
||||||
|
|
||||||
|
{ - TO32ValidatorItem - }
|
||||||
|
TO32ValidatorItem = class(TO32CollectionItem)
|
||||||
|
protected {private}
|
||||||
|
FValidator : TO32BaseValidator;
|
||||||
|
FValidationEvent : String;
|
||||||
|
FValidatorClass : TValidatorClass;
|
||||||
|
FValidatorType : String;
|
||||||
|
FBeepOnError : Boolean;
|
||||||
|
FMask : String;
|
||||||
|
|
||||||
|
{Component for which this item will validate}
|
||||||
|
FComponent : TCustomEdit;
|
||||||
|
FComponentColor : TColor;
|
||||||
|
FErrorColor : TColor;
|
||||||
|
{Event for which this object will execute a validation}
|
||||||
|
FEvent : TValidationEvent;
|
||||||
|
|
||||||
|
procedure DoValidation(Sender: TObject);
|
||||||
|
procedure SetComponent(Value: TCustomEdit);
|
||||||
|
procedure SetValidatorType(const Value: String);
|
||||||
|
procedure AssignValidator;
|
||||||
|
procedure SetEvent(Event: TValidationEvent);
|
||||||
|
procedure AssignEvent;
|
||||||
|
function ValidatorPool: TO32ValidatorPool;
|
||||||
|
public
|
||||||
|
constructor Create(Collection: TCollection); override;
|
||||||
|
property Validator: TO32BaseValidator
|
||||||
|
read FValidator write FValidator;
|
||||||
|
property ValidatorClass: TValidatorClass read FValidatorClass
|
||||||
|
write FValidatorClass;
|
||||||
|
published
|
||||||
|
property BeepOnError: Boolean
|
||||||
|
read FBeepOnError write FBeepOnError;
|
||||||
|
property Name;
|
||||||
|
property ErrorColor: TCOlor
|
||||||
|
read FErrorColor write FErrorColor;
|
||||||
|
property Component: TCustomEdit
|
||||||
|
read FComponent write SetComponent;
|
||||||
|
property Mask: String
|
||||||
|
read FMask write FMask;
|
||||||
|
property ValidationEvent: TValidationEvent
|
||||||
|
read FEvent write SetEvent;
|
||||||
|
property ValidatorType : string
|
||||||
|
read FValidatorType write SetValidatorType stored true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TO32Validators = class(TO32Collection)
|
||||||
|
protected {private}
|
||||||
|
FValidatorPool : TO32ValidatorPool;
|
||||||
|
function GetItem(Index: Integer): TO32ValidatorItem;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TPersistent;
|
||||||
|
ItemClass : TCollectionItemClass); override;
|
||||||
|
function AddItem(ValidatorClass: TValidatorClass): TCollectionItem;
|
||||||
|
procedure Delete(Index: Integer);
|
||||||
|
procedure DeleteByName(const Name: String);
|
||||||
|
function GetValidatorByName(const Name: String): TO32BaseValidator;
|
||||||
|
property ValidatorPool: TO32ValidatorPool
|
||||||
|
read FValidatorPool;
|
||||||
|
property Items[index: Integer]: TO32ValidatorItem
|
||||||
|
read GetItem;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ - TO32ValidatorPool - }
|
||||||
|
TO32ValidatorPool = class(TO32Component)
|
||||||
|
protected {private}
|
||||||
|
FValidators: TO32Validators;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
published
|
||||||
|
property Name;
|
||||||
|
property Validators: TO32Validators
|
||||||
|
read FValidators
|
||||||
|
write FValidators;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} SysUtils, Controls, Dialogs;
|
||||||
|
|
||||||
|
{===== TO32ValidatorPool =============================================}
|
||||||
|
|
||||||
|
constructor TO32ValidatorPool.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FValidators := TO32Validators.Create(self, TO32ValidatorItem);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TO32ValidatorPool.Destroy;
|
||||||
|
begin
|
||||||
|
FValidators.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{===== TO32Validators ================================================}
|
||||||
|
constructor TO32Validators.Create(AOwner : TPersistent;
|
||||||
|
ItemClass : TCollectionItemClass);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FValidatorPool := TO32ValidatorPool(AOwner);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32Validators.GetValidatorByName(const Name: String): TO32BaseValidator;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
for i := 0 to Count - 1 do begin
|
||||||
|
if TO32ValidatorItem(Items[i]).Name = Name then begin
|
||||||
|
result := TO32ValidatorItem(Items[i]).Validator;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
result := nil;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32Validators.AddItem(ValidatorClass: TValidatorClass):
|
||||||
|
TCollectionItem;
|
||||||
|
var
|
||||||
|
NewItem: TO32ValidatorItem;
|
||||||
|
begin
|
||||||
|
NewItem := TO32ValidatorItem(inherited Add);
|
||||||
|
NewItem.ValidatorClass := ValidatorClass;
|
||||||
|
NewItem.Validator := ValidatorClass.Create(FValidatorPool);
|
||||||
|
result := NewItem;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Validators.Delete(Index: Integer);
|
||||||
|
begin
|
||||||
|
TO32ValidatorItem(Items[Index]).Validator.Free;
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
inherited Delete(Index);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32Validators.DeleteByName(const Name: String);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
for i := 0 to Count - 1 do begin
|
||||||
|
if TO32ValidatorItem(Items[i]).Name = Name then begin
|
||||||
|
TO32ValidatorItem(Items[i]).Validator.Free;
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
inherited Delete(i);
|
||||||
|
{$ENDIF}
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32Validators.GetItem(Index : LongInt) : TO32ValidatorItem;
|
||||||
|
begin
|
||||||
|
result := TO32ValidatorItem(inherited GetItem(Index));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===== TO32ValidatorItem =============================================}
|
||||||
|
type
|
||||||
|
TProtectedCustomEdit = class(TCustomEdit);
|
||||||
|
TProtectedWinControl = class(TWinControl);
|
||||||
|
|
||||||
|
constructor TO32ValidatorItem.Create(Collection: TCollection);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
SetName('ValidatorItem' + IntToStr(Collection.Count));
|
||||||
|
FErrorColor := clRed;
|
||||||
|
FBeepOnError := true;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.DoValidation(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if not (csDesigning in ValidatorPool.ComponentState)
|
||||||
|
and (FValidator <> nil) then begin
|
||||||
|
{ set the validator's values }
|
||||||
|
FValidator.Mask := FMask;
|
||||||
|
FValidator.Input := FComponent.Text;
|
||||||
|
{ execute validation }
|
||||||
|
if not FValidator.IsValid then begin
|
||||||
|
{ beep or not }
|
||||||
|
if BeepOnError then MessageBeep(0);
|
||||||
|
TProtectedCustomEdit(FComponent).Color := FErrorColor;
|
||||||
|
FComponent.SetFocus;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (FComponent is TCustomEdit) then
|
||||||
|
TProtectedCustomEdit(FComponent).Color := FComponentColor;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.SetComponent(Value: TCustomEdit);
|
||||||
|
begin
|
||||||
|
if (Value is TCustomEdit) and (FComponent <> Value) then begin
|
||||||
|
FComponent := Value;
|
||||||
|
FComponentColor := TProtectedCustomEdit(FComponent).Color;
|
||||||
|
AssignEvent;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.SetEvent(Event: TValidationEvent);
|
||||||
|
begin
|
||||||
|
FEvent := Event;
|
||||||
|
AssignEvent;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.AssignEvent;
|
||||||
|
begin
|
||||||
|
if (FComponent <> nil) then
|
||||||
|
case FEvent of
|
||||||
|
veOnChange:
|
||||||
|
TProtectedCustomEdit(FComponent).OnChange := DoValidation;
|
||||||
|
veOnEnter :
|
||||||
|
TProtectedCustomEdit(FComponent).OnEnter := DoValidation;
|
||||||
|
veOnExit :
|
||||||
|
TProtectedCustomEdit(FComponent).OnExit := DoValidation;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.SetValidatorType(const Value: string);
|
||||||
|
begin
|
||||||
|
if FValidatorType <> Value then begin
|
||||||
|
FValidatorType := Value;
|
||||||
|
AssignValidator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TO32ValidatorItem.AssignValidator;
|
||||||
|
begin
|
||||||
|
if (FValidatorType = 'None') or (FValidatorType = '')then
|
||||||
|
FValidatorClass := nil
|
||||||
|
else try
|
||||||
|
FValidatorClass := TValidatorClass(FindClass(FValidatorType));
|
||||||
|
except
|
||||||
|
FValidatorClass := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FValidatorClass <> nil then
|
||||||
|
FValidator
|
||||||
|
:= FValidatorClass.Create((Collection as TO32Validators).FValidatorPool);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TO32ValidatorItem.ValidatorPool: TO32ValidatorPool;
|
||||||
|
begin
|
||||||
|
Result := TO32Validators(Collection).FValidatorPool;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
end.
|
||||||
59
components/orpheus/orpheus.lpk
Normal file
59
components/orpheus/orpheus.lpk
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="2">
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Name Value="Orpheus"/>
|
||||||
|
<Author Value="Delphi version by TurboPower; ported to Lazarus by Phil Hess"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<D2Extensions Value="False"/>
|
||||||
|
<CStyleOperator Value="False"/>
|
||||||
|
<IncludeAssertionCode Value="True"/>
|
||||||
|
<AllowLabel Value="False"/>
|
||||||
|
<CPPInline Value="False"/>
|
||||||
|
<DelphiCompat Value="True"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<Other>
|
||||||
|
<WriteFPCLogo Value="False"/>
|
||||||
|
<CustomOptions Value="-dOrphChecksOn -dNoAsm
|
||||||
|
"/>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Description Value="Orpheus for Lazarus
|
||||||
|
"/>
|
||||||
|
<License Value="MPL 1.1
|
||||||
|
"/>
|
||||||
|
<Version Minor="1" Release="1"/>
|
||||||
|
<Files Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="myovcreg.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="MyOvcReg"/>
|
||||||
|
</Item1>
|
||||||
|
</Files>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<RequiredPkgs Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)\"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IgnoreBinaries Value="False"/>
|
||||||
|
</PublishOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
||||||
21
components/orpheus/orpheus.pas
Normal file
21
components/orpheus/orpheus.pas
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
{ This file was automatically created by Lazarus. Do not edit!
|
||||||
|
This source is only used to compile and install the package.
|
||||||
|
}
|
||||||
|
|
||||||
|
unit Orpheus;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
MyOvcReg, LazarusPackageIntf;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterUnit('MyOvcReg', @MyOvcReg.Register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterPackage('Orpheus', @Register);
|
||||||
|
end.
|
||||||
189
components/orpheus/ovc.inc
Normal file
189
components/orpheus/ovc.inc
Normal file
@ -0,0 +1,189 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVC.INC *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{Conditional defines that affect compilation}
|
||||||
|
|
||||||
|
(*
|
||||||
|
{$Q-} {Overflow Checking}
|
||||||
|
{$R-} {Range-Checking}
|
||||||
|
{$S-} {Stack-Overflow Checking}
|
||||||
|
*)
|
||||||
|
|
||||||
|
{$IFDEF OrphChecksOn}
|
||||||
|
{$Q+,R+,S+}
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF OrphChecksOff}
|
||||||
|
{$Q-,R-,S-}
|
||||||
|
{$ELSE}
|
||||||
|
{$IFOPT Q+}
|
||||||
|
{$Q+}
|
||||||
|
{$ELSE}
|
||||||
|
{$Q-}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFOPT R+}
|
||||||
|
{$R+}
|
||||||
|
{$ELSE}
|
||||||
|
{$R-}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFOPT S+}
|
||||||
|
{$S+}
|
||||||
|
{$ELSE}
|
||||||
|
{$S-}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$V-} {Var-String Checking}
|
||||||
|
{$T-} {No type-checked pointers}
|
||||||
|
{$X+} {Extended syntax}
|
||||||
|
{$P-} {No open string parameters}
|
||||||
|
{$B-} {Incomplete Boolean evaluation}
|
||||||
|
{$J+} {Writable constants}
|
||||||
|
{$H+} {Huge strings}
|
||||||
|
|
||||||
|
{General define indicating use under C++ Builder}
|
||||||
|
{$IFDEF VER93}
|
||||||
|
{$DEFINE CBuilder}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF VER110}
|
||||||
|
{$DEFINE CBuilder}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF VER125}
|
||||||
|
{$DEFINE CBuilder}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF VER130}
|
||||||
|
{$IFDEF BCB}
|
||||||
|
{$DEFINE CBuilder}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF VER140} {!!.04}
|
||||||
|
{$IFDEF BCB} {!!.04}
|
||||||
|
{$DEFINE CBuilder} {!!.04}
|
||||||
|
{$ObjExportAll On} {!!.04}
|
||||||
|
{$ENDIF} {!!.04}
|
||||||
|
{$ENDIF} {!!.04}
|
||||||
|
|
||||||
|
{$IFNDEF VER80} {Delphi 1.0}
|
||||||
|
{$DEFINE VERSION2} {Delphi 2.0 and BCB 1 or higher}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION2}
|
||||||
|
{$IFNDEF VER90} {Delphi 2.0}
|
||||||
|
{$IFNDEF VER93} {BCB 1.0}
|
||||||
|
{$DEFINE VERSION3} {Delphi 3.0 or BCB 3.0}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION3}
|
||||||
|
{$IFNDEF VER100} {Delphi 3}
|
||||||
|
{$IFNDEF VER110} {BCB 3}
|
||||||
|
{$DEFINE VERSION4} {Delphi 4.0 or higher}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
{$IFNDEF VER120} {Delphi 4}
|
||||||
|
{$IFNDEF VER125} {BCB 4}
|
||||||
|
{$DEFINE VERSION5} {Delphi 5.0 or higher}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
{$IFNDEF VER130} {Delphi 5}
|
||||||
|
{$IFNDEF VER135} {BCB 5}
|
||||||
|
{$DEFINE VERSION6} {Delphi 6.0 or higher}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION6}
|
||||||
|
{$IFNDEF VER140} {Delphi 6}
|
||||||
|
{$IFNDEF VER145} {BCB 6}
|
||||||
|
{$DEFINE VERSION7} {Delphi 7.0 or higher}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION2}
|
||||||
|
{$IFNDEF VERSION3}
|
||||||
|
{$DEFINE VERSION2ONLY}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION3}
|
||||||
|
{$IFNDEF VERSION4}
|
||||||
|
{$DEFINE VERSION3ONLY}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF Win32}
|
||||||
|
{$A+} {Word Align Data}
|
||||||
|
{$ELSE}
|
||||||
|
{$A-} {Byte Align Data}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VERSION6}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$WARN SYMBOL_PLATFORM OFF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF VERSION7}
|
||||||
|
{$B- Incomplete boolean evaluation}
|
||||||
|
{$H+ Long string support}
|
||||||
|
{$J+ Writeable typed constants}
|
||||||
|
{$P- No open string parameters}
|
||||||
|
{$T- No type-checked pointers}
|
||||||
|
{$V- No var string checking}
|
||||||
|
{$X+ Extended syntax}
|
||||||
|
{$Z1 Enumerations are word sized}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$WARN UNIT_PLATFORM OFF}
|
||||||
|
{$WARN UNSAFE_CODE OFF}
|
||||||
|
{$WARN UNSAFE_TYPE OFF}
|
||||||
|
{$WARN UNSAFE_CAST OFF}
|
||||||
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{ This define turns off all platform warnings in Delphi 6. Delphi 6 }
|
||||||
|
{ is cross-platform compatible with Kylix and all of Orpheus' Win32 }
|
||||||
|
{ only stuff causes the compiler to throw a truckload of platform }
|
||||||
|
{ warnings when rebuilding packages. }
|
||||||
|
|
||||||
|
{.$DEFINE ZeroDateAsNull}
|
||||||
|
{This define enables special handling for a zero date. If defined, }
|
||||||
|
{assigning 0 to a date field is treated the same as assigning the }
|
||||||
|
{constant "BadDate" (see manual) using the AsDateTime property. }
|
||||||
|
{Otherwise, 0 is treated as a valid date. (32-bit only) }
|
||||||
1291
components/orpheus/ovcabot0.lfm
Normal file
1291
components/orpheus/ovcabot0.lfm
Normal file
File diff suppressed because it is too large
Load Diff
1323
components/orpheus/ovcabot0.lrs
Normal file
1323
components/orpheus/ovcabot0.lrs
Normal file
File diff suppressed because it is too large
Load Diff
197
components/orpheus/ovcabot0.pas
Normal file
197
components/orpheus/ovcabot0.pas
Normal file
@ -0,0 +1,197 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCABOT0.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit Ovcabot0;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, Buttons, {$ENDIF}
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
|
||||||
|
{$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
|
||||||
|
ExtCtrls, OvcVer, OvcURL, {$IFDEF MSWINDOWS} ShellAPI; {$ELSE} Unix; {$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcfrmAboutForm = class(TForm)
|
||||||
|
Panel1: TPanel;
|
||||||
|
Image1: TImage;
|
||||||
|
btnOK: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
VisitUsLabel: TLabel;
|
||||||
|
lblTurboLink: TLabel;
|
||||||
|
Bevel3: TBevel;
|
||||||
|
GeneralNewsgroupsLabel: TLabel;
|
||||||
|
lblHelp: TLabel;
|
||||||
|
lblGeneralDiscussion: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
procedure btnOKClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure lblTurboLinkClick(Sender: TObject);
|
||||||
|
procedure lblHelpClick(Sender: TObject);
|
||||||
|
procedure lblGeneralDiscussionClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcAboutProperty = class(TStringProperty)
|
||||||
|
public
|
||||||
|
function GetAttributes: TPropertyAttributes;
|
||||||
|
override;
|
||||||
|
procedure Edit;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{$R *.DFM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOrAboutProperty ***}
|
||||||
|
|
||||||
|
function TOvcAboutProperty.GetAttributes: TPropertyAttributes;
|
||||||
|
begin
|
||||||
|
Result := [paDialog, paReadOnly];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcAboutProperty.Edit;
|
||||||
|
begin
|
||||||
|
with TOvcfrmAboutForm.Create(Application) do begin
|
||||||
|
try
|
||||||
|
ShowModal;
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** TEsAboutForm ***}
|
||||||
|
|
||||||
|
procedure TOvcfrmAboutForm.btnOKClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcfrmAboutForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Top := (Screen.Height - Height) div 3;
|
||||||
|
Left := (Screen.Width - Width) div 2;
|
||||||
|
|
||||||
|
lblTurboLink.Cursor := crHandPoint;
|
||||||
|
lblHelp.Cursor := crHandPoint;
|
||||||
|
lblGeneralDiscussion.Cursor := crHandPoint;
|
||||||
|
|
||||||
|
{$IFDEF LCL}
|
||||||
|
Image1.Transparent := False; //Default is True with Laz, False with Delphi
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcfrmAboutForm.lblTurboLinkClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
if ShellExecute(0, 'open', 'http://sourceforge.net/projects/tporpheus/',
|
||||||
|
{$ELSE}
|
||||||
|
if ShellExecute(0, 'open', PChar('http://sourceforge.net/projects/tporpheus/'),
|
||||||
|
{$ENDIF}
|
||||||
|
'', '', SW_SHOWNORMAL) <= 32
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
if Shell('Open http://sourceforge.net/projects/tporpheus/') = 127
|
||||||
|
{$ELSE}
|
||||||
|
if (GetBrowserPath = '') or
|
||||||
|
(Shell(GetBrowserPath + ' http://sourceforge.net/projects/tporpheus/') = 127)
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
then
|
||||||
|
ShowMessage('Error launching browser.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcfrmAboutForm.lblHelpClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if ShellExecute(0, 'open',
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
'http://sourceforge.net/forum/forum.php?forum_id=241874', '', '',
|
||||||
|
{$ELSE}
|
||||||
|
PChar('http://sourceforge.net/forum/forum.php?forum_id=241874'), '', '',
|
||||||
|
{$ENDIF}
|
||||||
|
SW_SHOWNORMAL) <= 32
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
if Shell('Open http://sourceforge.net/forum/forum.php?forum_id=241874') = 127
|
||||||
|
{$ELSE}
|
||||||
|
if (GetBrowserPath = '') or
|
||||||
|
(Shell(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241874') = 127)
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
then
|
||||||
|
ShowMessage('Error launching browser.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcfrmAboutForm.lblGeneralDiscussionClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if ShellExecute(0, 'open',
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
'http://sourceforge.net/forum/forum.php?forum_id=241873', '', '',
|
||||||
|
{$ELSE}
|
||||||
|
PChar('http://sourceforge.net/forum/forum.php?forum_id=241873'), '', '',
|
||||||
|
{$ENDIF}
|
||||||
|
SW_SHOWNORMAL) <= 32
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
if Shell('Open http://sourceforge.net/forum/forum.php?forum_id=241873') = 127
|
||||||
|
{$ELSE}
|
||||||
|
if (GetBrowserPath = '') or
|
||||||
|
(Shell(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241873') = 127)
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
then
|
||||||
|
ShowMessage('Error launching browser.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{$I Ovcabot0.lrs} {Include form's resource file}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
66
components/orpheus/ovcbase.lrs
Normal file
66
components/orpheus/ovcbase.lrs
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
LazarusResources.Add('ORTCCOMBOARROW','BMP',[
|
||||||
|
'BM'#162#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0','#0
|
||||||
|
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0
|
||||||
|
+#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#136#136
|
||||||
|
+#136#128#136#136#136#128#136#136#136#128#136#128#136#128#136#0#8#128#128#0#0
|
||||||
|
+#128#0#0#0#0#136#136#136#128#136#136#136#128#136#136#136#128#136#136#136#128
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('ORTCCHECKGLYPHS','BMP',[
|
||||||
|
'BM'#198#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0'*'#0#0#0#14#0#0#0#1#0#4#0#0#0#0#0'P'
|
||||||
|
+#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
|
||||||
|
+#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#215'www'
|
||||||
|
+'www'#215'wwwwww'#215'wwwwww'#0#0#0#15#255#255#255#255#255#247#15#255#255#255
|
||||||
|
+#255#255#247#15#255#255#255#255#255#247#0#0#0#7#136#136#136#136#136#247#7#136
|
||||||
|
+#136#136#136#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7
|
||||||
|
+#128#8#136#128#8#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7
|
||||||
|
+#128#0#136#0#8#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7
|
||||||
|
+#136#0#0#0#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136
|
||||||
|
+#128#0#8#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136
|
||||||
|
+#128#0#8#136#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7#136
|
||||||
|
+#0#0#0#136#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7#128#0
|
||||||
|
+#136#0#8#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#128#8#136
|
||||||
|
+#128#8#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136#136#136
|
||||||
|
+#136#136#247#7#128#8#128#8#128#247#0#0#0#7'wwwww'#247#7'wwwww'#247#7'wwwww'
|
||||||
|
+#247#0#0#0#0#0#0#0#0#0#7#0#0#0#0#0#0#7#0#0#0#0#0#0#7#0#0#0
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('ORBTNCLC','BMP',[
|
||||||
|
'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
|
||||||
|
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
|
||||||
|
+#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'0'#0#0#0
|
||||||
|
+#0'0'#0#0#8#136#136#136#136#0#0#0#8#8#8#153#152#0#0#0#8#136#136#136#136#0#0#0
|
||||||
|
+#8#8#8#8#8#0#0#0#8#136#136#136#136#0#0#0#8#0#0#0#8#0#0#0#8#0#14#14#8#0#0#0#8
|
||||||
|
+#0#0#0#8#0#0#0#8#136#136#136#136#0#0#0'0'#0#0#0#0'0'#0#0
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('ORCOLUMNMOVECURSOR','CUR',[
|
||||||
|
#0#0#2#0#1#0' '#0#0#0#0#0#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1#0
|
||||||
|
+#1#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#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#31#224#0#0#31#224#0#0#31#224
|
||||||
|
+#0#0#31#224#0#0#31#224#0#0'_'#224#0#0#223#224#0#0#223#224#0#1#159#224#0#1#159
|
||||||
|
+#224#0#3#0#0#0#3#31#224#0'F'#31#224#0'f'#0#0#0'|'#0#0#0'|'#0#0#0''#192#0#0
|
||||||
|
+''#128#0#0''#0#0#0'~'#0#0#0'|'#0#0#0'x'#0#0#0'p'#0#0#0'`'#0#0#0'@'#0#0#0#0
|
||||||
|
+#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
|
||||||
|
+#255#255#255#255#192#15#255#255#223#239#255#255#223#239#255#255#223#239#255
|
||||||
|
+#255#223#239#255#255#159#239#255#255#31#239#255#254#31#239#255#254#31#239#255
|
||||||
|
+#252#31#239#255#252#31#239#255#248'@'#15#255'8@'#15#255#16#192#15#255#0#192
|
||||||
|
+#15#255#1#255#255#255#0#31#255#255#0#31#255#255#0'?'#255#255#0''#255#255#0
|
||||||
|
+#255#255#255#1#255#255#255#3#255#255#255#7#255#255#255#15#255#255#255#31#255
|
||||||
|
+#255#255'?'#255#255#255
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('ORROWMOVECURSOR','CUR',[
|
||||||
|
#0#0#2#0#1#0' '#0#0#0#0#0#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1#0
|
||||||
|
+#1#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#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#29#255#240#0
|
||||||
|
+#29#255#240#0#29#255#240#0#0#0#0#0#0#192#0#0#0#192#0#0#1#128#0#0#1#128#0#0#3
|
||||||
|
+#0#0#0#3#0#0#0'F'#0#0#0'f'#0#0#0'|'#0#0#0'|'#0#0#0''#192#0#0''#128#0#0''#0
|
||||||
|
+#0#0'~'#0#0#0'|'#0#0#0'x'#0#0#0'p'#0#0#0'`'#0#0#0'@'#0#0#0#0#0#0#0#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#192#0#7#255#193#255#247#255#193#255#247#255#193
|
||||||
|
+#255#247#255#192#0#7#255#254#31#255#255#254#31#255#255#252'?'#255#255#252'?'
|
||||||
|
+#255#255#248''#255#255'8'#255#255#16#255#255#255#0#255#255#255#1#255#255
|
||||||
|
+#255#0#31#255#255#0#31#255#255#0'?'#255#255#0''#255#255#0#255#255#255#1#255
|
||||||
|
+#255#255#3#255#255#255#7#255#255#255#15#255#255#255#31#255#255#255'?'#255#255
|
||||||
|
+#255
|
||||||
|
]);
|
||||||
2747
components/orpheus/ovcbase.pas
Normal file
2747
components/orpheus/ovcbase.pas
Normal file
File diff suppressed because it is too large
Load Diff
BIN
components/orpheus/ovcbase.res
Normal file
BIN
components/orpheus/ovcbase.res
Normal file
Binary file not shown.
1510
components/orpheus/ovcbcalc.pas
Normal file
1510
components/orpheus/ovcbcalc.pas
Normal file
File diff suppressed because it is too large
Load Diff
735
components/orpheus/ovcbordr.pas
Normal file
735
components/orpheus/ovcbordr.pas
Normal file
@ -0,0 +1,735 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCBORDR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcbordr;
|
||||||
|
{Old style, To be deprecated - simple, single, solid borders for entry
|
||||||
|
controls}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, OvcBase, OvcConst, OvcData,
|
||||||
|
OvcMisc, OvcEditF;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcBorderStyle = (bpsSolid);
|
||||||
|
|
||||||
|
TOvcBorderEdButton = class(TBitBtn)
|
||||||
|
public
|
||||||
|
procedure Click; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcBorder = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FEnabled : Boolean; {is border used}
|
||||||
|
FBorderStyle : TOvcBorderStyle; {bpsSolid only for now}
|
||||||
|
FPenColor : TColor; {color of pen}
|
||||||
|
FPenStyle : TPenStyle; {Windows pen style}
|
||||||
|
FPenWidth : integer; {width of pen}
|
||||||
|
|
||||||
|
FOnChange : TNotifyEvent; {notify owner of changes}
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure DoOnChange;
|
||||||
|
procedure SetDefaults;
|
||||||
|
|
||||||
|
procedure SetEnabled(Value : Boolean);
|
||||||
|
procedure SetBorderStyle(Value : TOvcBorderStyle);
|
||||||
|
procedure SetPenColor(Value : TColor);
|
||||||
|
procedure SetPenStyle(Value : TPenStyle);
|
||||||
|
procedure SetPenWidth(Value : integer);
|
||||||
|
|
||||||
|
public
|
||||||
|
procedure Assign(Value : TPersistent); override;
|
||||||
|
constructor Create;
|
||||||
|
|
||||||
|
published
|
||||||
|
property BorderStyle : TOvcBorderStyle
|
||||||
|
read FBorderStyle
|
||||||
|
write SetBorderStyle
|
||||||
|
stored FEnabled
|
||||||
|
default bpsSolid;
|
||||||
|
|
||||||
|
property Enabled : Boolean
|
||||||
|
read FEnabled
|
||||||
|
write SetEnabled
|
||||||
|
default False;
|
||||||
|
|
||||||
|
property OnChange : TNotifyEvent
|
||||||
|
read FOnChange
|
||||||
|
write FOnChange;
|
||||||
|
|
||||||
|
property PenColor : TColor
|
||||||
|
read FPenColor
|
||||||
|
write SetPenColor
|
||||||
|
stored FEnabled
|
||||||
|
default clBlack;
|
||||||
|
|
||||||
|
property PenStyle : TPenStyle
|
||||||
|
read FPenStyle
|
||||||
|
write SetPenStyle
|
||||||
|
stored FEnabled
|
||||||
|
default psSolid;
|
||||||
|
|
||||||
|
property PenWidth : integer
|
||||||
|
read FPenWidth
|
||||||
|
write SetPenWidth
|
||||||
|
stored FEnabled
|
||||||
|
default 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TOvcBorders = class(TPersistent)
|
||||||
|
protected {private}
|
||||||
|
FLeftBorder : TOvcBorder;
|
||||||
|
FRightBorder : TOvcBorder;
|
||||||
|
FTopBorder : TOvcBorder;
|
||||||
|
FBottomBorder : TOvcBorder;
|
||||||
|
|
||||||
|
public
|
||||||
|
procedure Assign(Source : TPersistent); override;
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
published
|
||||||
|
property BottomBorder : TOvcBorder
|
||||||
|
read FBottomBorder
|
||||||
|
write FBottomBorder;
|
||||||
|
|
||||||
|
property LeftBorder : TOvcBorder
|
||||||
|
read FLeftBorder
|
||||||
|
write FLeftBorder;
|
||||||
|
|
||||||
|
property RightBorder : TOvcBorder
|
||||||
|
read FRightBorder
|
||||||
|
write FRightBorder;
|
||||||
|
|
||||||
|
property TopBorder : TOvcBorder
|
||||||
|
read FTopBorder
|
||||||
|
write FTopBorder;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcBorderParent = class(TOvcCustomControl)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FBorders : TOvcBorders;
|
||||||
|
FEdit : TOvcCustomEdit;
|
||||||
|
FLabelInfo : TOvcLabelInfo;
|
||||||
|
|
||||||
|
FOrgHeight : integer;
|
||||||
|
|
||||||
|
protected
|
||||||
|
DefaultLabelPosition : TOvcLabelPosition;
|
||||||
|
DoingBorders : Boolean;
|
||||||
|
|
||||||
|
procedure BorderChanged(ABorder : TObject);
|
||||||
|
function GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure PaintBorders; virtual;
|
||||||
|
|
||||||
|
procedure WMSetFocus(var Msg : TWMSetFocus);
|
||||||
|
message WM_SETFOCUS;
|
||||||
|
procedure WMKillFocus(var Msg : TWMKillFocus);
|
||||||
|
message WM_KillFOCUS;
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure LabelChange(Sender : TObject);
|
||||||
|
procedure LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
procedure PositionLabel;
|
||||||
|
|
||||||
|
{VCL message methods}
|
||||||
|
procedure CMVisibleChanged(var Msg : TMessage);
|
||||||
|
message CM_VISIBLECHANGED;
|
||||||
|
|
||||||
|
procedure OrAssignLabel(var Msg : TMessage);
|
||||||
|
message OM_ASSIGNLABEL;
|
||||||
|
procedure OrPositionLabel(var Msg : TMessage);
|
||||||
|
message OM_POSITIONLABEL;
|
||||||
|
procedure OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
message OM_RECORDLABELPOSITION;
|
||||||
|
|
||||||
|
|
||||||
|
procedure CreateWnd;
|
||||||
|
override;
|
||||||
|
procedure Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
override;
|
||||||
|
|
||||||
|
public
|
||||||
|
ButtonWidth : integer;
|
||||||
|
DoShowButton : Boolean;
|
||||||
|
|
||||||
|
constructor Create(AOwner : TComponent);
|
||||||
|
override;
|
||||||
|
destructor Destroy;
|
||||||
|
override;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
||||||
|
override;
|
||||||
|
procedure SetEditControl(EC : TOvcCustomEdit); virtual;
|
||||||
|
|
||||||
|
property AttachedLabel : TOvcAttachedLabel
|
||||||
|
read GetAttachedLabel;
|
||||||
|
|
||||||
|
property Canvas;
|
||||||
|
|
||||||
|
property EditControl : TOvcCustomEdit
|
||||||
|
read FEdit
|
||||||
|
write FEdit;
|
||||||
|
|
||||||
|
published
|
||||||
|
property Borders : TOvcBorders
|
||||||
|
read FBorders
|
||||||
|
write FBorders;
|
||||||
|
|
||||||
|
property LabelInfo : TOvcLabelInfo
|
||||||
|
read FLabelInfo
|
||||||
|
write FLabelInfo;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
OvcBCalc;
|
||||||
|
|
||||||
|
procedure TOvcBorderEdButton.Click;
|
||||||
|
begin
|
||||||
|
TOvcBorderEdPopup(Parent).PopupOpen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{******************************************************************************}
|
||||||
|
{ TOvcBorder }
|
||||||
|
{******************************************************************************}
|
||||||
|
constructor TOvcBorder.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
SetDefaults;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.Assign(Value : TPersistent);
|
||||||
|
var
|
||||||
|
B : TOvcBorder absolute Value;
|
||||||
|
begin
|
||||||
|
if (Value <> nil) and (Value is TOvcBorder) then begin
|
||||||
|
Enabled := B.Enabled;
|
||||||
|
PenColor := B.PenColor;
|
||||||
|
PenStyle := B.PenStyle;
|
||||||
|
PenWidth := B.PenWidth;
|
||||||
|
end else
|
||||||
|
inherited Assign(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.DoOnChange;
|
||||||
|
begin
|
||||||
|
if (Assigned(FOnChange)) then
|
||||||
|
FOnChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetDefaults;
|
||||||
|
begin
|
||||||
|
FEnabled := False;
|
||||||
|
FPenColor := clBlack;
|
||||||
|
FPenStyle := psSolid;
|
||||||
|
FPenWidth := 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetBorderStyle(Value : TOvcBorderStyle);
|
||||||
|
begin
|
||||||
|
if (FBorderStyle <> Value) then begin
|
||||||
|
FBorderStyle := Value;
|
||||||
|
DoOnChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetEnabled(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if (FEnabled <> Value) then begin
|
||||||
|
FEnabled := Value;
|
||||||
|
DoOnChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetPenColor(Value : TColor);
|
||||||
|
begin
|
||||||
|
if (FPenColor <> Value) then begin
|
||||||
|
FPenColor := Value;
|
||||||
|
DoOnChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetPenStyle(Value : TPenStyle);
|
||||||
|
begin
|
||||||
|
if (FPenStyle <> Value) then begin
|
||||||
|
FPenStyle := Value;
|
||||||
|
DoOnChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorder.SetPenWidth(Value : integer);
|
||||||
|
begin
|
||||||
|
if (FPenWidth <> Value) and (Value > 0) then begin
|
||||||
|
FPenWidth := Value;
|
||||||
|
DoOnChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{******************************************************************************}
|
||||||
|
{ TOvcBorders }
|
||||||
|
{******************************************************************************}
|
||||||
|
|
||||||
|
constructor TOvcBorders.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FBottomBorder := TOvcBorder.Create;
|
||||||
|
FLeftBorder := TOvcBorder.Create;
|
||||||
|
FRightBorder := TOvcBorder.Create;
|
||||||
|
FTopBorder := TOvcBorder.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcBorders.Destroy;
|
||||||
|
begin
|
||||||
|
FBottomBorder.Free;
|
||||||
|
FBottomBorder := nil;
|
||||||
|
|
||||||
|
FLeftBorder.Free;
|
||||||
|
FLeftBorder := nil;
|
||||||
|
|
||||||
|
FRightBorder.Free;
|
||||||
|
FRightBorder := nil;
|
||||||
|
|
||||||
|
FTopBorder.Free;
|
||||||
|
FTopBorder := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorders.Assign(Source : TPersistent);
|
||||||
|
var
|
||||||
|
B : TOvcBorders absolute Source;
|
||||||
|
begin
|
||||||
|
if (Source <> nil) and (Source is TOvcBorders) then begin
|
||||||
|
FBottomBorder.Assign(B.BottomBorder);
|
||||||
|
FLeftBorder.Assign(B.LeftBorder);
|
||||||
|
FRightBorder.Assign(B.RightBorder);
|
||||||
|
FTopBorder.Assign(B.TopBorder);
|
||||||
|
end else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{******************************************************************************}
|
||||||
|
{ TOvcBorderParent }
|
||||||
|
{******************************************************************************}
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.BorderChanged(ABorder : TObject);
|
||||||
|
begin
|
||||||
|
PaintBorders;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.CMVisibleChanged(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if LabelInfo.Visible then
|
||||||
|
AttachedLabel.Visible := Visible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TOvcBorderParent.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
Parent := TWinControl(AOwner);
|
||||||
|
|
||||||
|
Height := 21;
|
||||||
|
Width := 121;
|
||||||
|
|
||||||
|
FOrgHeight := 21;
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
ParentColor := True;
|
||||||
|
Ctl3D := False;
|
||||||
|
|
||||||
|
|
||||||
|
{set default position and reference point}
|
||||||
|
DefaultLabelPosition := lpTopLeft;
|
||||||
|
|
||||||
|
FLabelInfo := TOvcLabelInfo.Create;
|
||||||
|
FLabelInfo.OnChange := LabelChange;
|
||||||
|
FLabelInfo.OnAttach := LabelAttach;
|
||||||
|
|
||||||
|
{create borders class and assign notifications}
|
||||||
|
FBorders := TOvcBorders.Create;
|
||||||
|
|
||||||
|
FBorders.LeftBorder.OnChange := BorderChanged;
|
||||||
|
FBorders.RightBorder.OnChange := BorderChanged;
|
||||||
|
FBorders.TopBorder.OnChange := BorderChanged;
|
||||||
|
FBorders.BottomBorder.OnChange := BorderChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcBorderParent.Destroy;
|
||||||
|
begin
|
||||||
|
{detatch and destroy label, if any}
|
||||||
|
FLabelInfo.Visible := False;
|
||||||
|
|
||||||
|
{dispose the borders object}
|
||||||
|
FBorders.Free;
|
||||||
|
FLabelInfo.Free;
|
||||||
|
FBorders := nil;
|
||||||
|
FLabelInfo := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcBorderParent.GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
begin
|
||||||
|
if not FLabelInfo.Visible then
|
||||||
|
raise Exception.Create(GetOrphStr(SCLabelNotAttached));
|
||||||
|
|
||||||
|
Result := FLabelInfo.ALabel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.WMSetFocus(var Msg : TWMSetFocus);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if (Assigned(FEdit)) then
|
||||||
|
FEdit.SetFocus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.WMKillFocus(var Msg : TWMKillFocus);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
S :string;
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Value then begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
|
||||||
|
FLabelInfo.ALabel.Parent := Parent;
|
||||||
|
|
||||||
|
S := GenerateComponentName(PF, Name + 'Label');
|
||||||
|
FLabelInfo.ALabel.Name := S;
|
||||||
|
FLabelInfo.ALabel.Caption := S;
|
||||||
|
|
||||||
|
FLabelInfo.SetOffsets(0, 0);
|
||||||
|
PositionLabel;
|
||||||
|
FLabelInfo.ALabel.BringToFront;
|
||||||
|
{turn off auto size}
|
||||||
|
TLabel(FLabelInfo.ALabel).AutoSize := False;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.LabelChange(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited CreateWnd;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
|
||||||
|
if Operation = opRemove then begin
|
||||||
|
if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
|
||||||
|
FLabelInfo.FVisible := False;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.OrAssignLabel(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.OrPositionLabel(var Msg : TMessage);
|
||||||
|
const
|
||||||
|
DX : Integer = 0;
|
||||||
|
DY : Integer = 0;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
|
||||||
|
end else begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top - Top - Height;
|
||||||
|
end;
|
||||||
|
if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
|
||||||
|
{if the label was cut and then pasted, this will complete the reattachment}
|
||||||
|
FLabelInfo.FVisible := True;
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
|
||||||
|
else
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top - Top - Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.PositionLabel;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end else begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY + Top + Height,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
begin
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
|
||||||
|
if not HandleAllocated then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if HandleAllocated then
|
||||||
|
PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.SetEditControl(EC : TOvcCustomEdit);
|
||||||
|
begin
|
||||||
|
FEdit := EC;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.Paint;
|
||||||
|
begin
|
||||||
|
PaintBorders;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcBorderParent.PaintBorders;
|
||||||
|
var
|
||||||
|
R : TRect;
|
||||||
|
C : TCanvas;
|
||||||
|
W : integer;
|
||||||
|
BW : integer;
|
||||||
|
begin
|
||||||
|
Height := FOrgHeight;
|
||||||
|
|
||||||
|
|
||||||
|
C := Canvas;
|
||||||
|
if DoShowButton then
|
||||||
|
W := ButtonWidth + 4
|
||||||
|
else
|
||||||
|
W := 0;
|
||||||
|
|
||||||
|
if (FBorders.LeftBorder.Enabled) then
|
||||||
|
FEdit.Left := FBorders.LeftBorder.PenWidth
|
||||||
|
else
|
||||||
|
FEdit.Left := 0;
|
||||||
|
|
||||||
|
if (FBorders.TopBorder.Enabled) then
|
||||||
|
FEdit.Top := FBorders.TopBorder.PenWidth
|
||||||
|
else
|
||||||
|
FEdit.Top := 0;
|
||||||
|
|
||||||
|
if (not (FBorders.LeftBorder.Enabled or FBorders.RightBorder.Enabled)) then
|
||||||
|
FEdit.Width := Width
|
||||||
|
else begin
|
||||||
|
BW := W;
|
||||||
|
if (FBorders.LeftBorder.Enabled) then
|
||||||
|
BW := FBorders.LeftBorder.PenWidth;
|
||||||
|
if (FBorders.RightBorder.Enabled) then
|
||||||
|
BW := BW + FBorders.RightBorder.PenWidth;
|
||||||
|
FEdit.Width := Width - BW;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (not (FBorders.TopBorder.Enabled or FBorders.BottomBorder.Enabled)) then
|
||||||
|
{ Height := FEdit.Height}
|
||||||
|
FEdit.Height := Height
|
||||||
|
else begin
|
||||||
|
BW := 0;
|
||||||
|
if (FBorders.TopBorder.Enabled) then
|
||||||
|
BW := FBorders.TopBorder.PenWidth;
|
||||||
|
if (FBorders.BottomBorder.Enabled) then
|
||||||
|
BW := BW + FBorders.BottomBorder.PenWidth;
|
||||||
|
|
||||||
|
FEdit.Height := Height - BW;
|
||||||
|
end;
|
||||||
|
|
||||||
|
R.Left := 0;
|
||||||
|
R.Top := 0;
|
||||||
|
R.Right := Width;
|
||||||
|
R.Bottom := Height;
|
||||||
|
|
||||||
|
if (Assigned(FBorders.FLeftBorder)) then begin
|
||||||
|
if (FBorders.LeftBorder.Enabled) then begin
|
||||||
|
C.Pen.Color := FBorders.LeftBorder.PenColor;
|
||||||
|
C.Pen.Width := FBorders.LeftBorder.PenWidth;
|
||||||
|
C.Pen.Style := FBorders.LeftBorder.PenStyle;
|
||||||
|
|
||||||
|
C.MoveTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Top);
|
||||||
|
C.LineTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Bottom);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Assigned(FBorders.FRightBorder)) then begin
|
||||||
|
if (FBorders.RightBorder.Enabled) then begin
|
||||||
|
C.Pen.Color := FBorders.RightBorder.PenColor;
|
||||||
|
C.Pen.Width := FBorders.RightBorder.PenWidth;
|
||||||
|
C.Pen.Style := FBorders.RightBorder.PenStyle;
|
||||||
|
|
||||||
|
if ((FBorders.RightBorder.PenWidth mod 2) = 0) then begin
|
||||||
|
C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Top);
|
||||||
|
C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Bottom);
|
||||||
|
end else begin
|
||||||
|
C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Top);
|
||||||
|
C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Bottom);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Assigned(FBorders.FTopBorder)) then begin
|
||||||
|
if (FBorders.TopBorder.Enabled) then begin
|
||||||
|
C.Pen.Color := FBorders.TopBorder.PenColor;
|
||||||
|
C.Pen.Width := FBorders.TopBorder.PenWidth;
|
||||||
|
C.Pen.Style := FBorders.TopBorder.PenStyle;
|
||||||
|
|
||||||
|
C.MoveTo(R.Left, R.Top + (FBorders.TopBorder.PenWidth div 2));
|
||||||
|
C.LineTo(R.Right, R.Top + (FBorders.TopBorder.PenWidth div 2));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Assigned(FBorders.FBottomBorder)) then begin
|
||||||
|
if (FBorders.BottomBorder.Enabled) then begin
|
||||||
|
C.Pen.Color := FBorders.BottomBorder.PenColor;
|
||||||
|
C.Pen.Width := FBorders.BottomBorder.PenWidth;
|
||||||
|
C.Pen.Style := FBorders.BottomBorder.PenStyle;
|
||||||
|
|
||||||
|
if ((FBorders.BottomBorder.PenWidth mod 2) = 0) then begin
|
||||||
|
C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
|
||||||
|
C.LineTo(R.Right - (FBorders.BottomBorder.PenWidth div 2),
|
||||||
|
R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
|
||||||
|
end else begin
|
||||||
|
C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
|
||||||
|
C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (Assigned(FEdit)) then
|
||||||
|
FEdit.Refresh;
|
||||||
|
ValidateRect(Handle, @R);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
1758
components/orpheus/ovccal.pas
Normal file
1758
components/orpheus/ovccal.pas
Normal file
File diff suppressed because it is too large
Load Diff
2685
components/orpheus/ovccalc.pas
Normal file
2685
components/orpheus/ovccalc.pas
Normal file
File diff suppressed because it is too large
Load Diff
690
components/orpheus/ovccaret.pas
Normal file
690
components/orpheus/ovccaret.pas
Normal file
@ -0,0 +1,690 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCCARET.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Short-circuit Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovccaret;
|
||||||
|
{-Caret handling class}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF}
|
||||||
|
Graphics, Classes, Controls, Forms;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCaretShape = ( {Predefined caret shapes..}
|
||||||
|
csBlock, {..block over whole cell}
|
||||||
|
csHalfBlock, {..block over bottom part of cell}
|
||||||
|
csVertLine, {..vertical line to left of cell}
|
||||||
|
csHorzLine, {..horizontal line on bottom of cell}
|
||||||
|
csCustom, {..custom width/height}
|
||||||
|
csBitmap); {..bitmap caret, custom width/height}
|
||||||
|
|
||||||
|
TOvcCaretAlign = ( {Alignment of caret in cell..}
|
||||||
|
caLeft, {..left side, centered vertically}
|
||||||
|
caTop, {..top side, centered horizontally}
|
||||||
|
caRight, {..right side, centered vertically}
|
||||||
|
caBottom, {..bottom side, centered horizontally}
|
||||||
|
caCenter); {..centered vertically and horizontally}
|
||||||
|
|
||||||
|
type
|
||||||
|
{Class defining a caret shape}
|
||||||
|
TOvcCaret = class(TPersistent)
|
||||||
|
{.Z+}
|
||||||
|
protected
|
||||||
|
{property fields}
|
||||||
|
FAlign : TOvcCaretAlign; {Caret alignment in cell}
|
||||||
|
FBitmap : TBitmap; {Bitmap for a bitmapped caret}
|
||||||
|
FBitmapX : Integer; {Bitmap's hotspot X}
|
||||||
|
FBitmapY : Integer; {Bitmap's hotspot Y}
|
||||||
|
FBlinkTime : word; {Blink time}
|
||||||
|
FCaretHt : Integer; {Height: autosized for some shapes}
|
||||||
|
FCaretWd : Integer; {Width: autosized for some shapes}
|
||||||
|
FIsGray : boolean; {True if a 'gray' caret}
|
||||||
|
FShape : TOvcCaretShape; {Shape}
|
||||||
|
|
||||||
|
FOnChange : TNotifyEvent; {Owner's change notification}
|
||||||
|
|
||||||
|
{internal fields}
|
||||||
|
RefCount : word; {Reference count}
|
||||||
|
|
||||||
|
{property access methods}
|
||||||
|
procedure SetAlign(A : TOvcCaretAlign);
|
||||||
|
procedure SetBitmap(BM : TBitMap);
|
||||||
|
procedure SetBitmapX(X : Integer);
|
||||||
|
procedure SetBitmapY(Y : Integer);
|
||||||
|
procedure SetBlinkTime(BT : word);
|
||||||
|
procedure SetCaretHeight(CH : Integer);
|
||||||
|
procedure SetCaretWidth(CW : Integer);
|
||||||
|
procedure SetIsGray(IG : boolean);
|
||||||
|
procedure SetShape(S : TOvcCaretShape);
|
||||||
|
|
||||||
|
{general methods}
|
||||||
|
procedure NotifyChange;
|
||||||
|
|
||||||
|
public
|
||||||
|
{VCL methods}
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
{other methods}
|
||||||
|
procedure Register;
|
||||||
|
procedure Deregister;
|
||||||
|
|
||||||
|
{properties}
|
||||||
|
property OnChange : TNotifyEvent
|
||||||
|
read FOnChange
|
||||||
|
write FOnChange;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
property Bitmap : TBitmap
|
||||||
|
read FBitmap write SetBitmap;
|
||||||
|
property BitmapHotSpotX : Integer
|
||||||
|
read FBitmapX write SetBitmapX
|
||||||
|
default 0;
|
||||||
|
property BitmapHotSpotY : Integer
|
||||||
|
read FBitmapY write SetBitmapY
|
||||||
|
default 0;
|
||||||
|
property Shape : TOvcCaretShape
|
||||||
|
read FShape write SetShape
|
||||||
|
default csVertLine;
|
||||||
|
property Align : TOvcCaretAlign
|
||||||
|
read FAlign write SetAlign
|
||||||
|
default caLeft;
|
||||||
|
property BlinkTime : word
|
||||||
|
read FBlinkTime write SetBlinkTime
|
||||||
|
default 0;
|
||||||
|
property CaretHeight : Integer
|
||||||
|
read FCaretHt write SetCaretHeight
|
||||||
|
default 10;
|
||||||
|
property CaretWidth : Integer
|
||||||
|
read FCaretWd write SetCaretWidth
|
||||||
|
default 2;
|
||||||
|
property IsGray : boolean
|
||||||
|
read FIsGray write SetIsGray
|
||||||
|
default False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{.Z+}
|
||||||
|
type
|
||||||
|
TOvcSingleCaret = class(TPersistent)
|
||||||
|
{Class defining a Single caret}
|
||||||
|
protected
|
||||||
|
{property fields}
|
||||||
|
FCaretType : TOvcCaret; {Current caret type}
|
||||||
|
FHeight : Integer; {Cell height}
|
||||||
|
FLinked : boolean; {True if linked to owner}
|
||||||
|
FPos : TPoint; {Position within owner}
|
||||||
|
FVisible : boolean; {True if visible}
|
||||||
|
FWidth : Integer; {Cell width}
|
||||||
|
|
||||||
|
{other fields}
|
||||||
|
OrigBlinkTime : word; {Blink time before linking}
|
||||||
|
Owner : TWinControl; {Owning control}
|
||||||
|
XOffset : Integer; {X Offset of caret in cell}
|
||||||
|
YOffset : Integer; {Y Offset of caret in cell}
|
||||||
|
|
||||||
|
{property access methods}
|
||||||
|
procedure SetCaretType(CT : TOvcCaret);
|
||||||
|
procedure SetCellHeight(CH : Integer);
|
||||||
|
procedure SetCellWidth(CW : Integer);
|
||||||
|
procedure SetLinked(L : boolean);
|
||||||
|
procedure SetPos(P : TPoint);
|
||||||
|
procedure SetVisible(V : boolean);
|
||||||
|
|
||||||
|
{general methods}
|
||||||
|
procedure MakeShape;
|
||||||
|
procedure Reinit;
|
||||||
|
procedure ResetPos;
|
||||||
|
|
||||||
|
public
|
||||||
|
{VCL methods}
|
||||||
|
constructor Create(AOwner : TWinControl);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
{general methods}
|
||||||
|
procedure CaretTypeHasChanged(Sender : TObject);
|
||||||
|
|
||||||
|
{properties}
|
||||||
|
property CaretType : TOvcCaret
|
||||||
|
read FCaretType
|
||||||
|
write SetCaretType;
|
||||||
|
|
||||||
|
property CellHeight : Integer
|
||||||
|
read FHeight
|
||||||
|
write SetCellHeight;
|
||||||
|
|
||||||
|
property CellWidth : Integer
|
||||||
|
read FWidth
|
||||||
|
write SetCellWidth;
|
||||||
|
|
||||||
|
property Linked : boolean
|
||||||
|
read FLinked
|
||||||
|
write SetLinked
|
||||||
|
stored false;
|
||||||
|
|
||||||
|
property Position : TPoint
|
||||||
|
read FPos
|
||||||
|
write SetPos;
|
||||||
|
|
||||||
|
property Visible : boolean
|
||||||
|
read FVisible
|
||||||
|
write SetVisible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCaretPair = class(TOvcSingleCaret)
|
||||||
|
{Class defining a pair of carets, one each for insert/overwrite modes}
|
||||||
|
protected
|
||||||
|
{property fields}
|
||||||
|
FInsMode : boolean;
|
||||||
|
FInsCaretType : TOvcCaret;
|
||||||
|
FOvrCaretType : TOvcCaret;
|
||||||
|
|
||||||
|
{property access methods}
|
||||||
|
procedure SetInsMode(IM : boolean);
|
||||||
|
procedure SetInsCaretType(ICT : TOvcCaret);
|
||||||
|
procedure SetOvrCaretType(OCT : TOvcCaret);
|
||||||
|
|
||||||
|
public
|
||||||
|
{VCL methods}
|
||||||
|
constructor Create(AOwner : TWinControl);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
{properties}
|
||||||
|
property InsertMode : boolean
|
||||||
|
read FInsMode
|
||||||
|
write SetInsMode;
|
||||||
|
|
||||||
|
property InsCaretType : TOvcCaret
|
||||||
|
read FInsCaretType
|
||||||
|
write SetInsCaretType;
|
||||||
|
|
||||||
|
property OvrCaretType : TOvcCaret
|
||||||
|
read FOvrCaretType
|
||||||
|
write SetOvrCaretType;
|
||||||
|
end;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{---TOvcCaret----------------------------------------------------}
|
||||||
|
constructor TOvcCaret.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FShape := csVertLine;
|
||||||
|
FAlign := caLeft;
|
||||||
|
FBlinkTime := 0;
|
||||||
|
FIsGray := False;
|
||||||
|
FBitMap := TBitMap.Create;
|
||||||
|
FCaretHt := 10;
|
||||||
|
FCaretWd := 2;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
destructor TOvcCaret.Destroy;
|
||||||
|
begin
|
||||||
|
FBitMap.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.Deregister;
|
||||||
|
begin
|
||||||
|
{decrement the reference count, if no one references us
|
||||||
|
any more, kill ourselves}
|
||||||
|
dec(RefCount);
|
||||||
|
if (RefCount = 0) then
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.NotifyChange;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnChange) then
|
||||||
|
FOnChange(Self);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.Register;
|
||||||
|
begin
|
||||||
|
inc(RefCount);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetAlign(A : TOvcCaretAlign);
|
||||||
|
begin
|
||||||
|
if (A <> FAlign) then
|
||||||
|
begin
|
||||||
|
FAlign := A;
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetBitmap(BM : TBitmap);
|
||||||
|
begin
|
||||||
|
if not Assigned(BM) then
|
||||||
|
Exit;
|
||||||
|
FBitMap.Assign(BM);
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetBitmapX(X : Integer);
|
||||||
|
begin
|
||||||
|
if (X <> FBitMapX) then
|
||||||
|
begin
|
||||||
|
FBitMapX := X;
|
||||||
|
if (Shape = csBitMap) then
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetBitmapY(Y : Integer);
|
||||||
|
begin
|
||||||
|
if (Y <> FBitMapY) then
|
||||||
|
begin
|
||||||
|
FBitMapY := Y;
|
||||||
|
if (Shape = csBitMap) then
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetBlinkTime(BT : word);
|
||||||
|
begin
|
||||||
|
if (BT <> FBlinkTime) then
|
||||||
|
begin
|
||||||
|
FBlinkTime := BT;
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetCaretHeight(CH : Integer);
|
||||||
|
begin
|
||||||
|
if (CH <> FCaretHt) and (CH > 0) then
|
||||||
|
begin
|
||||||
|
FCaretHt := CH;
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetCaretWidth(CW : Integer);
|
||||||
|
begin
|
||||||
|
if (CW <> FCaretWd) and (CW > 0) then
|
||||||
|
begin
|
||||||
|
FCaretWd := CW;
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetIsGray(IG : boolean);
|
||||||
|
begin
|
||||||
|
if (IG <> FIsGray) then
|
||||||
|
begin
|
||||||
|
FIsGray := IG;
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaret.SetShape(S : TOvcCaretShape);
|
||||||
|
begin
|
||||||
|
if (S <> FShape) then
|
||||||
|
begin
|
||||||
|
FShape := S;
|
||||||
|
case FShape of
|
||||||
|
csBlock:
|
||||||
|
FAlign := caLeft;
|
||||||
|
csVertLine :
|
||||||
|
begin
|
||||||
|
FAlign := caLeft;
|
||||||
|
FCaretWd := 2;
|
||||||
|
end;
|
||||||
|
csHalfBlock:
|
||||||
|
FAlign := caBottom;
|
||||||
|
csHorzLine :
|
||||||
|
begin
|
||||||
|
FAlign := caBottom;
|
||||||
|
FCaretHt := 2;
|
||||||
|
end;
|
||||||
|
csBitmap :
|
||||||
|
begin
|
||||||
|
FCaretHt := FBitMap.Height;
|
||||||
|
FCaretWd := FBitMap.Width;
|
||||||
|
end;
|
||||||
|
end;{case}
|
||||||
|
NotifyChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------------------------------------------------------------------}
|
||||||
|
|
||||||
|
|
||||||
|
{---TOvcSingleCaret--------------------------------------------------}
|
||||||
|
constructor TOvcSingleCaret.Create(AOwner : TWinControl);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
Owner := AOwner;
|
||||||
|
|
||||||
|
FHeight := 10;
|
||||||
|
FWidth := 10;
|
||||||
|
|
||||||
|
{make our default caret type}
|
||||||
|
FCaretType := TOvcCaret.Create;
|
||||||
|
FCaretType.Register;
|
||||||
|
Reinit;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
destructor TOvcSingleCaret.Destroy;
|
||||||
|
begin
|
||||||
|
Visible := false;
|
||||||
|
Linked := false;
|
||||||
|
FCaretType.Deregister;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.CaretTypeHasChanged(Sender : TObject);
|
||||||
|
var
|
||||||
|
WasLinked : boolean;
|
||||||
|
begin
|
||||||
|
{if something has changed about the caret, unlink from
|
||||||
|
our owner, recalc our values, relink}
|
||||||
|
WasLinked := Linked;
|
||||||
|
Linked := false;
|
||||||
|
Reinit;
|
||||||
|
Linked := WasLinked;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.MakeShape;
|
||||||
|
begin
|
||||||
|
{don't bother if we aren't linked to anything or if we
|
||||||
|
don't have a caret type}
|
||||||
|
if (not Linked) or (not Assigned(FCaretType)) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{create the caret, and if necessary show it}
|
||||||
|
with FCaretType do
|
||||||
|
if (Shape = csBitmap) then
|
||||||
|
CreateCaret(Owner.Handle, Bitmap.Handle, 0, 0)
|
||||||
|
else CreateCaret(Owner.Handle, ord(IsGray), CaretWidth, CaretHeight);
|
||||||
|
if Visible then
|
||||||
|
ShowCaret(Owner.Handle);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.Reinit;
|
||||||
|
var
|
||||||
|
NewXOfs : Integer;
|
||||||
|
NewYOfs : Integer;
|
||||||
|
begin
|
||||||
|
{don't bother if we don't have a caret type}
|
||||||
|
if (not Assigned(FCaretType)) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{inits}
|
||||||
|
NewXOfs := 0;
|
||||||
|
NewYOfs := 0;
|
||||||
|
|
||||||
|
with FCaretType do
|
||||||
|
begin
|
||||||
|
{stop recursion}
|
||||||
|
OnChange := nil;
|
||||||
|
|
||||||
|
{recalc the caret type's height and width}
|
||||||
|
if (Shape <> csBitmap) and (Shape <> csCustom) then
|
||||||
|
begin
|
||||||
|
case Shape of
|
||||||
|
csBlock :
|
||||||
|
begin
|
||||||
|
CaretHeight := FHeight;
|
||||||
|
CaretWidth := FWidth;
|
||||||
|
end;
|
||||||
|
csHalfBlock:
|
||||||
|
begin
|
||||||
|
CaretHeight := FHeight div 2;
|
||||||
|
CaretWidth := FWidth;
|
||||||
|
end;
|
||||||
|
csVertLine : CaretHeight := FHeight;
|
||||||
|
csHorzLine : CaretWidth := FWidth;
|
||||||
|
end;{case}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{allow changes to percolate through again}
|
||||||
|
OnChange := CaretTypeHasChanged;
|
||||||
|
|
||||||
|
{recalc the X and Y offsets}
|
||||||
|
case Align of
|
||||||
|
caLeft : begin
|
||||||
|
NewXOfs := 0;
|
||||||
|
NewYOfs := (FHeight - CaretHeight) div 2;
|
||||||
|
end;
|
||||||
|
caTop : begin
|
||||||
|
NewXOfs := (FWidth - CaretWidth) div 2;
|
||||||
|
NewYOfs := 0;
|
||||||
|
end;
|
||||||
|
caRight : begin
|
||||||
|
NewXOfs := FWidth - CaretWidth;
|
||||||
|
NewYOfs := (FHeight - CaretHeight) div 2;;
|
||||||
|
end;
|
||||||
|
caBottom : begin
|
||||||
|
NewXOfs := (FWidth - CaretWidth) div 2;
|
||||||
|
NewYOfs := FHeight - CaretHeight;
|
||||||
|
end;
|
||||||
|
caCenter : begin
|
||||||
|
NewXOfs := (FWidth - CaretWidth) div 2;
|
||||||
|
NewYOfs := (FHeight - CaretHeight) div 2;
|
||||||
|
end;
|
||||||
|
end;{case}
|
||||||
|
if (Shape = csBitMap) then
|
||||||
|
begin
|
||||||
|
dec(NewXOfs, BitMapHotSpotX);
|
||||||
|
dec(NewYOfs, BitMapHotSpotY);
|
||||||
|
end;
|
||||||
|
if (NewXOfs <> XOffset) or (NewYOfs <> YOffset) then
|
||||||
|
begin
|
||||||
|
XOffset := NewXOfs;
|
||||||
|
YOffset := NewYOfs;
|
||||||
|
if Linked then
|
||||||
|
ResetPos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.ResetPos;
|
||||||
|
var
|
||||||
|
NewX, NewY : Integer;
|
||||||
|
begin
|
||||||
|
if (FPos.X = MaxInt) then
|
||||||
|
NewX := MaxInt
|
||||||
|
else NewX := FPos.X + XOffset;
|
||||||
|
if (FPos.Y = MaxInt) then
|
||||||
|
NewY := MaxInt
|
||||||
|
else NewY := FPos.Y + YOffset;
|
||||||
|
SetCaretPos(NewX, NewY);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetCaretType(CT : TOvcCaret);
|
||||||
|
begin
|
||||||
|
if (CT <> FCaretType) then
|
||||||
|
begin
|
||||||
|
FCaretType.Deregister;
|
||||||
|
FCaretType := CT;
|
||||||
|
FCaretType.Register;
|
||||||
|
FCaretType.OnChange := CaretTypeHasChanged;
|
||||||
|
CaretTypeHasChanged(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetCellHeight(CH : Integer);
|
||||||
|
begin
|
||||||
|
if (CH <> FHeight) and (CH > 0) then
|
||||||
|
begin
|
||||||
|
FHeight := CH;
|
||||||
|
CaretTypeHasChanged(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetCellWidth(CW : Integer);
|
||||||
|
begin
|
||||||
|
if (CW <> FWidth) and (CW > 0) then
|
||||||
|
begin
|
||||||
|
FWidth := CW;
|
||||||
|
CaretTypeHasChanged(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetLinked(L : boolean);
|
||||||
|
begin
|
||||||
|
if (L <> FLinked) then
|
||||||
|
begin
|
||||||
|
FLinked := L;
|
||||||
|
if Assigned(Owner) and Owner.HandleAllocated then
|
||||||
|
if FLinked then
|
||||||
|
begin
|
||||||
|
OrigBlinkTime := GetCaretBlinkTime;
|
||||||
|
MakeShape;
|
||||||
|
ResetPos;
|
||||||
|
if (OrigBlinkTime <> CaretType.BlinkTime) then
|
||||||
|
if (CaretType.BlinkTime <> 0) then
|
||||||
|
SetCaretBlinkTime(CaretType.BlinkTime);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
SetCaretBlinkTime(OrigBlinkTime);
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
DestroyCaret;
|
||||||
|
{$ELSE}
|
||||||
|
DestroyCaret(Owner.Handle);
|
||||||
|
{$ENDIF}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
FLinked := false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetPos(P : TPoint);
|
||||||
|
begin
|
||||||
|
if (P.X < 0) then
|
||||||
|
P.X := MaxInt;
|
||||||
|
if (P.Y < 0) then
|
||||||
|
P.Y := MaxInt;
|
||||||
|
if (P.X <> FPos.X) or (P.Y <> FPos.Y) then
|
||||||
|
begin
|
||||||
|
FPos := P;
|
||||||
|
if Linked then
|
||||||
|
ResetPos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSingleCaret.SetVisible(V : boolean);
|
||||||
|
begin
|
||||||
|
if (V <> FVisible) then
|
||||||
|
begin
|
||||||
|
FVisible := V;
|
||||||
|
if Linked then
|
||||||
|
if Owner.HandleAllocated then
|
||||||
|
if FVisible then
|
||||||
|
ShowCaret(Owner.Handle)
|
||||||
|
else
|
||||||
|
HideCaret(Owner.Handle);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{---TOvcCaretPair----------------------------------------------------}
|
||||||
|
constructor TOvcCaretPair.Create(AOwner : TWinControl);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
FInsCaretType := TOvcCaret.Create;
|
||||||
|
FInsCaretType.Register;
|
||||||
|
|
||||||
|
FOvrCaretType := TOvcCaret.Create;
|
||||||
|
FOvrCaretType.Register;
|
||||||
|
FOvrCaretType.Shape := csBlock;
|
||||||
|
|
||||||
|
FInsMode := True;
|
||||||
|
|
||||||
|
if FInsMode then
|
||||||
|
CaretType := FInsCaretType
|
||||||
|
else
|
||||||
|
CaretType := FOvrCaretType
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcCaretPair.Destroy;
|
||||||
|
begin
|
||||||
|
FInsCaretType.Deregister;
|
||||||
|
FOvrCaretType.Deregister;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCaretPair.SetInsMode(IM : boolean);
|
||||||
|
begin
|
||||||
|
if (IM <> FInsMode) then
|
||||||
|
begin
|
||||||
|
FInsMode := IM;
|
||||||
|
if FInsMode then
|
||||||
|
CaretType := FInsCaretType
|
||||||
|
else CaretType := FOvrCaretType;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaretPair.SetInsCaretType(ICT : TOvcCaret);
|
||||||
|
begin
|
||||||
|
if (ICT <> FInsCaretType) then
|
||||||
|
begin
|
||||||
|
FInsCaretType.Deregister;
|
||||||
|
FInsCaretType := ICT;
|
||||||
|
FInsCaretType.Register;
|
||||||
|
if InsertMode then
|
||||||
|
CaretType := FInsCaretType;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcCaretPair.SetOvrCaretType(OCT : TOvcCaret);
|
||||||
|
begin
|
||||||
|
if (OCT <> FOvrCaretType) then
|
||||||
|
begin
|
||||||
|
FOvrCaretType.Deregister;
|
||||||
|
FOvrCaretType := OCT;
|
||||||
|
FOvrCaretType.Register;
|
||||||
|
if not InsertMode then
|
||||||
|
CaretType := FOvrCaretType;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------------------------------------------------------------------}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
330
components/orpheus/ovcclrcb.pas
Normal file
330
components/orpheus/ovcclrcb.pas
Normal file
@ -0,0 +1,330 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCCLRCB.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcclrcb;
|
||||||
|
{-color ComboBox selector}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
|
||||||
|
Classes, Controls, Forms, Graphics, Menus, StdCtrls,
|
||||||
|
OvcCmbx, OvcConst, OvcData;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomColorComboBox = class(TOvcBaseComboBox)
|
||||||
|
protected {private}
|
||||||
|
{property Variables}
|
||||||
|
FShowColorNames : Boolean;
|
||||||
|
|
||||||
|
{internal variables}
|
||||||
|
BoxWidth : Integer;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetSelectedColor : TColor;
|
||||||
|
procedure SetSelectedColor(Value : TColor);
|
||||||
|
procedure SetShowColorNames(Value : Boolean);
|
||||||
|
function ColorFromString(Str: string): TColor;
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure CalculateBoxWidth;
|
||||||
|
|
||||||
|
{message methods}
|
||||||
|
procedure CMFontChanged(var Message : TMessage);
|
||||||
|
message CM_FONTCHANGED;
|
||||||
|
|
||||||
|
procedure CreateWnd; override;
|
||||||
|
|
||||||
|
property SelectedColor : TColor
|
||||||
|
read GetSelectedColor write SetSelectedColor;
|
||||||
|
property ShowColorNames : Boolean
|
||||||
|
read FShowColorNames write SetShowColorNames default True;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure DrawItem(Index : Integer; Rect : TRect; State : TOwnerDrawState);
|
||||||
|
override;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcColorComboBox = class(TOvcCustomColorComboBox)
|
||||||
|
published
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property About;
|
||||||
|
property Color;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property DropDownCount;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property HotTrack;
|
||||||
|
// property Items;
|
||||||
|
property ItemHeight;
|
||||||
|
property LabelInfo;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property SelectedColor default clBlack;
|
||||||
|
property ShowColorNames;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Text;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
{events}
|
||||||
|
property AfterEnter;
|
||||||
|
property AfterExit;
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnDropDown;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnSelectionChange;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnMouseWheel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.CalculateBoxWidth;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
X : Integer;
|
||||||
|
T : Integer;
|
||||||
|
begin
|
||||||
|
if not HandleAllocated or (BoxWidth > 0) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if not FShowColorNames then begin
|
||||||
|
BoxWidth := ClientWidth - 1;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Canvas.Font := Font;
|
||||||
|
BoxWidth := 0;
|
||||||
|
T := 0;
|
||||||
|
|
||||||
|
{calculate width of the color box}
|
||||||
|
for I := 0 to pred(Items.Count) do begin
|
||||||
|
X := Canvas.TextWidth(Items[I]+'X');
|
||||||
|
if X > T then
|
||||||
|
T := X;
|
||||||
|
end;
|
||||||
|
|
||||||
|
BoxWidth := ClientWidth - T;
|
||||||
|
if BoxWidth < 25 then
|
||||||
|
BoxWidth := 25;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.CMFontChanged(var Message : TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
BoxWidth := 0;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TOvcCustomColorComboBox.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
{disable MRU list}
|
||||||
|
FMRUList.MaxItems := 0;
|
||||||
|
|
||||||
|
Style := ocsDropDownList;
|
||||||
|
|
||||||
|
FShowColorNames := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcCustomColorComboBox.Destroy;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ - modified}
|
||||||
|
procedure TOvcCustomColorComboBox.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited CreateWnd;
|
||||||
|
|
||||||
|
Text := '';
|
||||||
|
Items.Clear;
|
||||||
|
Items.Add(GetOrphStr(SCColorBlack));
|
||||||
|
Items.Add(GetOrphStr(SCColorMaroon));
|
||||||
|
Items.Add(GetOrphStr(SCColorGreen));
|
||||||
|
Items.Add(GetOrphStr(SCColorOlive));
|
||||||
|
Items.Add(GetOrphStr(SCColorNavy));
|
||||||
|
Items.Add(GetOrphStr(SCColorPurple));
|
||||||
|
Items.Add(GetOrphStr(SCColorTeal));
|
||||||
|
Items.Add(GetOrphStr(SCColorGray));
|
||||||
|
Items.Add(GetOrphStr(SCColorSilver));
|
||||||
|
Items.Add(GetOrphStr(SCColorRed));
|
||||||
|
Items.Add(GetOrphStr(SCColorLime));
|
||||||
|
Items.Add(GetOrphStr(SCColorYellow));
|
||||||
|
Items.Add(GetOrphStr(SCColorBlue));
|
||||||
|
Items.Add(GetOrphStr(SCColorFuchsia));
|
||||||
|
Items.Add(GetOrphStr(SCColorAqua));
|
||||||
|
Items.Add(GetOrphStr(SCColorLightGray));
|
||||||
|
Items.Add(GetOrphStr(SCColorMediumGray));
|
||||||
|
Items.Add(GetOrphStr(SCColorDarkGray));
|
||||||
|
Items.Add(GetOrphStr(SCColorWhite));
|
||||||
|
Items.Add(GetOrphStr(SCColorMoneyGreen));
|
||||||
|
Items.Add(GetOrphStr(SCColorSkyBlue));
|
||||||
|
Items.Add(GetOrphStr(SCColorCream));
|
||||||
|
|
||||||
|
ItemIndex := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.DrawItem(Index : Integer; Rect : TRect;
|
||||||
|
State : TOwnerDrawState);
|
||||||
|
var
|
||||||
|
BC : TColor;
|
||||||
|
S : string;
|
||||||
|
begin
|
||||||
|
{get selected color and text to display}
|
||||||
|
if Index > -1 then begin
|
||||||
|
S := Items[Index];
|
||||||
|
BC := ColorFromString(S);
|
||||||
|
end else begin
|
||||||
|
S := GetOrphStr(SCColorBlack);
|
||||||
|
BC := clBlack;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CalculateBoxWidth;
|
||||||
|
|
||||||
|
Canvas.Font.Color := Font.Color;
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
|
||||||
|
if FShowColorNames then begin
|
||||||
|
Canvas.Pen.Color := Canvas.Brush.Color;
|
||||||
|
Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
|
||||||
|
Inc(Rect.Left);
|
||||||
|
DrawText(Canvas.Handle, @S[1], Length(S), Rect,
|
||||||
|
DT_LEFT or DT_VCENTER or DT_SINGLELINE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Canvas.Pen.Color := Font.Color;
|
||||||
|
Canvas.Brush.Color := BC;
|
||||||
|
Canvas.Rectangle(ClientWidth - BoxWidth, Rect.Top + 1, Rect.Right -1,
|
||||||
|
Rect.Bottom - 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomColorComboBox.GetSelectedColor : TColor;
|
||||||
|
begin
|
||||||
|
if ItemIndex > -1 then
|
||||||
|
Result := ColorFromString(Items[ItemIndex])
|
||||||
|
else
|
||||||
|
Result := clBlack;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
begin
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
BoxWidth := 0;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.SetSelectedColor(Value : TColor);
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Pred(Items.Count) do
|
||||||
|
if Value = ColorFromString(Items[I]) then begin
|
||||||
|
ItemIndex := I;
|
||||||
|
Change;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ - New}
|
||||||
|
function TOvcCustomColorComboBox.ColorFromString(Str: string):TColor;
|
||||||
|
begin
|
||||||
|
if Str = GetOrphStr(SCColorBlack) then result := clBlack
|
||||||
|
else if Str = GetOrphStr(SCColorMaroon) then result := clMaroon
|
||||||
|
else if Str = GetOrphStr(SCColorGreen) then result := clGreen
|
||||||
|
else if Str = GetOrphStr(SCColorOlive) then result := clOlive
|
||||||
|
else if Str = GetOrphStr(SCColorNavy) then result := clNavy
|
||||||
|
else if Str = GetOrphStr(SCColorPurple) then result := clPurple
|
||||||
|
else if Str = GetOrphStr(SCColorTeal) then result := clTeal
|
||||||
|
else if Str = GetOrphStr(SCColorGray) then result := clGray
|
||||||
|
else if Str = GetOrphStr(SCColorSilver) then result := clSilver
|
||||||
|
else if Str = GetOrphStr(SCColorRed) then result := clRed
|
||||||
|
else if Str = GetOrphStr(SCColorLime) then result := clLime
|
||||||
|
else if Str = GetOrphStr(SCColorYellow) then result := clYellow
|
||||||
|
else if Str = GetOrphStr(SCColorBlue) then result := clBlue
|
||||||
|
else if Str = GetOrphStr(SCColorFuchsia) then result := clFuchsia
|
||||||
|
else if Str = GetOrphStr(SCColorAqua) then result := clAqua
|
||||||
|
else if Str = GetOrphStr(SCColorLightGray) then result := TColor($C0C0C0)
|
||||||
|
else if Str = GetOrphStr(SCColorMediumGray) then result := TColor($A4A0A0)
|
||||||
|
else if Str = GetOrphStr(SCColorDarkGray) then result := TColor($808080)
|
||||||
|
else if Str = GetOrphStr(SCColorWhite) then result := clWhite
|
||||||
|
else if Str = GetOrphStr(SCColorMoneyGreen) then result := TColor($C0DCC0)
|
||||||
|
else if Str = GetOrphStr(SCColorSkyBlue) then result := TColor($F0CAA6)
|
||||||
|
else if Str = GetOrphStr(SCColorCream) then result := TColor($F0FBFF)
|
||||||
|
else result := clBlack;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomColorComboBox.SetShowColorNames(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShowColorNames then begin
|
||||||
|
FShowColorNames := Value;
|
||||||
|
BoxWidth := 0;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
1701
components/orpheus/ovccmbx.pas
Normal file
1701
components/orpheus/ovccmbx.pas
Normal file
File diff suppressed because it is too large
Load Diff
1494
components/orpheus/ovccmd.pas
Normal file
1494
components/orpheus/ovccmd.pas
Normal file
File diff suppressed because it is too large
Load Diff
200
components/orpheus/ovccolor.pas
Normal file
200
components/orpheus/ovccolor.pas
Normal file
@ -0,0 +1,200 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCCOLOR.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovccolor;
|
||||||
|
{-Color selection class}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} Classes, Graphics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcColors = class(TPersistent)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FBackColor : TColor; {background color}
|
||||||
|
FTextColor : TColor; {text or font color}
|
||||||
|
FUseDefault : Boolean; {true to use defaults}
|
||||||
|
|
||||||
|
{event variables}
|
||||||
|
FOnColorChange : TNotifyEvent;
|
||||||
|
|
||||||
|
{internal variables}
|
||||||
|
cDefBackColor : TColor; {default background}
|
||||||
|
cDefTextColor : TColor; {default text color}
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
procedure SetBackColor(Value: TColor);
|
||||||
|
{-set the color used for the background}
|
||||||
|
procedure SetTextColor(Value: TColor);
|
||||||
|
{-set the color used for the foreground}
|
||||||
|
procedure SetUseDefault(Value: Boolean);
|
||||||
|
{-set the flag to reset colors to parent default values}
|
||||||
|
|
||||||
|
procedure ReadUseDefault(Reader : TReader);
|
||||||
|
{-read the UseDefault property. for backward compatibility only}
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure DefineProperties(Filer : TFiler);
|
||||||
|
override;
|
||||||
|
|
||||||
|
procedure DoOnColorChange;
|
||||||
|
{-notify onwing object that a color has changed}
|
||||||
|
dynamic;
|
||||||
|
|
||||||
|
procedure ResetToDefaultColors;
|
||||||
|
{-assign default color values}
|
||||||
|
dynamic;
|
||||||
|
|
||||||
|
public
|
||||||
|
procedure Assign(Source : TPersistent);
|
||||||
|
override;
|
||||||
|
constructor Create(FG, BG : TColor);
|
||||||
|
virtual;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
property OnColorChange : TNotifyEvent
|
||||||
|
read FOnColorChange
|
||||||
|
write FOnColorChange;
|
||||||
|
|
||||||
|
published
|
||||||
|
property BackColor : TColor
|
||||||
|
read FBackColor
|
||||||
|
write SetBackColor;
|
||||||
|
|
||||||
|
property TextColor : TColor
|
||||||
|
read FTextColor
|
||||||
|
write SetTextColor;
|
||||||
|
|
||||||
|
property UseDefault : Boolean
|
||||||
|
read FUseDefault
|
||||||
|
write SetUseDefault
|
||||||
|
stored False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcColors ***}
|
||||||
|
|
||||||
|
procedure TOvcColors.Assign(Source : TPersistent);
|
||||||
|
var
|
||||||
|
C : TOvcColors absolute Source;
|
||||||
|
begin
|
||||||
|
if (Source <> nil) and (Source is TOvcColors) then begin
|
||||||
|
BackColor := C.BackColor;
|
||||||
|
TextColor := C.TextColor;
|
||||||
|
end else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TOvcColors.Create(FG, BG : TColor);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
cDefBackColor := BG;
|
||||||
|
cDefTextColor := FG;
|
||||||
|
FUseDefault := True;
|
||||||
|
|
||||||
|
{initialize to these colors}
|
||||||
|
ResetToDefaultColors;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.DefineProperties(Filer : TFiler);
|
||||||
|
begin
|
||||||
|
inherited DefineProperties(Filer);
|
||||||
|
{define a UseDefault property for compatibility with eariler versions}
|
||||||
|
Filer.DefineProperty('UseDefault', ReadUseDefault, nil, False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.DoOnColorChange;
|
||||||
|
{-notify onwing object that a color has changed}
|
||||||
|
begin
|
||||||
|
if Assigned(FOnColorChange) then
|
||||||
|
FOnColorChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.ReadUseDefault(Reader : TReader);
|
||||||
|
begin
|
||||||
|
{read property and discard it}
|
||||||
|
Reader.ReadBoolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.ResetToDefaultColors;
|
||||||
|
{-obtain default color values}
|
||||||
|
begin
|
||||||
|
FBackColor := cDefBackColor;
|
||||||
|
FTextColor := cDefTextColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.SetBackColor(Value: TColor);
|
||||||
|
{-set the color used for the background}
|
||||||
|
begin
|
||||||
|
if Value <> FBackColor then begin
|
||||||
|
if Value <> cDefBackColor then
|
||||||
|
FUseDefault := False;
|
||||||
|
FBackColor := Value;
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.SetTextColor(Value: TColor);
|
||||||
|
{-set the color used for the foreground}
|
||||||
|
begin
|
||||||
|
if Value <> FTextColor then begin
|
||||||
|
if Value <> cDefTextColor then
|
||||||
|
FUseDefault := False;
|
||||||
|
FTextColor := Value;
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcColors.SetUseDefault(Value: Boolean);
|
||||||
|
{-set the flag to reset colors to parent default values}
|
||||||
|
begin
|
||||||
|
FUseDefault := Value;
|
||||||
|
if FUseDefault then begin
|
||||||
|
ResetToDefaultColors; {assign default values}
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
604
components/orpheus/ovcconst.pas
Normal file
604
components/orpheus/ovcconst.pas
Normal file
@ -0,0 +1,604 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCCONST.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcconst;
|
||||||
|
{-Command and resource constants}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
{value used to offset string resource id's}
|
||||||
|
BaseOffset = 32768; {***}
|
||||||
|
|
||||||
|
const
|
||||||
|
{constants for exception messages}
|
||||||
|
SCUnknownError = 30168;
|
||||||
|
SCDuplicateCommand = 30169;
|
||||||
|
SCTableNotFound = 30170;
|
||||||
|
SCNotDoneYet = 30171;
|
||||||
|
SCNoControllerAssigned = 30172;
|
||||||
|
SCCantCreateCommandTable = 30173;
|
||||||
|
SCCantDelete = 30174;
|
||||||
|
SCInvalidKeySequence = 30175;
|
||||||
|
SCNotWordStarCommands = 30176;
|
||||||
|
SCNoCommandSelected = 30177;
|
||||||
|
SCDuplicateKeySequence = 30178;
|
||||||
|
SCRangeError = 30179;
|
||||||
|
SCInvalidNumber = 30180;
|
||||||
|
SCRequiredField = 30181;
|
||||||
|
SCInvalidDate = 30182;
|
||||||
|
SCInvalidTime = 30183;
|
||||||
|
SCBlanksInField = 30184;
|
||||||
|
SCPartialEntry = 30185;
|
||||||
|
SCRegionTooLarge = 30186;
|
||||||
|
SCOutOfMemoryForCopy = 30187;
|
||||||
|
SCInvalidParamValue = 30188;
|
||||||
|
SCNoTimersAvail = 30189;
|
||||||
|
SCTooManyEvents = 30190;
|
||||||
|
SCBadTriggerHandle = 30191;
|
||||||
|
SCOnSelectNotAssigned = 30192;
|
||||||
|
SCInvalidPageIndex = 30193;
|
||||||
|
SCInvalidDataType = 30194;
|
||||||
|
SCInvalidTabFont = 30195;
|
||||||
|
SCInvalidLabelFont = 30196;
|
||||||
|
SCOutOfMemory = 30197;
|
||||||
|
SCTooManyParas = 30198;
|
||||||
|
SCCannotJoin = 30199;
|
||||||
|
SCTooManyBytes = 30200;
|
||||||
|
SCParaTooLong = 30201;
|
||||||
|
SCInvalidPictureMask = 30202;
|
||||||
|
SCInvalidRange = 30203;
|
||||||
|
SCInvalidRealRange = 30204;
|
||||||
|
SCInvalidExtendedRange = 30205;
|
||||||
|
SCInvalidDoubleRange = 30206;
|
||||||
|
SCInvalidSingleRange = 30207;
|
||||||
|
SCInvalidCompRange = 30208;
|
||||||
|
SCInvalidDateRange = 30209;
|
||||||
|
SCInvalidTimeRange = 30210;
|
||||||
|
SCInvalidRangeValue = 30211;
|
||||||
|
SCRangeNotSupported = 30212;
|
||||||
|
SCInvalidLineOrParaIndex = 30213;
|
||||||
|
SCNonFixedFont = 30214;
|
||||||
|
SCInvalidFontParam = 30215;
|
||||||
|
SCInvalidLineOrColumn = 30216;
|
||||||
|
SCSAEGeneral = 30217;
|
||||||
|
SCSAEAtMaxSize = 30218;
|
||||||
|
SCSAEOutOfBounds = 30219;
|
||||||
|
SCInvalidXMLFile = 30220;
|
||||||
|
SCUnterminatedElement = 30221;
|
||||||
|
SCBadColorConst = 30222;
|
||||||
|
SCBadColorValue = 30223;
|
||||||
|
SCInvalidFieldType = 30224;
|
||||||
|
SCBadAlarmHandle = 30225;
|
||||||
|
SCOnIsSelectedNotAssigned= 30226;
|
||||||
|
SCInvalidDateForMask = 30227;
|
||||||
|
SCNoTableAttached = 30228;
|
||||||
|
SCViewerIOError = 30232;
|
||||||
|
SCViewerFileNotFound = 30233;
|
||||||
|
SCViewerPathNotFound = 30234;
|
||||||
|
SCViewerTooManyOpenFiles = 30235;
|
||||||
|
SCViewerFileAccessDenied = 30236;
|
||||||
|
SCControlAttached = 30237;
|
||||||
|
SCCantEdit = 30238;
|
||||||
|
SCChildTableError = 30239;
|
||||||
|
SCNoCollection = 30241;
|
||||||
|
SCNotOvcDescendant = 30242;
|
||||||
|
SCItemIncompatible = 30243;
|
||||||
|
SCLabelNotAttached = 30244;
|
||||||
|
SCClassNotSet = 30245;
|
||||||
|
SCCollectionNotFound = 30246;
|
||||||
|
SCDayConvertError = 30247;
|
||||||
|
SCMonthConvertError = 30248;
|
||||||
|
SCMonthNameConvertError = 30249;
|
||||||
|
SCYearConvertError = 30250;
|
||||||
|
SCDayRequired = 30251;
|
||||||
|
SCMonthRequired = 30252;
|
||||||
|
SCYearRequired = 30253;
|
||||||
|
SCInvalidDay = 30254;
|
||||||
|
SCInvalidMonth = 30255;
|
||||||
|
SCInvalidMonthName = 30256;
|
||||||
|
SCInvalidYear = 30257;
|
||||||
|
SCTableRowOutOfBounds = 30258;
|
||||||
|
SCTableMaxRows = 30259;
|
||||||
|
SCTableMaxColumns = 30260;
|
||||||
|
SCTableGeneral = 30261;
|
||||||
|
SCTableToManyColumns = 30262;
|
||||||
|
SCTableInvalidFieldIndex = 30263;
|
||||||
|
SCTableHeaderNotAssigned = 30264;
|
||||||
|
SCTableInvalidHeaderCell = 30265;
|
||||||
|
SCGridTableName = 30266;
|
||||||
|
{general constants for string table resource entries}
|
||||||
|
SCNoneStr = 30268;
|
||||||
|
SCccUser = 30269;
|
||||||
|
SCccUserNum = 30270;
|
||||||
|
SCDeleteTable = 30271;
|
||||||
|
SCRenameTable = 30272;
|
||||||
|
SCEnterTableName = 30273;
|
||||||
|
SCNewTable = 30274;
|
||||||
|
SCDefaultTableName = 30275;
|
||||||
|
SCWordStarTableName = 30276;
|
||||||
|
SCUnknownTable = 30277;
|
||||||
|
SCDefaultEntryErrorText = 30278;
|
||||||
|
SCGotItemWarning = 30279;
|
||||||
|
SCSampleListItem = 30280;
|
||||||
|
SCAlphaString = 30281;
|
||||||
|
SCTallLowChars = 30282;
|
||||||
|
SCDefault = 30283;
|
||||||
|
SCDescending = 30285;
|
||||||
|
SCDefaultIndex = 30286;
|
||||||
|
SCRestoreMI = 30287;
|
||||||
|
SCCutMI = 30288;
|
||||||
|
SCCopyMI = 30289;
|
||||||
|
SCPasteMI = 30290;
|
||||||
|
SCDeleteMI = 30291;
|
||||||
|
SCSelectAllMI = 30292;
|
||||||
|
SCCalcBack = 30293;
|
||||||
|
SCCalcMC = 30294;
|
||||||
|
SCCalcMR = 30295;
|
||||||
|
SCCalcMS = 30296;
|
||||||
|
SCCalcMPlus = 30297;
|
||||||
|
SCCalcMMinus = 30298;
|
||||||
|
SCCalcCT = 30299;
|
||||||
|
SCCalcCE = 30300;
|
||||||
|
SCCalcC = 30301;
|
||||||
|
SCCalcSqrt = 30302;
|
||||||
|
SCCalNext = 30303;
|
||||||
|
SCCalLast = 30304;
|
||||||
|
SCCalFirst = 30305;
|
||||||
|
SCCal1st = 30306;
|
||||||
|
SCCalSecond = 30307;
|
||||||
|
SCCal2nd = 30308;
|
||||||
|
SCCalThird = 30309;
|
||||||
|
SCCal3rd = 30310;
|
||||||
|
SCCalFourth = 30311;
|
||||||
|
SCCal4th = 30312;
|
||||||
|
SCCalFinal = 30313;
|
||||||
|
SCCalBOM = 30314;
|
||||||
|
SCCalEnd = 30315;
|
||||||
|
SCCalEOM = 30316;
|
||||||
|
SCCalYesterday = 30317;
|
||||||
|
SCCalToday = 30318;
|
||||||
|
SCCalTomorrow = 30319;
|
||||||
|
SCEditingSections = 30320;
|
||||||
|
SCEditingItems = 30321;
|
||||||
|
SCEditingFolders = 30322;
|
||||||
|
SCEditingPages = 30323;
|
||||||
|
SCEditingImages = 30324;
|
||||||
|
SCSectionBaseName = 30325;
|
||||||
|
SCItemBaseName = 30326;
|
||||||
|
SCFolderBaseName = 30327;
|
||||||
|
SCPageBaseName = 30328;
|
||||||
|
SCImageBaseName = 30329;
|
||||||
|
SCOwnerMustBeForm = 30330;
|
||||||
|
SCTimeConvertError = 30331;
|
||||||
|
SCCancelQuery = 30332;
|
||||||
|
SCNoPagesAssigned = 30333;
|
||||||
|
SCCalPrev = 30334;
|
||||||
|
SCCalBegin = 30335;
|
||||||
|
SCInvalidMinMaxValue = 30336;
|
||||||
|
SCFormUseOnly = 30337;
|
||||||
|
|
||||||
|
{misc constant values}
|
||||||
|
SCYes = 30368;
|
||||||
|
SCNo = 30369;
|
||||||
|
SCTrue = 30370;
|
||||||
|
SCFalse = 30371;
|
||||||
|
SCHoursName = 30372;
|
||||||
|
SCMinutesName = 30373;
|
||||||
|
SCSecondsName = 30374;
|
||||||
|
SCCloseCaption = 30375;
|
||||||
|
|
||||||
|
{report view exceptions}
|
||||||
|
SCViewFieldNotFound = 30376;
|
||||||
|
SCCantResolveField = 30377;
|
||||||
|
SCItemAlreadyExists = 30378;
|
||||||
|
SCAlreadyInTempMode = 30379;
|
||||||
|
SCItemNotFound = 30380;
|
||||||
|
SCUpdatePending = 30381;
|
||||||
|
SCOnCompareNotAssigned = 30382;
|
||||||
|
SCOnFilterNotAssigned = 30383;
|
||||||
|
SCGetAsFloatNotAssigned = 30384;
|
||||||
|
SCNotInTempMode = 30385;
|
||||||
|
SCItemNotInIndex = 30387;
|
||||||
|
SCNoActiveView = 30388;
|
||||||
|
SCItemIsNotGroup = 30389;
|
||||||
|
SCNotMultiSelect = 30390;
|
||||||
|
SCLineNoOutOfRange = 30391;
|
||||||
|
SCUnknownView = 30392;
|
||||||
|
SCOnKeySearchNotAssigned = 30393;
|
||||||
|
SCOnEnumNotAssigned = 30394;
|
||||||
|
SCOnEnumSelectedNA = 30395;
|
||||||
|
|
||||||
|
{MRU list exceptions }
|
||||||
|
SCNoMenuAssigned = 30400;
|
||||||
|
SCNoAnchorAssigned = 30401;
|
||||||
|
SCInvalidParameter = 30402;
|
||||||
|
SCInvalidOperation = 30403;
|
||||||
|
|
||||||
|
SCColorBlack = 30500;
|
||||||
|
SCColorMaroon = 30501;
|
||||||
|
SCColorGreen = 30502;
|
||||||
|
SCColorOlive = 30503;
|
||||||
|
SCColorNavy = 30504;
|
||||||
|
SCColorPurple = 30505;
|
||||||
|
SCColorTeal = 30506;
|
||||||
|
SCColorGray = 30507;
|
||||||
|
SCColorSilver = 30508;
|
||||||
|
SCColorRed = 30509;
|
||||||
|
SCColorLime = 30510;
|
||||||
|
SCColorYellow = 30511;
|
||||||
|
SCColorBlue = 30512;
|
||||||
|
SCColorFuchsia = 30513;
|
||||||
|
SCColorAqua = 30514;
|
||||||
|
SCColorWhite = 30515;
|
||||||
|
SCColorLightGray = 30516;
|
||||||
|
SCColorMediumGray = 30517;
|
||||||
|
SCColorDarkGray = 30518;
|
||||||
|
SCColorMoneyGreen = 30519;
|
||||||
|
SCColorSkyBlue = 30520;
|
||||||
|
SCColorCream = 30521;
|
||||||
|
|
||||||
|
const
|
||||||
|
cHotKeyChar = '&'; {hotkey prefix character}
|
||||||
|
|
||||||
|
const
|
||||||
|
{offset for resource id's}
|
||||||
|
CommandResOfs = BaseOffset + 1000; {***}
|
||||||
|
|
||||||
|
{command codes - corresponding text offset by CommandOfs, stored in rc file}
|
||||||
|
{*** must be contiguous ***}
|
||||||
|
ccFirstCmd = 0; {first defined command}
|
||||||
|
ccNone = 0; {no command or not a known command}
|
||||||
|
ccBack = 1; {backspace one character}
|
||||||
|
ccBotOfPage = 2; {move caret to end of last page}
|
||||||
|
ccBotRightCell = 3; {move to the bottom right hand cell in a table}
|
||||||
|
ccCompleteDate = 4; {use default date for current date sub field}
|
||||||
|
ccCompleteTime = 5; {use default time for current time sub field}
|
||||||
|
ccCopy = 6; {copy highlighted text to clipboard}
|
||||||
|
ccCtrlChar = 7; {accept control character}
|
||||||
|
ccCut = 8; {copy highlighted text to clipboard and delete it}
|
||||||
|
ccDec = 9; {decrement the current entry field value}
|
||||||
|
ccDel = 10; {delete current character}
|
||||||
|
ccDelBol = 11; {delete from caret to beginning of line}
|
||||||
|
ccDelEol = 12; {delete from caret to end of line}
|
||||||
|
ccDelLine = 13; {delete entire line}
|
||||||
|
ccDelWord = 14; {delete word to right of caret}
|
||||||
|
ccDown = 15; {cursor down}
|
||||||
|
ccEnd = 16; {caret to end of line}
|
||||||
|
ccExtendDown = 17; {extend selection down one line}
|
||||||
|
ccExtendEnd = 18; {extend highlight to end of field}
|
||||||
|
ccExtendHome = 19; {extend highlight to start of field}
|
||||||
|
ccExtendLeft = 20; {extend highlight left one character}
|
||||||
|
ccExtendPgDn = 21; {extend selection down one page}
|
||||||
|
ccExtendPgUp = 22; {extend selection up one page}
|
||||||
|
ccExtendRight = 23; {extend highlight right one character}
|
||||||
|
ccExtendUp = 24; {extend selection up one line}
|
||||||
|
ccExtBotOfPage = 25; {extend selection to bottom of page}
|
||||||
|
ccExtFirstPage = 26; {extend selection to first page}
|
||||||
|
ccExtLastPage = 27; {extend selection to last page}
|
||||||
|
ccExtTopOfPage = 28; {extend selection to top of page}
|
||||||
|
ccExtWordLeft = 29; {extend highlight left one word}
|
||||||
|
ccExtWordRight = 30; {extend highlight right one word}
|
||||||
|
ccFirstPage = 31; {first page in table}
|
||||||
|
ccGotoMarker0 = 32; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker1 = 33; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker2 = 34; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker3 = 35; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker4 = 36; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker5 = 37; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker6 = 38; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker7 = 39; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker8 = 40; {editor & viewer, go to a position marker}
|
||||||
|
ccGotoMarker9 = 41; {editor & viewer, go to a position marker}
|
||||||
|
ccHome = 42; {caret to beginning of line}
|
||||||
|
ccInc = 43; {increment the current entry field value}
|
||||||
|
ccIns = 44; {toggle insert mode}
|
||||||
|
ccLastPage = 45; {last page in table}
|
||||||
|
ccLeft = 46; {caret left by one character}
|
||||||
|
ccNewLine = 47; {editor, create a new line}
|
||||||
|
ccNextPage = 48; {next page in table}
|
||||||
|
ccPageLeft = 49; {move left a page in the table}
|
||||||
|
ccPageRight = 50; {move right a page in the table}
|
||||||
|
ccPaste = 51; {paste text from clipboard}
|
||||||
|
ccPrevPage = 52; {previous page in table}
|
||||||
|
ccRedo = 53; {re-do the last undone operation}
|
||||||
|
ccRestore = 54; {restore default and continue}
|
||||||
|
ccRight = 55; {caret right by one character}
|
||||||
|
ccScrollDown = 56; {editor, scroll page up one line}
|
||||||
|
ccScrollUp = 57; {editor, scroll page down one line}
|
||||||
|
ccSetMarker0 = 58; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker1 = 59; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker2 = 60; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker3 = 61; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker4 = 62; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker5 = 63; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker6 = 64; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker7 = 65; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker8 = 66; {editor & viewer, set a position marker}
|
||||||
|
ccSetMarker9 = 67; {editor & viewer, set a position marker}
|
||||||
|
ccTab = 68; {editor, for tab entry}
|
||||||
|
ccTableEdit = 69; {enter/exit table edit mode}
|
||||||
|
ccTopLeftCell = 70; {move to the top left cell in a table}
|
||||||
|
ccTopOfPage = 71; {move caret to beginning of first page}
|
||||||
|
ccUndo = 72; {undo last operation}
|
||||||
|
ccUp = 73; {cursor up}
|
||||||
|
ccWordLeft = 74; {caret left one word}
|
||||||
|
ccWordRight = 75; {caret right one word}
|
||||||
|
|
||||||
|
ccLastCmd = 75; {***} {last interfaced command}
|
||||||
|
|
||||||
|
{internal}
|
||||||
|
ccChar = 249; {regular character; generated internally}
|
||||||
|
ccMouse = 250; {mouse selection; generated internally}
|
||||||
|
ccMouseMove = 251; {mouse move; generated internally}
|
||||||
|
ccAccept = 252; {accept next key; internal}
|
||||||
|
ccDblClk = 253; {mouse double click; generated internally}
|
||||||
|
ccSuppress = 254; {suppress next key; internal}
|
||||||
|
ccPartial = 255; {partial command; internal}
|
||||||
|
|
||||||
|
{user defined commands start here}
|
||||||
|
ccUserFirst = 256;
|
||||||
|
ccUser0 = ccUserFirst + 0;
|
||||||
|
ccUser1 = ccUserFirst + 1;
|
||||||
|
ccUser2 = ccUserFirst + 2;
|
||||||
|
ccUser3 = ccUserFirst + 3;
|
||||||
|
ccUser4 = ccUserFirst + 4;
|
||||||
|
ccUser5 = ccUserFirst + 5;
|
||||||
|
ccUser6 = ccUserFirst + 6;
|
||||||
|
ccUser7 = ccUserFirst + 7;
|
||||||
|
ccUser8 = ccUserFirst + 8;
|
||||||
|
ccUser9 = ccUserFirst + 9;
|
||||||
|
{... = ccUserFirst + 65535 - ccUserFirst}
|
||||||
|
|
||||||
|
|
||||||
|
{data type base offset}
|
||||||
|
const
|
||||||
|
DataTypeOfs = BaseOffset + 1300; {***}
|
||||||
|
|
||||||
|
{entry field data type sub codes}
|
||||||
|
const
|
||||||
|
fsubString = 0; {field subclass codes}
|
||||||
|
fsubChar = 1;
|
||||||
|
fsubBoolean = 2;
|
||||||
|
fsubYesNo = 3;
|
||||||
|
fsubLongInt = 4;
|
||||||
|
fsubWord = 5;
|
||||||
|
fsubInteger = 6;
|
||||||
|
fsubByte = 7;
|
||||||
|
fsubShortInt = 8;
|
||||||
|
fsubReal = 9;
|
||||||
|
fsubExtended = 10;
|
||||||
|
fsubDouble = 11;
|
||||||
|
fsubSingle = 12;
|
||||||
|
fsubComp = 13;
|
||||||
|
fsubDate = 14;
|
||||||
|
fsubTime = 15;
|
||||||
|
|
||||||
|
|
||||||
|
{constants for simple, picture, and numeric picture}
|
||||||
|
{mask samples used in the property editors}
|
||||||
|
const
|
||||||
|
PictureMaskOfs = BaseOffset + 1700; {***}
|
||||||
|
|
||||||
|
{simple field mask characters}
|
||||||
|
stsmFirst = 34468;
|
||||||
|
stsmLast = 34468 + 23;
|
||||||
|
|
||||||
|
{numeric field picture masks}
|
||||||
|
stnmFirst = 34493;
|
||||||
|
stnmLast = 34493 + 17;
|
||||||
|
|
||||||
|
{picture field picture masks}
|
||||||
|
stpmFirst = 34518;
|
||||||
|
stpmLast = 34518 + 23;
|
||||||
|
|
||||||
|
const
|
||||||
|
{String Resource Constants...}
|
||||||
|
|
||||||
|
{Note: These should stay in numerical order. It's not as important here as it
|
||||||
|
is in the O32SR.pas file's Lookup Array, but you should still keep it in
|
||||||
|
mind when editing these values...}
|
||||||
|
|
||||||
|
{String Resource Index Constants}
|
||||||
|
IccNone = 33768;
|
||||||
|
IccBack = 33769;
|
||||||
|
IccBotOfPage = 33770;
|
||||||
|
IccBotRightCell = 33771;
|
||||||
|
IccCompleteDate = 33772;
|
||||||
|
IccCompleteTime = 33773;
|
||||||
|
IccCopy = 33774;
|
||||||
|
IccCtrlChar = 33775;
|
||||||
|
IccCut = 33776;
|
||||||
|
IccDec = 33777;
|
||||||
|
IccDel = 33778;
|
||||||
|
IccDelBol = 33779;
|
||||||
|
IccDelEol = 33780;
|
||||||
|
IccDelLine = 33781;
|
||||||
|
IccDelWord = 33782;
|
||||||
|
IccDown = 33783;
|
||||||
|
IccEnd = 33784;
|
||||||
|
IccExtendDown = 33785;
|
||||||
|
IccExtendEnd = 33786;
|
||||||
|
IccExtendHome = 33787;
|
||||||
|
IccExtendLeft = 33788;
|
||||||
|
IccExtendPgDn = 33789;
|
||||||
|
IccExtendPgUp = 33790;
|
||||||
|
IccExtendRight = 33791;
|
||||||
|
IccExtendUp = 33792;
|
||||||
|
IccExtBotOfPage = 33793;
|
||||||
|
IccExtFirstPage = 33794;
|
||||||
|
IccExtLastPage = 33795;
|
||||||
|
IccExtTopOfPage = 33796;
|
||||||
|
IccExtWordLeft = 33797;
|
||||||
|
IccExtWordRight = 33798;
|
||||||
|
IccFirstPage = 33799;
|
||||||
|
IccGotoMarker0 = 33800;
|
||||||
|
IccGotoMarker1 = 33801;
|
||||||
|
IccGotoMarker2 = 33802;
|
||||||
|
IccGotoMarker3 = 33803;
|
||||||
|
IccGotoMarker4 = 33804;
|
||||||
|
IccGotoMarker5 = 33805;
|
||||||
|
IccGotoMarker6 = 33806;
|
||||||
|
IccGotoMarker7 = 33807;
|
||||||
|
IccGotoMarker8 = 33808;
|
||||||
|
IccGotoMarker9 = 33809;
|
||||||
|
IccHome = 33810;
|
||||||
|
IccInc = 33811;
|
||||||
|
IccIns = 33812;
|
||||||
|
IccLastPage = 33813;
|
||||||
|
IccLeft = 33814;
|
||||||
|
IccNewLine = 33815;
|
||||||
|
IccNextPage = 33816;
|
||||||
|
IccPageLeft = 33817;
|
||||||
|
IccPageRight = 33818;
|
||||||
|
IccPaste = 33819;
|
||||||
|
IccPrevPage = 33820;
|
||||||
|
IccRedo = 33821;
|
||||||
|
IccRestore = 33822;
|
||||||
|
IccRight = 33823;
|
||||||
|
IccScrollDown = 33824;
|
||||||
|
IccScrollUp = 33825;
|
||||||
|
IccSetMarker0 = 33826;
|
||||||
|
IccSetMarker1 = 33827;
|
||||||
|
IccSetMarker2 = 33828;
|
||||||
|
IccSetMarker3 = 33829;
|
||||||
|
IccSetMarker4 = 33830;
|
||||||
|
IccSetMarker5 = 33831;
|
||||||
|
IccSetMarker6 = 33832;
|
||||||
|
IccSetMarker7 = 33833;
|
||||||
|
IccSetMarker8 = 33834;
|
||||||
|
IccSetMarker9 = 33835;
|
||||||
|
IccTab = 33836;
|
||||||
|
IccTableEdit = 33837;
|
||||||
|
IccTopLeftCell = 33838;
|
||||||
|
IccTopOfPage = 33839;
|
||||||
|
IccUndo = 33840;
|
||||||
|
IccUp = 33841;
|
||||||
|
IccWordLeft = 33842;
|
||||||
|
IccWordRight = 33843;
|
||||||
|
|
||||||
|
IString = 34068;
|
||||||
|
IChar = 34069;
|
||||||
|
IBoolean = 34070;
|
||||||
|
IYesNo = 34071;
|
||||||
|
ILongInt = 34072;
|
||||||
|
IWord = 34073;
|
||||||
|
ISmallInt = 34074;
|
||||||
|
IByte = 34075;
|
||||||
|
IShortInt = 34076;
|
||||||
|
IReal = 34077;
|
||||||
|
IExtended = 34078;
|
||||||
|
IDouble = 34079;
|
||||||
|
ISingle = 34080;
|
||||||
|
IComp = 34081;
|
||||||
|
IDate = 34082;
|
||||||
|
ITime = 34083;
|
||||||
|
|
||||||
|
{Character Masks}
|
||||||
|
ICharMask1 = 34468;
|
||||||
|
ICharMask2 = 34469;
|
||||||
|
ICharMask3 = 34470;
|
||||||
|
ICharMask4 = 34471;
|
||||||
|
ICharMask5 = 34472;
|
||||||
|
ICharMask6 = 34473;
|
||||||
|
ICharMask7 = 34474;
|
||||||
|
ICharMask8 = 34475;
|
||||||
|
ICharMask9 = 34476;
|
||||||
|
ICharMask10 = 34477;
|
||||||
|
ICharMask11 = 34478;
|
||||||
|
ICharMask12 = 34479;
|
||||||
|
ICharMask13 = 34480;
|
||||||
|
ICharMask14 = 34481;
|
||||||
|
ICharMask15 = 34482;
|
||||||
|
ICharMask16 = 34483;
|
||||||
|
ICharMask17 = 34484;
|
||||||
|
ICharMask18 = 34485;
|
||||||
|
ICharMask19 = 34486;
|
||||||
|
ICharMask20 = 34487;
|
||||||
|
ICharMask21 = 34488;
|
||||||
|
ICharMask22 = 34489;
|
||||||
|
ICharMask23 = 34490;
|
||||||
|
ICharMask24 = 34491;
|
||||||
|
|
||||||
|
{Sample Field Masks }
|
||||||
|
IFieldMask1 = 34493;
|
||||||
|
IFieldMask2 = 34494;
|
||||||
|
IFieldMask3 = 34495;
|
||||||
|
IFieldMask4 = 34496;
|
||||||
|
IFieldMask5 = 34497;
|
||||||
|
IFieldMask6 = 34498;
|
||||||
|
IFieldMask7 = 34499;
|
||||||
|
IFieldMask8 = 34500;
|
||||||
|
IFieldMask9 = 34501;
|
||||||
|
IFieldMask10 = 34502;
|
||||||
|
IFieldMask11 = 34503;
|
||||||
|
IFieldMask12 = 34504;
|
||||||
|
IFieldMask13 = 34505;
|
||||||
|
IFieldMask14 = 34506;
|
||||||
|
IFieldMask15 = 34507;
|
||||||
|
IFieldMask16 = 34508;
|
||||||
|
IFieldMask17 = 34509;
|
||||||
|
IFieldMask18 = 34510;
|
||||||
|
|
||||||
|
IFieldMask19 = 34518;
|
||||||
|
IFieldMask20 = 34519;
|
||||||
|
IFieldMask21 = 34520;
|
||||||
|
IFieldMask22 = 34521;
|
||||||
|
IFieldMask23 = 34522;
|
||||||
|
IFieldMask24 = 34523;
|
||||||
|
IFieldMask25 = 34524;
|
||||||
|
IFieldMask26 = 34525;
|
||||||
|
IFieldMask27 = 34526;
|
||||||
|
IFieldMask28 = 34527;
|
||||||
|
IFieldMask29 = 34528;
|
||||||
|
IFieldMask30 = 34529;
|
||||||
|
IFieldMask31 = 34530;
|
||||||
|
IFieldMask32 = 34531;
|
||||||
|
IFieldMask33 = 34532;
|
||||||
|
IFieldMask34 = 34533;
|
||||||
|
IFieldMask35 = 34534;
|
||||||
|
IFieldMask36 = 34535;
|
||||||
|
IFieldMask37 = 34536;
|
||||||
|
IFieldMask38 = 34537;
|
||||||
|
IFieldMask39 = 34538;
|
||||||
|
IFieldMask40 = 34539;
|
||||||
|
IFieldMask41 = 34540;
|
||||||
|
IFieldMask42 = 34541;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
624
components/orpheus/ovcdata.pas
Normal file
624
components/orpheus/ovcdata.pas
Normal file
@ -0,0 +1,624 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCDATA.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcdata;
|
||||||
|
{-Miscellaneous type and constant declarations}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Controls, Forms, Graphics, StdCtrls, SysUtils, OvcConst, OvcDate, O32SR;
|
||||||
|
|
||||||
|
const
|
||||||
|
BorderStyles : array[TBorderStyle] of LongInt =
|
||||||
|
(0, WS_BORDER);
|
||||||
|
ScrollBarStyles : array [TScrollStyle] of LongInt =
|
||||||
|
(0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
|
||||||
|
{$IFDEF LCL}
|
||||||
|
,WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
|
||||||
|
{$ENDIF}
|
||||||
|
);
|
||||||
|
|
||||||
|
{$IFNDEF VERSION4}
|
||||||
|
type
|
||||||
|
PDateTime = ^TDateTime;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{some colors that are not defined by Delphi}
|
||||||
|
const
|
||||||
|
clCream = TColor($A6CAF0);
|
||||||
|
clMoneyGreen = TColor($C0DCC0);
|
||||||
|
clSkyBlue = TColor($FFFBF0);
|
||||||
|
|
||||||
|
type
|
||||||
|
TCharSet = set of AnsiChar; {a Pascal set of characters}
|
||||||
|
|
||||||
|
type
|
||||||
|
PPointer = ^Pointer;
|
||||||
|
|
||||||
|
type
|
||||||
|
{secondary field options--internal}
|
||||||
|
TsefOption = (
|
||||||
|
sefValPending, {field needs validation}
|
||||||
|
sefInvalid, {field is invalid}
|
||||||
|
sefNoHighlight, {Don't highlight field initially}
|
||||||
|
sefIgnoreFocus, {We're ignoring the focus}
|
||||||
|
sefValidating, {We're validating a field}
|
||||||
|
sefModified, {Field recently modified}
|
||||||
|
sefEverModified, {Field has been modified after last data transfer}
|
||||||
|
sefFixSemiLits, {Semi-literals were stripped}
|
||||||
|
sefHexadecimal, {Field's value is shown in hex}
|
||||||
|
sefOctal, {Field's value is shown in octal}
|
||||||
|
sefBinary, {Field's value is shown in binary}
|
||||||
|
sefNumeric, {Edit from right to left--for numbers only}
|
||||||
|
sefRealVar, {Field is of a real/8087 type}
|
||||||
|
sefNoLiterals, {Picture mask has no literals}
|
||||||
|
sefHaveFocus, {Control has the focus}
|
||||||
|
sefRetainPos, {Retain caret position}
|
||||||
|
sefErrorPending, {Error pending?}
|
||||||
|
sefInsert, {Insert mode on}
|
||||||
|
sefLiteral, {Next char is literal}
|
||||||
|
sefAcceptChar, {Accept next character}
|
||||||
|
sefCharOK, {OK to add a character}
|
||||||
|
sefUpdating, {field is being updated}
|
||||||
|
sefGettingValue, {field contents are being retrieved}
|
||||||
|
sefUserValidating, {user validation in progress}
|
||||||
|
sefNoUserValidate); {don't perform user validation}
|
||||||
|
|
||||||
|
{Set of current secondary options for entry fields}
|
||||||
|
TsefOptionSet = set of TsefOption;
|
||||||
|
|
||||||
|
const
|
||||||
|
{default secondary field options}
|
||||||
|
sefDefOptions : TsefOptionSet = [sefCharOK, sefInsert];
|
||||||
|
|
||||||
|
const
|
||||||
|
DefPadChar = ' '; {Default character used to pad the end of a display string}
|
||||||
|
MaxEditLen = 255; {Maximum length of edit string}
|
||||||
|
MaxPicture = 255; {Maximum length of a picture mask}
|
||||||
|
|
||||||
|
{*** Picture masks ***}
|
||||||
|
const
|
||||||
|
{the following characters are meaningful in Picture masks}
|
||||||
|
pmAnyChar = 'X'; {allows any character}
|
||||||
|
pmForceUpper = '!'; {allows any character, forces upper case}
|
||||||
|
pmForceLower = 'L'; {allows any character, forces lower case}
|
||||||
|
pmForceMixed = 'x'; {allows any character, forces mixed case}
|
||||||
|
pmAlpha = 'a'; {allows alphas only}
|
||||||
|
pmUpperAlpha = 'A'; {allows alphas only, forces upper case}
|
||||||
|
pmLowerAlpha = 'l'; {allows alphas only, forces lower case}
|
||||||
|
pmPositive = '9'; {allows numbers and spaces only}
|
||||||
|
pmWhole = 'i'; {allows numbers, spaces, minus}
|
||||||
|
pmDecimal = '#'; {allows numbers, spaces, minus, period}
|
||||||
|
pmScientific = 'E'; {allows numbers, spaces, minus, period, 'e'}
|
||||||
|
pmHexadecimal = 'K'; {allows 0-9, A-F, and space forces upper case}
|
||||||
|
pmOctal = 'O'; {allows 0-7, space}
|
||||||
|
pmBinary = 'b'; {allows 0-1, space}
|
||||||
|
pmTrueFalse = 'B'; {allows T, t, F, f}
|
||||||
|
pmYesNo = 'Y'; {allows Y, y, N, n}
|
||||||
|
|
||||||
|
pmUser1 = '1'; {User-defined picture mask characters}
|
||||||
|
pmUser2 = '2';
|
||||||
|
pmUser3 = '3';
|
||||||
|
pmUser4 = '4';
|
||||||
|
pmUser5 = '5';
|
||||||
|
pmUser6 = '6';
|
||||||
|
pmUser7 = '7';
|
||||||
|
pmUser8 = '8';
|
||||||
|
|
||||||
|
Subst1 = #241; {User-defined substitution characters}
|
||||||
|
Subst2 = #242;
|
||||||
|
Subst3 = #243;
|
||||||
|
Subst4 = #244;
|
||||||
|
Subst5 = #245;
|
||||||
|
Subst6 = #246;
|
||||||
|
Subst7 = #247;
|
||||||
|
Subst8 = #248;
|
||||||
|
|
||||||
|
const
|
||||||
|
{Other special characters allowed in Picture strings}
|
||||||
|
pmDecimalPt = '.'; {insert decimal point}
|
||||||
|
pmComma = ','; {character used to separate numbers}
|
||||||
|
pmFloatDollar = '$'; {floating dollar sign}
|
||||||
|
pmCurrencyLt = 'c'; {currency to left of the amount}
|
||||||
|
pmCurrencyRt = 'C'; {currency to right of the amount}
|
||||||
|
pmNegParens = 'p'; {indicates () should be used for negative #'s}
|
||||||
|
pmNegHere = 'g'; {placeholder for minus sign}
|
||||||
|
{NOTE: Comma and FloatDollar are allowed only in fields containing fixed
|
||||||
|
decimal points and/or numeric fields. NegParens and NegHere should be used
|
||||||
|
only in numeric fields.}
|
||||||
|
|
||||||
|
const
|
||||||
|
{the following characters are meaningful in date Picture masks}
|
||||||
|
pmMonth = 'm'; {formatting character for a date string picture mask}
|
||||||
|
pmMonthU = 'M'; {formatting character for a date string picture mask.
|
||||||
|
Uppercase means pad with ' ' rather than '0'}
|
||||||
|
pmDay = 'd'; {formatting character for a date string picture mask}
|
||||||
|
pmDayU = 'D'; {formatting character for a date string picture mask.
|
||||||
|
Uppercase means pad with ' ' rather then '0'}
|
||||||
|
pmYear = 'y'; {formatting character for a date string picture mask}
|
||||||
|
pmDateSlash = '/'; {formatting character for a date string picture mask}
|
||||||
|
|
||||||
|
{'n'/'N' may be used in place of 'm'/'M' when the name of the month is
|
||||||
|
desired instead of its number. E.g., 'dd/nnn/yyyy' -\> '01-Jan-1980'.
|
||||||
|
'dd/NNN/yyyy' -\> '01-JAN-1980' (if SlashChar = '-'). The abbreviation used
|
||||||
|
is based on the width of the subfield (3 in the example) and the current
|
||||||
|
contents of the MonthString array.}
|
||||||
|
pmMonthName = 'n'; {formatting character for a date string picture mask}
|
||||||
|
pmMonthNameU = 'N'; {formatting character for a date string picture mask.
|
||||||
|
Uppercase causes the output to be in uppercase}
|
||||||
|
|
||||||
|
{'w'/'W' may be used to include the day of the week in a date string. E.g.,
|
||||||
|
'www dd nnn yyyy' -\> 'Mon 01 Jan 1989'. The abbreviation used is based on
|
||||||
|
the width of the subfield (3 in the example) and the current contents of the
|
||||||
|
DayString array. Note that entry field will not allow the user to enter
|
||||||
|
text into a subfield containing 'w' or 'W'. The day of the week will be
|
||||||
|
supplied automatically when a valid date is entered.}
|
||||||
|
pmWeekDay = 'w'; {formatting character for a date string picture mask}
|
||||||
|
pmWeekDayU = 'W'; {formatting character for a date string picture mask.
|
||||||
|
Uppercase causes the output to be in uppercase}
|
||||||
|
|
||||||
|
pmLongDateSub1 = 'f'; {mask character used with Window's long date format}
|
||||||
|
pmLongDateSub2 = 'g'; {mask character used with Window's long date format}
|
||||||
|
pmLongDateSub3 = 'h'; {mask character used with Window's long date format}
|
||||||
|
|
||||||
|
const
|
||||||
|
{if uppercase letters are used, numbers are padded with ' ' rather than '0'}
|
||||||
|
pmHour = 'h'; {formatting character for a time string picture mask}
|
||||||
|
pmHourU = 'H'; {formatting character for a time string picture mask}
|
||||||
|
pmMinute = 'm'; {formatting character for a time string picture mask}
|
||||||
|
pmMinuteU = 'M'; {formatting character for a time string picture mask}
|
||||||
|
pmSecond = 's'; {formatting character for a time string picture mask}
|
||||||
|
pmSecondU = 'S'; {formatting character for a time string picture mask}
|
||||||
|
{'hh:mm:ss tt' -\> '12:00:00 pm', 'hh:mmt' -\> '12:00p'}
|
||||||
|
pmAmPm = 't'; {formatting character for a time string picture mask.
|
||||||
|
This generates 'AM' or 'PM'}
|
||||||
|
pmTimeColon = ':'; {formatting character for a time string picture mask}
|
||||||
|
|
||||||
|
const
|
||||||
|
PictureChars : TCharSet = [
|
||||||
|
pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
|
||||||
|
pmAlpha, pmUpperAlpha, pmLowerAlpha,
|
||||||
|
pmPositive, pmWhole, pmDecimal, pmScientific,
|
||||||
|
pmHexadecimal, pmOctal, pmBinary,
|
||||||
|
pmTrueFalse, pmYesNo,
|
||||||
|
pmMonthName, pmMonthNameU, pmMonth,
|
||||||
|
pmMonthU, pmDay, pmDayU, pmYear, pmHour, pmHourU, {$IFNDEF FPC} pmMinute,
|
||||||
|
pmMinuteU, {$ENDIF} pmSecond, pmSecondU, pmAmPm, pmUser1..pmUser8];
|
||||||
|
|
||||||
|
const
|
||||||
|
{set of allowable picture characters for simple fields}
|
||||||
|
SimplePictureChars : TCharSet = [
|
||||||
|
pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
|
||||||
|
pmAlpha, pmUpperAlpha, pmLowerAlpha,
|
||||||
|
pmPositive, pmWhole, pmDecimal, pmScientific,
|
||||||
|
pmHexadecimal, pmOctal, pmBinary,
|
||||||
|
pmTrueFalse, pmYesNo,
|
||||||
|
pmUser1..pmUser8];
|
||||||
|
|
||||||
|
type
|
||||||
|
{types of case change operations associated with a picture mask character}
|
||||||
|
TCaseChange = (mcNoChange, mcUpperCase, mcLowerCase, mcMixedCase);
|
||||||
|
|
||||||
|
type
|
||||||
|
TUserSetRange = pmUser1..pmUser8;
|
||||||
|
TForceCaseRange = pmUser1..pmUser8;
|
||||||
|
TSubstCharRange = Subst1..Subst8;
|
||||||
|
|
||||||
|
TUserCharSets = array[TUserSetRange] of TCharSet;
|
||||||
|
TForceCase = array[TForceCaseRange] of TCaseChange;
|
||||||
|
TSubstChars = array[TSubstCharRange] of AnsiChar;
|
||||||
|
|
||||||
|
const
|
||||||
|
MaxDateLen = 40; {maximum length of date picture strings}
|
||||||
|
MaxMonthName = 15; {maximum length for month names}
|
||||||
|
MaxDayName = 15; {maximum length for day names}
|
||||||
|
|
||||||
|
const
|
||||||
|
otf_SizeData = 0; {These three constants are used in data transfers to}
|
||||||
|
otf_GetData = 1; {specify the type of transfer operation being requested}
|
||||||
|
otf_SetData = 2;
|
||||||
|
|
||||||
|
type
|
||||||
|
TEditString = array[0..MaxEditLen] of AnsiChar;
|
||||||
|
TPictureMask = array[0..MaxPicture] of AnsiChar;
|
||||||
|
|
||||||
|
{An array of flags that indicate the type of mask character at a given
|
||||||
|
location in a picture mask}
|
||||||
|
TPictureFlags = array[0..MaxEditLen+1] of Byte;
|
||||||
|
|
||||||
|
{Each entry field maintains two data structures of this type, one to store
|
||||||
|
the lower limit of a field's value, and another to store the upper limit}
|
||||||
|
PRangeType = ^TRangeType;
|
||||||
|
TRangeType = packed record
|
||||||
|
case Byte of {size}
|
||||||
|
00 : (rtChar : AnsiChar); {01}
|
||||||
|
01 : (rtByte : Byte); {01}
|
||||||
|
02 : (rtSht : ShortInt); {01}
|
||||||
|
03 : (rtInt : SmallInt); {02}
|
||||||
|
04 : (rtWord : Word); {02}
|
||||||
|
05 : (rtLong : LongInt); {04}
|
||||||
|
06 : (rtSgl : Single); {04}
|
||||||
|
07 : (rtPtr : Pointer); {04}
|
||||||
|
{$IFDEF CBuilder}
|
||||||
|
08 : (rtReal : Double); {06}
|
||||||
|
{$ELSE}
|
||||||
|
08 : (rtReal : Real); {06}
|
||||||
|
{$ENDIF CBuilder}
|
||||||
|
09 : (rtDbl : Double); {08}
|
||||||
|
{$IFDEF CBuilder}
|
||||||
|
10 : (rtComp : Double); {08}
|
||||||
|
{$ELSE}
|
||||||
|
{$IFNDEF FPC} {Delphi}
|
||||||
|
10 : (rtComp : Comp); {08}
|
||||||
|
{$ELSE} {FPC}
|
||||||
|
{$IFDEF CPU86}
|
||||||
|
10 : (rtComp : Comp); {08}
|
||||||
|
{$ELSE} {Comp is true integer with non-Intel}
|
||||||
|
10 : (rtComp : Double); {08}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF CBuilder}
|
||||||
|
11 : (rtExt : Extended); {10}
|
||||||
|
12 : (rtDate : LongInt); {04}
|
||||||
|
13 : (rtTime : LongInt); {04}
|
||||||
|
14 : (rt10 : array[1..10] of Byte); {10} {forces structure to size of 10 bytes}
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
BlankRange : TRangeType = (rt10 : (0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
|
||||||
|
|
||||||
|
{*** Date/Time declarations ***}
|
||||||
|
type
|
||||||
|
TOvcDate = TStDate;
|
||||||
|
TOvcTime = TStTime;
|
||||||
|
TDayType = TStDayType;
|
||||||
|
|
||||||
|
type
|
||||||
|
{states for data aware entry fields}
|
||||||
|
TDbEntryFieldStates = (esFocused, esSelected, esReset);
|
||||||
|
TDbEntryFieldState = set of TDbEntryFieldStates;
|
||||||
|
|
||||||
|
type
|
||||||
|
{Search option flags for editor and viewer}
|
||||||
|
TSearchOptions = (
|
||||||
|
soFind, {find (this option is assumed) }
|
||||||
|
soBackward, {search backwards }
|
||||||
|
soMatchCase, {don't ignore case when searching }
|
||||||
|
soGlobal, {search globally }
|
||||||
|
soReplace, {find and replace (editor only)}
|
||||||
|
soReplaceAll, {find and replace all (editor only)}
|
||||||
|
soWholeWord, {match on whole word only (editor only)}
|
||||||
|
soSelText); {search in selected text (editor only)}
|
||||||
|
TSearchOptionSet = set of TSearchOptions;
|
||||||
|
|
||||||
|
const
|
||||||
|
{maximum length of a search/replacement string}
|
||||||
|
MaxSearchString = 255;
|
||||||
|
|
||||||
|
type
|
||||||
|
{types of tabs supported in the editor}
|
||||||
|
TTabType = (ttReal, ttFixed, ttSmart);
|
||||||
|
|
||||||
|
{entry field flag for display of number field with zero value}
|
||||||
|
TZeroDisplay = (zdShow, zdHide, zdHideUntilModified);
|
||||||
|
|
||||||
|
type
|
||||||
|
{structrue of the commands stored in the command table}
|
||||||
|
POvcCmdRec = ^TOvcCmdRec;
|
||||||
|
TOvcCmdRec = packed record
|
||||||
|
case Byte of
|
||||||
|
0 : (Key1 : Byte; {first keys' virtual key code}
|
||||||
|
SS1 : Byte; {shift state of first key}
|
||||||
|
Key2 : Byte; {second keys' virtual key code, if any}
|
||||||
|
SS2 : Byte; {shift state of second key}
|
||||||
|
Cmd : Word); {command to return for this entry}
|
||||||
|
1 : (Keys : LongInt); {used for sorting, searching, and storing}
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
{shift state flags for command processors}
|
||||||
|
ss_None = $00; {no shift key is pressed}
|
||||||
|
ss_Shift = $02; {the shift key is pressed}
|
||||||
|
ss_Ctrl = $04; {the control key is pressed}
|
||||||
|
ss_Alt = $08; {the alt key is pressed}
|
||||||
|
ss_Wordstar = $80; {2nd key of a twokey wordstar command: ss_Ctrl or ss_None}
|
||||||
|
{the second key of a two-key wordstar command is accepted if}
|
||||||
|
{pressed by itself of with the ctrl key. case is ignored}
|
||||||
|
|
||||||
|
const
|
||||||
|
{virtual key constants not already defined}
|
||||||
|
VK_NONE = 0;
|
||||||
|
VK_ALT = VK_MENU;
|
||||||
|
VK_A = Ord('A'); VK_B = Ord('B'); VK_C = Ord('C'); VK_D = Ord('D');
|
||||||
|
VK_E = Ord('E'); VK_F = Ord('F'); VK_G = Ord('G'); VK_H = Ord('H');
|
||||||
|
VK_I = Ord('I'); VK_J = Ord('J'); VK_K = Ord('K'); VK_L = Ord('L');
|
||||||
|
VK_M = Ord('M'); VK_N = Ord('N'); VK_O = Ord('O'); VK_P = Ord('P');
|
||||||
|
VK_Q = Ord('Q'); VK_R = Ord('R'); VK_S = Ord('S'); VK_T = Ord('T');
|
||||||
|
VK_U = Ord('U'); VK_V = Ord('V'); VK_W = Ord('W'); VK_X = Ord('X');
|
||||||
|
VK_Y = Ord('Y'); VK_Z = Ord('Z'); VK_0 = Ord('0'); VK_1 = Ord('1');
|
||||||
|
VK_2 = Ord('2'); VK_3 = Ord('3'); VK_4 = Ord('4'); VK_5 = Ord('5');
|
||||||
|
VK_6 = Ord('6'); VK_7 = Ord('7'); VK_8 = Ord('8'); VK_9 = Ord('9');
|
||||||
|
|
||||||
|
var
|
||||||
|
AlphaCharSet : TCharSet;
|
||||||
|
|
||||||
|
const
|
||||||
|
IntegerCharSet: TCharSet = ['0'..'9', ' '];
|
||||||
|
RealCharSet : TCharSet = ['0'..'9', ' ', '-', '.'];
|
||||||
|
|
||||||
|
const
|
||||||
|
{Picture flag values for elements in a TPictureFlags array}
|
||||||
|
pflagLiteral = 0; {Corresponding char in the mask is a literal}
|
||||||
|
pflagFormat = 1; {Corresponding char in the mask is a formatting character}
|
||||||
|
pflagSemiLit = 2; {Corresponding char in the mask is a semi-literal character}
|
||||||
|
|
||||||
|
const
|
||||||
|
{------------------- Windows messages -----------------------}
|
||||||
|
{Not a message code. Value of the first of the message codes used}
|
||||||
|
OM_FIRST = $7F00; {***}
|
||||||
|
|
||||||
|
{entry field error}
|
||||||
|
OM_REPORTERROR = OM_FIRST + 0;
|
||||||
|
{messages for/from viewer/editor controls}
|
||||||
|
OM_SETFOCUS = OM_FIRST + 1;
|
||||||
|
{sent by an entry field to the controller to request return of the
|
||||||
|
focus. lParam is pointer of the object to return the focus to}
|
||||||
|
OM_SHOWSTATUS = OM_FIRST + 2;
|
||||||
|
{sent by a viewer or editor control to itself when the caret moves, or
|
||||||
|
when text is inserted or deleted. wParam is the current column (an
|
||||||
|
effective column number), and lParam is the current line}
|
||||||
|
OM_GETDATASIZE = OM_FIRST + 3;
|
||||||
|
{sent to an entry field to obtain its data size}
|
||||||
|
OM_RECREATEWND = OM_FIRST + 5;
|
||||||
|
{sent to force a call to RecreateWnd}
|
||||||
|
OM_PREEDIT = OM_FIRST + 6;
|
||||||
|
{sent to preform pre-edit notification for entry fields}
|
||||||
|
OM_POSTEDIT = OM_FIRST + 7;
|
||||||
|
{sent to preform post-edit notification for entry fields}
|
||||||
|
OM_AFTERENTER = OM_FIRST + 8;
|
||||||
|
{sent to preform after-enter notification}
|
||||||
|
OM_AFTEREXIT = OM_FIRST + 9;
|
||||||
|
{sent to preform after-exit notification}
|
||||||
|
OM_DELAYNOTIFY = OM_FIRST + 10;
|
||||||
|
{sent to preform delayed notification}
|
||||||
|
OM_POSITIONLABEL = OM_FIRST + 11;
|
||||||
|
{sent to cause the label to be repositioned}
|
||||||
|
OM_RECORDLABELPOSITION = OM_FIRST + 12;
|
||||||
|
{sent to cause the current position of the label to be recorded}
|
||||||
|
OM_ASSIGNLABEL = OM_FIRST + 13;
|
||||||
|
{sent to assign a albel to a control}
|
||||||
|
OM_FONTUPDATEPREVIEW = OM_FIRST + 14;
|
||||||
|
{sent to postpone the font change of the preview control}
|
||||||
|
OM_DESTROYHOOK = OM_FIRST + 15;
|
||||||
|
{send to cause the window hook to be destroyed}
|
||||||
|
OM_PROPCHANGE = OM_FIRST + 16;
|
||||||
|
{sent by a collection to its property editor when a property is changed}
|
||||||
|
OM_ISATTACHED = OM_FIRST + 17;
|
||||||
|
{sent to other controls to see if they are attached. Used by attached
|
||||||
|
button components and components that use an internal validator.
|
||||||
|
Result is LongInt(Self) if true}
|
||||||
|
OM_VALIDATE = OM_FIRST + 18;
|
||||||
|
{Sent to the FlexEdit as a call for it to Validate Itself}
|
||||||
|
|
||||||
|
{message crackers for the above Orpheus messages}
|
||||||
|
|
||||||
|
type
|
||||||
|
TOMReportError = packed record
|
||||||
|
Msg : Cardinal;
|
||||||
|
Error : Word;
|
||||||
|
Unused : Word;
|
||||||
|
lParam : LongInt;
|
||||||
|
Result : LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOMSetFocus = packed record
|
||||||
|
Msg : Cardinal;
|
||||||
|
wParam : Integer;
|
||||||
|
Control: TWinControl;
|
||||||
|
Result : LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOMShowStatus = packed record
|
||||||
|
Msg : Cardinal;
|
||||||
|
Column : Integer;
|
||||||
|
Line : LongInt;
|
||||||
|
Result : LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TShowStatusEvent =
|
||||||
|
procedure(Sender : TObject; LineNum : LongInt; ColNum : Integer)
|
||||||
|
of object;
|
||||||
|
{-event to notify of a viewer or editor caret position change}
|
||||||
|
|
||||||
|
TTopLineChangedEvent =
|
||||||
|
procedure(Sender : TObject; Line : LongInt)
|
||||||
|
of object;
|
||||||
|
{-event to notify when the top line changes for the editor or viewer}
|
||||||
|
|
||||||
|
const
|
||||||
|
{*** Error message codes ***}
|
||||||
|
oeFirst = 256;
|
||||||
|
|
||||||
|
oeRangeError = oeFirst + 0;
|
||||||
|
{This error occurs when a user enters a value that is not within the
|
||||||
|
accepted range of values for the field}
|
||||||
|
oeInvalidNumber = oeFirst + 1;
|
||||||
|
{This error is reported if the user enters a string that does not represent
|
||||||
|
a number in a field that should contain a numeric value}
|
||||||
|
oeRequiredField = oeFirst + 2;
|
||||||
|
{This error occurs when the user leaves blank a field that is marked as
|
||||||
|
required}
|
||||||
|
oeInvalidDate = oeFirst + 3;
|
||||||
|
{This error occurs when the user enters a value in a date field that does
|
||||||
|
not represent a valid date}
|
||||||
|
oeInvalidTime = oeFirst + 4;
|
||||||
|
{This error occurs when the user enters a value in a time field that does
|
||||||
|
not represent a valid time of day}
|
||||||
|
oeBlanksInField = oeFirst + 5;
|
||||||
|
{This error is reported only by the validation helper routines
|
||||||
|
ValidateNoBlanks and ValidateSubfields. It indicates that a blank was left
|
||||||
|
in a field or subfield in which no blanks are allowed}
|
||||||
|
oePartialEntry = oeFirst + 6;
|
||||||
|
{This error is reported only by the validation helper routines
|
||||||
|
ValidateNotPartial and ValidateSubfields in OODEWCC. It indicates that a
|
||||||
|
partial entry was given in a field or subfield in which the field/subfield
|
||||||
|
must be either entirely empty or entirely full}
|
||||||
|
oeOutOfMemory = oeFirst + 7;
|
||||||
|
{This error is reported by a viewer or editor control when there is
|
||||||
|
insufficient memory to perform the requested operation. A viewer control
|
||||||
|
reports this error only when copying selected text to the clipboard}
|
||||||
|
oeRegionSize = oeFirst + 8;
|
||||||
|
{This error is reported by an editor control when the user asks to
|
||||||
|
copy selected text to the clipboard, and the selected region exceeds
|
||||||
|
64K in size}
|
||||||
|
oeTooManyParas = oeFirst + 9;
|
||||||
|
{This error is reported by an editor control when the limit on the number
|
||||||
|
of paragraphs is reached, and the requested operation would cause it to be
|
||||||
|
exceeded}
|
||||||
|
oeCannotJoin = oeFirst + 10;
|
||||||
|
{This error is reported by an editor control when the user attempts to join
|
||||||
|
two paragraphs that cannot be joined. Typically this occurs when joining
|
||||||
|
the two paragraphs would cause the new paragraph to exceed its size limit}
|
||||||
|
oeTooManyBytes = oeFirst + 11;
|
||||||
|
{This error is reported by an editor control when the limit on the total
|
||||||
|
number of bytes is reached, and the requested operation would cause it to
|
||||||
|
be exceeded}
|
||||||
|
oeParaTooLong = oeFirst + 12;
|
||||||
|
{This error is reported by an editor control when the limit on the length
|
||||||
|
of an individual paragraph is reached, and the requested operation would
|
||||||
|
cause it to be exceeded}
|
||||||
|
oeCustomError = 32768;
|
||||||
|
{the first error code reserved for user applications. All }
|
||||||
|
{error values less than this value are reserved for use by}
|
||||||
|
{Orpheus}
|
||||||
|
|
||||||
|
{*** Field class and type constant id's ***}
|
||||||
|
|
||||||
|
const
|
||||||
|
{Field class codes}
|
||||||
|
fcSimple = 0;
|
||||||
|
fcPicture = 1;
|
||||||
|
fcNumeric = 2;
|
||||||
|
|
||||||
|
{Field class divisor}
|
||||||
|
fcpDivisor = $40;
|
||||||
|
|
||||||
|
{Field class prefixes}
|
||||||
|
fcpSimple = fcpDivisor*fcSimple;
|
||||||
|
fcpPicture = fcpDivisor*fcPicture;
|
||||||
|
fcpNumeric = fcpDivisor*fcNumeric;
|
||||||
|
|
||||||
|
{Field type IDs for simple fields}
|
||||||
|
fidSimpleString = fcpSimple+fsubString;
|
||||||
|
fidSimpleChar = fcpSimple+fsubChar;
|
||||||
|
fidSimpleBoolean = fcpSimple+fsubBoolean;
|
||||||
|
fidSimpleYesNo = fcpSimple+fsubYesNo;
|
||||||
|
fidSimpleLongInt = fcpSimple+fsubLongInt;
|
||||||
|
fidSimpleWord = fcpSimple+fsubWord;
|
||||||
|
fidSimpleInteger = fcpSimple+fsubInteger;
|
||||||
|
fidSimpleByte = fcpSimple+fsubByte;
|
||||||
|
fidSimpleShortInt = fcpSimple+fsubShortInt;
|
||||||
|
fidSimpleReal = fcpSimple+fsubReal;
|
||||||
|
fidSimpleExtended = fcpSimple+fsubExtended;
|
||||||
|
fidSimpleDouble = fcpSimple+fsubDouble;
|
||||||
|
fidSimpleSingle = fcpSimple+fsubSingle;
|
||||||
|
fidSimpleComp = fcpSimple+fsubComp;
|
||||||
|
|
||||||
|
{Field type IDs for picture fields}
|
||||||
|
fidPictureString = fcpPicture+fsubString;
|
||||||
|
fidPictureChar = fcpPicture+fsubChar;
|
||||||
|
fidPictureBoolean = fcpPicture+fsubBoolean;
|
||||||
|
fidPictureYesNo = fcpPicture+fsubYesNo;
|
||||||
|
fidPictureLongInt = fcpPicture+fsubLongInt;
|
||||||
|
fidPictureWord = fcpPicture+fsubWord;
|
||||||
|
fidPictureInteger = fcpPicture+fsubInteger;
|
||||||
|
fidPictureByte = fcpPicture+fsubByte;
|
||||||
|
fidPictureShortInt = fcpPicture+fsubShortInt;
|
||||||
|
fidPictureReal = fcpPicture+fsubReal;
|
||||||
|
fidPictureExtended = fcpPicture+fsubExtended;
|
||||||
|
fidPictureDouble = fcpPicture+fsubDouble;
|
||||||
|
fidPictureSingle = fcpPicture+fsubSingle;
|
||||||
|
fidPictureComp = fcpPicture+fsubComp;
|
||||||
|
fidPictureDate = fcpPicture+fsubDate;
|
||||||
|
fidPictureTime = fcpPicture+fsubTime;
|
||||||
|
|
||||||
|
{Field type IDs for numeric fields}
|
||||||
|
fidNumericLongInt = fcpNumeric+fsubLongInt;
|
||||||
|
fidNumericWord = fcpNumeric+fsubWord;
|
||||||
|
fidNumericInteger = fcpNumeric+fsubInteger;
|
||||||
|
fidNumericByte = fcpNumeric+fsubByte;
|
||||||
|
fidNumericShortInt = fcpNumeric+fsubShortInt;
|
||||||
|
fidNumericReal = fcpNumeric+fsubReal;
|
||||||
|
fidNumericExtended = fcpNumeric+fsubExtended;
|
||||||
|
fidNumericDouble = fcpNumeric+fsubDouble;
|
||||||
|
fidNumericSingle = fcpNumeric+fsubSingle;
|
||||||
|
fidNumericComp = fcpNumeric+fsubComp;
|
||||||
|
|
||||||
|
|
||||||
|
function GetOrphStr(Index : Word) : string;
|
||||||
|
{-return a string from our RCDATA string resource}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function GetOrphStr(Index : Word) : string;
|
||||||
|
begin
|
||||||
|
Result := ResourceStrByNumber(Index);
|
||||||
|
if Result = '' then
|
||||||
|
Result := 'Unknown';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure InitAlphaCharSet;
|
||||||
|
{-Initialize AlphaOnlySet}
|
||||||
|
var
|
||||||
|
C : AnsiChar;
|
||||||
|
begin
|
||||||
|
AlphaCharSet := ['A'..'Z', 'a'..'z', ' ', '-', '.', ','];
|
||||||
|
for C := #128 to #255 do
|
||||||
|
{ask windows what other characters are considered alphas}
|
||||||
|
if IsCharAlpha(C) then
|
||||||
|
AlphaCharSet := AlphaCharSet + [C];
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
InitAlphaCharSet;
|
||||||
|
|
||||||
|
end.
|
||||||
996
components/orpheus/ovcdate.pas
Normal file
996
components/orpheus/ovcdate.pas
Normal file
@ -0,0 +1,996 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCDATE.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$IFDEF VERSION7}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$WARN UNSAFE_CODE OFF}
|
||||||
|
{$WARN UNSAFE_TYPE OFF}
|
||||||
|
{$WARN UNSAFE_CAST OFF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{For BCB 3.0 package support.}
|
||||||
|
{$IFDEF VER110}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{---Global compiler defines for Delphi 2.0---}
|
||||||
|
{$A+} {Word Align Data}
|
||||||
|
{$H+} {Huge string support}
|
||||||
|
{$Q-} {Overflow check}
|
||||||
|
{$R-} {Range check}
|
||||||
|
{$S-} {Stack check}
|
||||||
|
{$T-} {Typed @ check}
|
||||||
|
{$V-} {Var strings}
|
||||||
|
|
||||||
|
unit ovcdate; {formerly StDate}
|
||||||
|
{-Date and time manipulation}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TStDate = LongInt;
|
||||||
|
{In STDATE, dates are stored in long integer format as the number of days
|
||||||
|
since January 1, 1600}
|
||||||
|
|
||||||
|
TDateArray = array[0..(MaxLongInt div SizeOf(TStDate))-1] of TStDate;
|
||||||
|
{Type for StDate open array}
|
||||||
|
|
||||||
|
TStDayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
|
||||||
|
{An enumerated type used when representing a day of the week}
|
||||||
|
|
||||||
|
TStBondDateType = (bdtActual, bdt30E360, bdt30360, bdt30360psa);
|
||||||
|
{An enumerated type used for calculating bond date differences}
|
||||||
|
|
||||||
|
TStTime = LongInt;
|
||||||
|
{STDATE handles time in a manner similar to dates, representing a given
|
||||||
|
time of day as the number of seconds since midnight}
|
||||||
|
|
||||||
|
TStDateTimeRec =
|
||||||
|
record
|
||||||
|
{This record type simply combines the two basic date types defined by
|
||||||
|
STDATE, Date and Time}
|
||||||
|
D : TStDate;
|
||||||
|
T : TStTime;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
MinYear = 1600; {Minimum valid year for a date variable}
|
||||||
|
MaxYear = 3999; {Maximum valid year for a date variable}
|
||||||
|
Mindate = $00000000; {Minimum valid date for a date variable - 01/01/1600}
|
||||||
|
Maxdate = $000D6025; {Maximum valid date for a date variable - 12/31/3999}
|
||||||
|
Date1900 = $0001AC05; {This constant contains the Julian date for 01/01/1900}
|
||||||
|
Date1980 = $00021E28; {This constant contains the Julian date for 01/01/1980}
|
||||||
|
Date2000 = $00023AB1; {This constant contains the Julian date for 01/01/2000}
|
||||||
|
{This value is used to represent an invalid date, such as 12/32/1992}
|
||||||
|
BadDate = LongInt($FFFFFFFF);
|
||||||
|
|
||||||
|
DeltaJD = $00232DA8; {Days between 1/1/-4173 and 1/1/1600}
|
||||||
|
|
||||||
|
MinTime = 0; {Minimum valid time for a time variable - 00:00:00 am}
|
||||||
|
MaxTime = 86399; {Maximum valid time for a time variable - 23:59:59 pm}
|
||||||
|
{This value is used to represent an invalid time of day, such as 12:61:00}
|
||||||
|
BadTime = LongInt($FFFFFFFF);
|
||||||
|
|
||||||
|
SecondsInDay = 86400; {Number of seconds in a day}
|
||||||
|
SecondsInHour = 3600; {Number of seconds in an hour}
|
||||||
|
SecondsInMinute = 60; {Number of seconds in a minute}
|
||||||
|
HoursInDay = 24; {Number of hours in a day}
|
||||||
|
MinutesInHour = 60; {Number of minutes in an hour}
|
||||||
|
MinutesInDay = 1440; {Number of minutes in a day}
|
||||||
|
|
||||||
|
var
|
||||||
|
DefaultYear : Integer; {default year--used by DateStringToDMY}
|
||||||
|
DefaultMonth : ShortInt; {default month}
|
||||||
|
|
||||||
|
{-------julian date routines---------------}
|
||||||
|
|
||||||
|
function CurrentDate : TStDate;
|
||||||
|
{-returns today's date as a Julian date}
|
||||||
|
|
||||||
|
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
|
||||||
|
{-Verify that day, month, year is a valid date}
|
||||||
|
|
||||||
|
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
|
||||||
|
{-Convert from day, month, year to a Julian date}
|
||||||
|
|
||||||
|
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
|
||||||
|
{-Convert from a Julian date to day, month, year}
|
||||||
|
|
||||||
|
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
|
||||||
|
{-Add (or subtract) the number of days, months, and years to a date}
|
||||||
|
|
||||||
|
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
|
||||||
|
{-Add (or subtract) the specified number of months and years to a date}
|
||||||
|
|
||||||
|
procedure DateDiff(Date1, Date2 : TStDate;
|
||||||
|
var Days, Months, Years : Integer);
|
||||||
|
{-Return the difference in days, months, and years between two valid Julian
|
||||||
|
dates}
|
||||||
|
|
||||||
|
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
|
||||||
|
{-Return the difference in days between two valid Julian
|
||||||
|
dates using a specific financial basis}
|
||||||
|
|
||||||
|
function WeekOfYear(Julian : TStDate) : Byte;
|
||||||
|
{-Returns the week number of the year given the Julian Date}
|
||||||
|
|
||||||
|
function AstJulianDate(Julian : TStDate) : Double;
|
||||||
|
{-Returns the Astronomical Julian Date from a TStDate}
|
||||||
|
|
||||||
|
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
|
||||||
|
{-Returns a TStDate from an Astronomical Julian Date.
|
||||||
|
Truncate TRUE Converts to appropriate 0 hours then truncates
|
||||||
|
FALSE Converts to appropriate 0 hours, then rounds to
|
||||||
|
nearest;}
|
||||||
|
|
||||||
|
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
|
||||||
|
{-Returns an Astronomical Julian Date for any year, even those outside
|
||||||
|
MinYear..MaxYear}
|
||||||
|
|
||||||
|
function DayOfWeek(Julian : TStDate) : TStDayType;
|
||||||
|
{-Return the day of the week for a Julian date}
|
||||||
|
|
||||||
|
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
|
||||||
|
{-Return the day of the week for the day, month, year}
|
||||||
|
|
||||||
|
function IsLeapYear(Year : Integer) : Boolean;
|
||||||
|
{-Return True if Year is a leap year}
|
||||||
|
|
||||||
|
function DaysInMonth(Month : Integer; Year, Epoch : Integer) : Integer;
|
||||||
|
{-Return the number of days in the specified month of a given year}
|
||||||
|
|
||||||
|
function ResolveEpoch(Year, Epoch : Integer) : Integer;
|
||||||
|
{-Convert 2 digit year to 4 digit year according to Epoch}
|
||||||
|
|
||||||
|
|
||||||
|
{-------time routines---------------}
|
||||||
|
|
||||||
|
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
|
||||||
|
{-Return True if Hours:Minutes:Seconds is a valid time}
|
||||||
|
|
||||||
|
procedure StTimeToHMS(T : TStTime;
|
||||||
|
var Hours, Minutes, Seconds : Byte);
|
||||||
|
{-Convert a time variable to hours, minutes, seconds}
|
||||||
|
|
||||||
|
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Convert hours, minutes, seconds to a time variable}
|
||||||
|
|
||||||
|
function CurrentTime : TStTime;
|
||||||
|
{-Return the current time in seconds since midnight}
|
||||||
|
|
||||||
|
procedure TimeDiff(Time1, Time2 : TStTime;
|
||||||
|
var Hours, Minutes, Seconds : Byte);
|
||||||
|
{-Return the difference in hours, minutes, and seconds between two times}
|
||||||
|
|
||||||
|
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Add the specified hours, minutes, and seconds to a given time of day}
|
||||||
|
|
||||||
|
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Subtract the specified hours, minutes, and seconds from a given time of day}
|
||||||
|
|
||||||
|
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
|
||||||
|
{-Given a time, round it to the nearest hour, or truncate minutes and
|
||||||
|
seconds}
|
||||||
|
|
||||||
|
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
|
||||||
|
{-Given a time, round it to the nearest minute, or truncate seconds}
|
||||||
|
|
||||||
|
{-------- routines for DateTimeRec records ---------}
|
||||||
|
|
||||||
|
procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
|
||||||
|
var Days : LongInt; var Secs : LongInt);
|
||||||
|
{-Return the difference in days and seconds between two points in time}
|
||||||
|
|
||||||
|
procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
|
||||||
|
Days : Integer; Secs : LongInt);
|
||||||
|
{-Increment (or decrement) a date and time by the specified number of days
|
||||||
|
and seconds}
|
||||||
|
|
||||||
|
function DateTimeToStDate(DT : TDateTime) : TStDate;
|
||||||
|
{-Convert Delphi TDateTime to TStDate}
|
||||||
|
|
||||||
|
function DateTimeToStTime(DT : TDateTime) : TStTime;
|
||||||
|
{-Convert Delphi TDateTime to TStTime}
|
||||||
|
|
||||||
|
function StDateToDateTime(D : TStDate) : TDateTime;
|
||||||
|
{-Convert TStDate to TDateTime}
|
||||||
|
|
||||||
|
function StTimeToDateTime(T : TStTime) : TDateTime;
|
||||||
|
{-Convert TStTime to TDateTime}
|
||||||
|
|
||||||
|
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
|
||||||
|
{-Convert an Object Professional two byte date into a SysTools date}
|
||||||
|
|
||||||
|
function Convert4ByteDate(FourByteDate : TStDate) : Word;
|
||||||
|
{-Convert a SysTools date into an Object Professional two byte date}
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
First2Months = 59; {1600 was a leap year}
|
||||||
|
FirstDayOfWeek = Saturday; {01/01/1600 was a Saturday}
|
||||||
|
DateLen = 40; {maximum length of Picture strings}
|
||||||
|
MaxMonthName = 15;
|
||||||
|
MaxDayName = 15;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
{ DateString = string[DateLen];}
|
||||||
|
SString = string[255];
|
||||||
|
|
||||||
|
function IsLeapYear(Year : Integer) : Boolean;
|
||||||
|
{-Return True if Year is a leap year}
|
||||||
|
begin
|
||||||
|
Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
|
||||||
|
((Year mod 100 <> 0) or (Year mod 400 = 0));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsLastDayofMonth(Day, Month, Year : Integer) : Boolean;
|
||||||
|
{-Return True if date is the last day in month}
|
||||||
|
var
|
||||||
|
Epoch : Integer;
|
||||||
|
begin
|
||||||
|
Epoch := (Year div 100) * 100;
|
||||||
|
if ValidDate(Day + 1, Month, Year, Epoch) then
|
||||||
|
Result := false
|
||||||
|
else
|
||||||
|
Result := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsLastDayofFeb(Date : TStDate) : Boolean;
|
||||||
|
{-Return True if date is the last day in February}
|
||||||
|
var
|
||||||
|
Day, Month, Year : Integer;
|
||||||
|
begin
|
||||||
|
StDateToDMY(Date, Day, Month, Year);
|
||||||
|
if (Month = 2) and IsLastDayOfMonth(Day, Month, Year) then
|
||||||
|
Result := true
|
||||||
|
else
|
||||||
|
Result := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF NoAsm}
|
||||||
|
procedure ExchangeLongInts(var I, J : LongInt);
|
||||||
|
var
|
||||||
|
Temp : LongInt;
|
||||||
|
begin
|
||||||
|
Temp := I;
|
||||||
|
I := J;
|
||||||
|
J := Temp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// ExchangeStructs not needed - see the one place where called below.
|
||||||
|
|
||||||
|
{$ELSE}
|
||||||
|
procedure ExchangeLongInts(var I, J : LongInt);
|
||||||
|
register;
|
||||||
|
asm
|
||||||
|
mov ecx, [eax]
|
||||||
|
push ecx
|
||||||
|
mov ecx, [edx]
|
||||||
|
mov [eax], ecx
|
||||||
|
pop ecx
|
||||||
|
mov [edx], ecx
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ExchangeStructs(var I, J; Size : Cardinal);
|
||||||
|
register;
|
||||||
|
asm
|
||||||
|
push edi
|
||||||
|
push ebx
|
||||||
|
push ecx
|
||||||
|
shr ecx, 2
|
||||||
|
jz @@LessThanFour
|
||||||
|
|
||||||
|
@@AgainDWords:
|
||||||
|
mov ebx, [eax]
|
||||||
|
mov edi, [edx]
|
||||||
|
mov [edx], ebx
|
||||||
|
mov [eax], edi
|
||||||
|
add eax, 4
|
||||||
|
add edx, 4
|
||||||
|
dec ecx
|
||||||
|
jnz @@AgainDWords
|
||||||
|
|
||||||
|
@@LessThanFour:
|
||||||
|
pop ecx
|
||||||
|
and ecx, $3
|
||||||
|
jz @@Done
|
||||||
|
mov bl, [eax]
|
||||||
|
mov bh, [edx]
|
||||||
|
mov [edx], bl
|
||||||
|
mov [eax], bh
|
||||||
|
inc eax
|
||||||
|
inc edx
|
||||||
|
dec ecx
|
||||||
|
jz @@Done
|
||||||
|
|
||||||
|
mov bl, [eax]
|
||||||
|
mov bh, [edx]
|
||||||
|
mov [edx], bl
|
||||||
|
mov [eax], bh
|
||||||
|
inc eax
|
||||||
|
inc edx
|
||||||
|
dec ecx
|
||||||
|
jz @@Done
|
||||||
|
|
||||||
|
mov bl, [eax]
|
||||||
|
mov bh, [edx]
|
||||||
|
mov [edx], bl
|
||||||
|
mov [eax], bh
|
||||||
|
|
||||||
|
@@Done:
|
||||||
|
pop ebx
|
||||||
|
pop edi
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
function ResolveEpoch(Year, Epoch : Integer) : Integer;
|
||||||
|
{-Convert 2-digit year to 4-digit year according to Epoch}
|
||||||
|
var
|
||||||
|
EpochYear,
|
||||||
|
EpochCent : Integer;
|
||||||
|
begin
|
||||||
|
if Word(Year) < 100 then begin
|
||||||
|
EpochYear := Epoch mod 100;
|
||||||
|
EpochCent := (Epoch div 100) * 100;
|
||||||
|
if (Year < EpochYear) then
|
||||||
|
Inc(Year,EpochCent+100)
|
||||||
|
else
|
||||||
|
Inc(Year,EpochCent);
|
||||||
|
end;
|
||||||
|
Result := Year;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CurrentDate : TStDate;
|
||||||
|
{-Returns today's date as a julian}
|
||||||
|
var
|
||||||
|
Year, Month, Date : Word;
|
||||||
|
begin
|
||||||
|
DecodeDate(Now,Year,Month,Date);
|
||||||
|
Result := DMYToStDate(Date,Month,Year,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DaysInMonth(Month : integer; Year, Epoch : Integer) : Integer;
|
||||||
|
{-Return the number of days in the specified month of a given year}
|
||||||
|
begin
|
||||||
|
Year := ResolveEpoch(Year, Epoch);
|
||||||
|
|
||||||
|
if (Year < MinYear) OR (Year > MaxYear) then
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case Month of
|
||||||
|
1, 3, 5, 7, 8, 10, 12 :
|
||||||
|
Result := 31;
|
||||||
|
4, 6, 9, 11 :
|
||||||
|
Result := 30;
|
||||||
|
2 :
|
||||||
|
Result := 28+Ord(IsLeapYear(Year));
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
|
||||||
|
{-Verify that day, month, year is a valid date}
|
||||||
|
begin
|
||||||
|
Year := ResolveEpoch(Year, Epoch);
|
||||||
|
|
||||||
|
if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
|
||||||
|
Result := False
|
||||||
|
else case Month of
|
||||||
|
1..12 :
|
||||||
|
Result := Day <= DaysInMonth(Month, Year, Epoch);
|
||||||
|
else
|
||||||
|
Result := False;
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
|
||||||
|
{-Convert from day, month, year to a julian date}
|
||||||
|
begin
|
||||||
|
Year := ResolveEpoch(Year, Epoch);
|
||||||
|
|
||||||
|
if not ValidDate(Day, Month, Year, Epoch) then
|
||||||
|
Result := BadDate
|
||||||
|
else if (Year = MinYear) and (Month < 3) then
|
||||||
|
if Month = 1 then
|
||||||
|
Result := Pred(Day)
|
||||||
|
else
|
||||||
|
Result := Day+30
|
||||||
|
else begin
|
||||||
|
if Month > 2 then
|
||||||
|
Dec(Month, 3)
|
||||||
|
else begin
|
||||||
|
Inc(Month, 9);
|
||||||
|
Dec(Year);
|
||||||
|
end;
|
||||||
|
Dec(Year, MinYear);
|
||||||
|
Result :=
|
||||||
|
((LongInt(Year div 100)*146097) div 4)+
|
||||||
|
((LongInt(Year mod 100)*1461) div 4)+
|
||||||
|
(((153*Month)+2) div 5)+Day+First2Months;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WeekOfYear(Julian : TStDate) : Byte;
|
||||||
|
{-Returns the week number of the year given the Julian Date}
|
||||||
|
var
|
||||||
|
Day, Month, Year : Integer;
|
||||||
|
FirstJulian : TStDate;
|
||||||
|
begin
|
||||||
|
if (Julian < MinDate) or (Julian > MaxDate) then
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Julian := Julian + 3 - ((6 + Ord(DayOfWeek(Julian))) mod 7);
|
||||||
|
StDateToDMY(Julian,Day,Month,Year);
|
||||||
|
FirstJulian := DMYToStDate(1,1,Year,0);
|
||||||
|
Result := 1 + (Julian - FirstJulian) div 7;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function AstJulianDate(Julian : TStDate) : Double;
|
||||||
|
{-Returns the Astronomical Julian Date from a TStDate}
|
||||||
|
begin
|
||||||
|
{Subtract 0.5d since Astronomical JD starts at noon
|
||||||
|
while TStDate (with implied .0) starts at midnight}
|
||||||
|
Result := Julian - 0.5 + DeltaJD;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
|
||||||
|
var
|
||||||
|
A, B : integer;
|
||||||
|
LY,
|
||||||
|
GC : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := -MaxLongInt;
|
||||||
|
if (not (Month in [1..12])) or (Date < 1) then
|
||||||
|
Exit
|
||||||
|
else if (Month in [1, 3, 5, 7, 8, 10, 12]) and (Date > 31) then
|
||||||
|
Exit
|
||||||
|
else if (Month in [4, 6, 9, 11]) and (Date > 30) then
|
||||||
|
Exit
|
||||||
|
else if (Month = 2) then begin
|
||||||
|
LY := IsLeapYear(Year);
|
||||||
|
if ((LY) and (Date > 29)) or (not (LY) and (Date > 28)) then
|
||||||
|
Exit;
|
||||||
|
end else if ((UT < 0) or (UT >= SecondsInDay)) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if (Month <= 2) then begin
|
||||||
|
Year := Year - 1;
|
||||||
|
Month := Month + 12;
|
||||||
|
end;
|
||||||
|
A := abs(Year div 100);
|
||||||
|
|
||||||
|
if (Year > 1582) then
|
||||||
|
GC := True
|
||||||
|
else if (Year = 1582) then begin
|
||||||
|
if (Month > 10) then
|
||||||
|
GC := True
|
||||||
|
else if (Month < 10) then
|
||||||
|
GC := False
|
||||||
|
else begin
|
||||||
|
if (Date >= 15) then
|
||||||
|
GC := True
|
||||||
|
else
|
||||||
|
GC := False;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
GC := False;
|
||||||
|
if (GC) then
|
||||||
|
B := 2 - A + abs(A div 4)
|
||||||
|
else
|
||||||
|
B := 0;
|
||||||
|
|
||||||
|
Result := Trunc(365.25 * (Year + 4716))
|
||||||
|
+ Trunc(30.6001 * (Month + 1))
|
||||||
|
+ Date + B - 1524.5
|
||||||
|
+ UT / SecondsInDay;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
|
||||||
|
{-Returns a TStDate from an Astronomical Julian Date.
|
||||||
|
Truncate TRUE Converts to appropriate 0 hours then truncates
|
||||||
|
FALSE Converts to appropriate 0 hours, then rounds to
|
||||||
|
nearest;}
|
||||||
|
begin
|
||||||
|
{Convert to TStDate, adding 0.5d for implied .0d of TStDate}
|
||||||
|
AstJulian := AstJulian + 0.5 - DeltaJD;
|
||||||
|
if (AstJulian < MinDate) OR (AstJulian > MaxDate) then
|
||||||
|
begin
|
||||||
|
Result := BadDate;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Truncate then
|
||||||
|
Result := Trunc(AstJulian)
|
||||||
|
else
|
||||||
|
Result := Trunc(AstJulian + 0.5);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
|
||||||
|
{-Convert from a julian date to month, day, year}
|
||||||
|
var
|
||||||
|
I, J : LongInt;
|
||||||
|
begin
|
||||||
|
if Julian = BadDate then begin
|
||||||
|
Day := 0;
|
||||||
|
Month := 0;
|
||||||
|
Year := 0;
|
||||||
|
end else if Julian <= First2Months then begin
|
||||||
|
Year := MinYear;
|
||||||
|
if Julian <= 30 then begin
|
||||||
|
Month := 1;
|
||||||
|
Day := Succ(Julian);
|
||||||
|
end else begin
|
||||||
|
Month := 2;
|
||||||
|
Day := Julian-30;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
I := (4*LongInt(Julian-First2Months))-1;
|
||||||
|
|
||||||
|
J := (4*((I mod 146097) div 4))+3;
|
||||||
|
Year := (100*(I div 146097))+(J div 1461);
|
||||||
|
I := (5*(((J mod 1461)+4) div 4))-3;
|
||||||
|
Day := ((I mod 153)+5) div 5;
|
||||||
|
|
||||||
|
Month := I div 153;
|
||||||
|
if Month < 10 then
|
||||||
|
Inc(Month, 3)
|
||||||
|
else begin
|
||||||
|
Dec(Month, 9);
|
||||||
|
Inc(Year);
|
||||||
|
end;
|
||||||
|
Inc(Year, MinYear);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
|
||||||
|
{-Add (or subtract) the number of months, days, and years to a date.
|
||||||
|
Months and years are added before days. No overflow/underflow
|
||||||
|
checks are made}
|
||||||
|
var
|
||||||
|
Day, Month, Year, Day28Delta : Integer;
|
||||||
|
begin
|
||||||
|
StDateToDMY(Julian, Day, Month, Year);
|
||||||
|
Day28Delta := Day-28;
|
||||||
|
if Day28Delta < 0 then
|
||||||
|
Day28Delta := 0
|
||||||
|
else
|
||||||
|
Day := 28;
|
||||||
|
|
||||||
|
Inc(Year, Years);
|
||||||
|
Inc(Year, Months div 12);
|
||||||
|
Inc(Month, Months mod 12);
|
||||||
|
if Month < 1 then begin
|
||||||
|
Inc(Month, 12);
|
||||||
|
Dec(Year);
|
||||||
|
end
|
||||||
|
else if Month > 12 then begin
|
||||||
|
Dec(Month, 12);
|
||||||
|
Inc(Year);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Julian := DMYtoStDate(Day, Month, Year,0);
|
||||||
|
if Julian <> BadDate then begin
|
||||||
|
Inc(Julian, Days);
|
||||||
|
Inc(Julian, Day28Delta);
|
||||||
|
end;
|
||||||
|
Result := Julian;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
|
||||||
|
{-Add (or subtract) the specified number of months and years to a date}
|
||||||
|
var
|
||||||
|
Day, Month, Year : Integer;
|
||||||
|
MaxDay, Day28Delta : Integer;
|
||||||
|
begin
|
||||||
|
StDateToDMY(Julian, Day, Month, Year);
|
||||||
|
Day28Delta := Day-28;
|
||||||
|
if Day28Delta < 0 then
|
||||||
|
Day28Delta := 0
|
||||||
|
else
|
||||||
|
Day := 28;
|
||||||
|
|
||||||
|
Inc(Year, Years);
|
||||||
|
Inc(Year, Months div 12);
|
||||||
|
Inc(Month, Months mod 12);
|
||||||
|
if Month < 1 then begin
|
||||||
|
Inc(Month, 12);
|
||||||
|
Dec(Year);
|
||||||
|
end
|
||||||
|
else if Month > 12 then begin
|
||||||
|
Dec(Month, 12);
|
||||||
|
Inc(Year);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Julian := DMYtoStDate(Day, Month, Year,0);
|
||||||
|
if Julian <> BadDate then begin
|
||||||
|
MaxDay := DaysInMonth(Month, Year,0);
|
||||||
|
if Day+Day28Delta > MaxDay then
|
||||||
|
Inc(Julian, MaxDay-Day)
|
||||||
|
else
|
||||||
|
Inc(Julian, Day28Delta);
|
||||||
|
end;
|
||||||
|
Result := Julian;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DateDiff(Date1, Date2 : TStDate; var Days, Months, Years : Integer);
|
||||||
|
{-Return the difference in days,months,years between two valid julian dates}
|
||||||
|
var
|
||||||
|
Day1, Day2, Month1, Month2, Year1, Year2 : Integer;
|
||||||
|
begin
|
||||||
|
{we want Date2 > Date1}
|
||||||
|
if Date1 > Date2 then
|
||||||
|
ExchangeLongInts(Date1, Date2);
|
||||||
|
|
||||||
|
{convert dates to day,month,year}
|
||||||
|
StDateToDMY(Date1, Day1, Month1, Year1);
|
||||||
|
StDateToDMY(Date2, Day2, Month2, Year2);
|
||||||
|
|
||||||
|
{days first}
|
||||||
|
if (Day1 = DaysInMonth(Month1, Year1, 0)) then begin
|
||||||
|
Day1 := 0;
|
||||||
|
Inc(Month1); {OK if Month1 > 12}
|
||||||
|
end;
|
||||||
|
if (Day2 = DaysInMonth(Month2, Year2, 0)) then begin
|
||||||
|
Day2 := 0;
|
||||||
|
Inc(Month2); {OK if Month2 > 12}
|
||||||
|
end;
|
||||||
|
if (Day2 < Day1) then begin
|
||||||
|
Dec(Month2);
|
||||||
|
if Month2 = 0 then begin
|
||||||
|
Month2 := 12;
|
||||||
|
Dec(Year2);
|
||||||
|
end;
|
||||||
|
Days := Day2 + DaysInMonth(Month1, Year1, 0) - Day1;
|
||||||
|
end else
|
||||||
|
Days := Day2-Day1;
|
||||||
|
|
||||||
|
{now months and years}
|
||||||
|
if Month2 < Month1 then begin
|
||||||
|
Inc(Month2, 12);
|
||||||
|
Dec(Year2);
|
||||||
|
end;
|
||||||
|
Months := Month2-Month1;
|
||||||
|
Years := Year2-Year1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
|
||||||
|
{-Return the difference in days between two valid Julian
|
||||||
|
dates using one a specific accrual method}
|
||||||
|
var
|
||||||
|
Day1,
|
||||||
|
Month1,
|
||||||
|
Year1,
|
||||||
|
Day2,
|
||||||
|
Month2,
|
||||||
|
Year2 : Integer;
|
||||||
|
IY : LongInt;
|
||||||
|
begin
|
||||||
|
{we want Date2 > Date1}
|
||||||
|
if Date1 > Date2 then
|
||||||
|
ExchangeLongInts(Date1, Date2);
|
||||||
|
|
||||||
|
if (DayBasis = bdtActual) then
|
||||||
|
Result := Date2-Date1
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
StDateToDMY(Date1, Day1, Month1, Year1);
|
||||||
|
StDateToDMY(Date2, Day2, Month2, Year2);
|
||||||
|
|
||||||
|
if ((DayBasis = bdt30360PSA) and IsLastDayofFeb(Date1)) or (Day1 = 31) then
|
||||||
|
Day1 := 30;
|
||||||
|
if (DayBasis = bdt30E360) then
|
||||||
|
begin
|
||||||
|
if (Day2 = 31) then
|
||||||
|
Day2 := 30
|
||||||
|
end else
|
||||||
|
if (Day2 = 31) and (Day1 >= 30) then
|
||||||
|
Day2 := 30;
|
||||||
|
|
||||||
|
IY := 360 * (Year2 - Year1);
|
||||||
|
Result := IY + 30 * (Month2 - Month1) + (Day2 - Day1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DayOfWeek(Julian : TStDate) : TStDayType;
|
||||||
|
{-Return the day of the week for the date. Returns TStDayType(7) if Julian =
|
||||||
|
BadDate.}
|
||||||
|
var
|
||||||
|
B : Byte;
|
||||||
|
begin
|
||||||
|
if Julian = BadDate then begin
|
||||||
|
B := 7;
|
||||||
|
Result := TStDayType(B);
|
||||||
|
end else
|
||||||
|
Result := TStDayType( (Julian+Ord(FirstDayOfWeek)) mod 7 );
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
|
||||||
|
{-Return the day of the week for the day, month, year}
|
||||||
|
begin
|
||||||
|
Result := DayOfWeek( DMYtoStDate(Day, Month, Year, Epoch) );
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure StTimeToHMS(T : TStTime; var Hours, Minutes, Seconds : Byte);
|
||||||
|
{-Convert a Time variable to Hours, Minutes, Seconds}
|
||||||
|
begin
|
||||||
|
if T = BadTime then begin
|
||||||
|
Hours := 0;
|
||||||
|
Minutes := 0;
|
||||||
|
Seconds := 0;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
Hours := T div SecondsInHour;
|
||||||
|
Dec(T, LongInt(Hours)*SecondsInHour);
|
||||||
|
Minutes := T div SecondsInMinute;
|
||||||
|
Dec(T, LongInt(Minutes)*SecondsInMinute);
|
||||||
|
Seconds := T;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Convert Hours, Minutes, Seconds to a Time variable}
|
||||||
|
var
|
||||||
|
T : TStTime;
|
||||||
|
begin
|
||||||
|
Hours := Hours mod HoursInDay;
|
||||||
|
T := (LongInt(Hours)*SecondsInHour)+(LongInt(Minutes)*SecondsInMinute)+Seconds;
|
||||||
|
Result := T mod SecondsInDay;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
|
||||||
|
{-Return true if Hours:Minutes:Seconds is a valid time}
|
||||||
|
begin
|
||||||
|
if (Hours < 0) or (Hours > 23) or
|
||||||
|
(Minutes < 0) or (Minutes >= 60) or
|
||||||
|
(Seconds < 0) or (Seconds >= 60) then
|
||||||
|
Result := False
|
||||||
|
else
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CurrentTime : TStTime;
|
||||||
|
{-Returns current time in seconds since midnight}
|
||||||
|
begin
|
||||||
|
Result := Trunc(SysUtils.Time * SecondsInDay);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TimeDiff(Time1, Time2 : TStTime; var Hours, Minutes, Seconds : Byte);
|
||||||
|
{-Return the difference in hours,minutes,seconds between two times}
|
||||||
|
begin
|
||||||
|
StTimeToHMS(Abs(Time1-Time2), Hours, Minutes, Seconds);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Add the specified hours,minutes,seconds to T and return the result}
|
||||||
|
begin
|
||||||
|
Inc(T, HMStoStTime(Hours, Minutes, Seconds));
|
||||||
|
Result := T mod SecondsInDay;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
||||||
|
{-Subtract the specified hours,minutes,seconds from T and return the result}
|
||||||
|
begin
|
||||||
|
Hours := Hours mod HoursInDay;
|
||||||
|
Dec(T, HMStoStTime(Hours, Minutes, Seconds));
|
||||||
|
if T < 0 then
|
||||||
|
Result := T+SecondsInDay
|
||||||
|
else
|
||||||
|
Result := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
|
||||||
|
{-Round T to the nearest hour, or Truncate minutes and seconds from T}
|
||||||
|
var
|
||||||
|
Hours, Minutes, Seconds : Byte;
|
||||||
|
begin
|
||||||
|
StTimeToHMS(T, Hours, Minutes, Seconds);
|
||||||
|
Seconds := 0;
|
||||||
|
if not Truncate then
|
||||||
|
if Minutes >= (MinutesInHour div 2) then
|
||||||
|
Inc(Hours);
|
||||||
|
Minutes := 0;
|
||||||
|
Result := HMStoStTime(Hours, Minutes, Seconds);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
|
||||||
|
{-Round T to the nearest minute, or Truncate seconds from T}
|
||||||
|
var
|
||||||
|
Hours, Minutes, Seconds : Byte;
|
||||||
|
begin
|
||||||
|
StTimeToHMS(T, Hours, Minutes, Seconds);
|
||||||
|
if not Truncate then
|
||||||
|
if Seconds >= (SecondsInMinute div 2) then
|
||||||
|
Inc(Minutes);
|
||||||
|
Seconds := 0;
|
||||||
|
Result := HMStoStTime(Hours, Minutes, Seconds);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
|
||||||
|
var Days : LongInt; var Secs : LongInt);
|
||||||
|
{-Return the difference in days and seconds between two points in time}
|
||||||
|
var
|
||||||
|
tDT1, tDT2 : TStDateTimeRec;
|
||||||
|
{$IFDEF NoAsm}
|
||||||
|
Temp : TStDateTimeRec;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
tDT1 := DT1;
|
||||||
|
tDT2 := DT2;
|
||||||
|
{swap if tDT1 later than tDT2}
|
||||||
|
if (tDT1.D > tDT2.D) or ((tDT1.D = tDT2.D) and (tDT1.T > tDT2.T)) then
|
||||||
|
{$IFDEF NoAsm}
|
||||||
|
begin
|
||||||
|
Temp := tDT1;
|
||||||
|
tDT1 := tDT2;
|
||||||
|
tDT2 := Temp;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
ExchangeStructs(tDT1, tDT2,sizeof(TStDateTimeRec));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{the difference in days is easy}
|
||||||
|
Days := tDT2.D-tDT1.D;
|
||||||
|
|
||||||
|
{difference in seconds}
|
||||||
|
if tDT2.T < tDT1.T then begin
|
||||||
|
{subtract one day, add 24 hours}
|
||||||
|
Dec(Days);
|
||||||
|
Inc(tDT2.T, SecondsInDay);
|
||||||
|
end;
|
||||||
|
Secs := tDT2.T-tDT1.T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DateTimeToStDate(DT : TDateTime) : TStDate;
|
||||||
|
{-Convert Delphi TDateTime to TStDate}
|
||||||
|
var
|
||||||
|
Day, Month, Year : Word;
|
||||||
|
begin
|
||||||
|
DecodeDate(DT, Year, Month, Day);
|
||||||
|
Result := DMYToStDate(Day, Month, Year, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DateTimeToStTime(DT : TDateTime) : TStTime;
|
||||||
|
{-Convert Delphi TDateTime to TStTime}
|
||||||
|
var
|
||||||
|
Hour, Min, Sec, MSec : Word;
|
||||||
|
begin
|
||||||
|
DecodeTime(DT, Hour, Min, Sec, MSec);
|
||||||
|
Result := HMSToStTime(Hour, Min, Sec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StDateToDateTime(D : TStDate) : TDateTime;
|
||||||
|
{-Convert TStDate to TDateTime}
|
||||||
|
var
|
||||||
|
Day, Month, Year : Integer;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
if D <> BadDate then begin
|
||||||
|
StDateToDMY(D, Day, Month, Year);
|
||||||
|
Result := EncodeDate(Year, Month, Day);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StTimeToDateTime(T : TStTime) : TDateTime;
|
||||||
|
{-Convert TStTime to TDateTime}
|
||||||
|
var
|
||||||
|
Hour, Min, Sec : Byte;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
if T <> BadTime then begin
|
||||||
|
StTimeToHMS(T, Hour, Min, Sec);
|
||||||
|
Result := EncodeTime(Hour, Min, Sec, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; Days : Integer; Secs : LongInt);
|
||||||
|
{-Increment (or decrement) DT1 by the specified number of days and seconds
|
||||||
|
and put the result in DT2}
|
||||||
|
begin
|
||||||
|
DT2 := DT1;
|
||||||
|
|
||||||
|
{date first}
|
||||||
|
Inc(DT2.D, LongInt(Days));
|
||||||
|
|
||||||
|
if Secs < 0 then begin
|
||||||
|
{change the sign}
|
||||||
|
Secs := -Secs;
|
||||||
|
|
||||||
|
{adjust the date}
|
||||||
|
Dec(DT2.D, Secs div SecondsInDay);
|
||||||
|
Secs := Secs mod SecondsInDay;
|
||||||
|
|
||||||
|
if Secs > DT2.T then begin
|
||||||
|
{subtract a day from DT2.D and add a day's worth of seconds to DT2.T}
|
||||||
|
Dec(DT2.D);
|
||||||
|
Inc(DT2.T, SecondsInDay);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{now subtract the seconds}
|
||||||
|
Dec(DT2.T, Secs);
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
{increment the seconds}
|
||||||
|
Inc(DT2.T, Secs);
|
||||||
|
|
||||||
|
{adjust date if necessary}
|
||||||
|
Inc(DT2.D, DT2.T div SecondsInDay);
|
||||||
|
|
||||||
|
{force time to 0..SecondsInDay-1 range}
|
||||||
|
DT2.T := DT2.T mod SecondsInDay;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
|
||||||
|
begin
|
||||||
|
Result := LongInt(TwoByteDate) + Date1900;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function Convert4ByteDate(FourByteDate : TStDate) : Word;
|
||||||
|
begin
|
||||||
|
Result := Word(FourByteDate - Date1900);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SetDefaultYear;
|
||||||
|
{-Initialize DefaultYear and DefaultMonth}
|
||||||
|
var
|
||||||
|
Month, Day, Year : Word;
|
||||||
|
T : TDateTime;
|
||||||
|
begin
|
||||||
|
T := Now;
|
||||||
|
DecodeDate(T, Year, Month, Day);
|
||||||
|
DefaultYear := Year;
|
||||||
|
DefaultMonth := Month;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{initialize DefaultYear and DefaultMonth}
|
||||||
|
SetDefaultYear;
|
||||||
|
end.
|
||||||
272
components/orpheus/ovcdrag.pas
Normal file
272
components/orpheus/ovcdrag.pas
Normal file
@ -0,0 +1,272 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCDRAG.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcdrag;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
|
||||||
|
Classes, Graphics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcDragShow = class(TObject)
|
||||||
|
{.Z+}
|
||||||
|
protected
|
||||||
|
dStretchBltMode : Integer;
|
||||||
|
dMemDC,dSMemDC,
|
||||||
|
dDstDC,dSaveDC : hDC;
|
||||||
|
dSaveBmp, dMemBmp,
|
||||||
|
dSMemBmp : hBITMAP;
|
||||||
|
dcrText, dcrBack : TColorRef;
|
||||||
|
dRect : TRect;
|
||||||
|
dSize : TPoint;
|
||||||
|
dSystemPalette16 : hPalette;
|
||||||
|
dOldPal : hPalette;
|
||||||
|
Bitmap,dMask : TBitmap;
|
||||||
|
DeltaX, DeltaY : Integer;
|
||||||
|
dDragging,
|
||||||
|
dHaveOriginal : Boolean;
|
||||||
|
|
||||||
|
procedure ilDragDraw;
|
||||||
|
procedure ilRestoreOriginal;
|
||||||
|
procedure ilSaveOriginal;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
|
||||||
|
destructor Destroy;
|
||||||
|
override;
|
||||||
|
procedure DragMove(X, Y : Integer);
|
||||||
|
procedure HideDragImage;
|
||||||
|
procedure ShowDragImage;
|
||||||
|
{.Z+}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcDragShow ***}
|
||||||
|
|
||||||
|
constructor TOvcDragShow.Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
|
||||||
|
var
|
||||||
|
dMaskDC : HDC;
|
||||||
|
SrcDC : HDC;
|
||||||
|
begin
|
||||||
|
dHaveOriginal := False;
|
||||||
|
dDstDC := GetDC(0);
|
||||||
|
DeltaX := X - SourceRect.Left;
|
||||||
|
DeltaY := Y - SourceRect.Top;
|
||||||
|
dec(X, DeltaX);
|
||||||
|
dec(Y, DeltaY);
|
||||||
|
dRect.Left := X;
|
||||||
|
dRect.Top := Y;
|
||||||
|
Bitmap := nil;
|
||||||
|
dMask := nil;
|
||||||
|
try
|
||||||
|
Bitmap := TBitmap.Create;
|
||||||
|
Bitmap.Width := SourceRect.Right - SourceRect.Left + 1;
|
||||||
|
Bitmap.Height := SourceRect.Bottom - SourceRect.Top + 1;
|
||||||
|
|
||||||
|
dMask := TBitmap.Create;
|
||||||
|
dMask.Width := SourceRect.Right - SourceRect.Left + 1;
|
||||||
|
dMask.Height := SourceRect.Bottom - SourceRect.Top + 1;
|
||||||
|
|
||||||
|
BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, dDstDC, SourceRect.Left,
|
||||||
|
SourceRect.Top, SRCCOPY);
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
dMask.Canvas.BrushCopy(Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
|
||||||
|
Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
|
||||||
|
{$ELSE}
|
||||||
|
BrushCopy(dMask.Canvas, Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
|
||||||
|
Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
dMemDC := CreateCompatibleDC(0);
|
||||||
|
dSaveDC := CreateCompatibleDC(0);
|
||||||
|
dDragging := True;
|
||||||
|
dStretchBltMode := SetStretchBltMode(dDstDC, BLACKONWHITE);
|
||||||
|
dSize.X := Bitmap.Width;
|
||||||
|
dSize.Y := Bitmap.Height;
|
||||||
|
dRect.Right := dRect.Left + dSize.X - 1;
|
||||||
|
dRect.Bottom := dRect.Top + dSize.Y - 1;
|
||||||
|
SrcDC := Bitmap.Canvas.Handle;
|
||||||
|
dMaskDC := dMask.Canvas.Handle;
|
||||||
|
dSMemDC := CreateCompatibleDC(dMaskDC);
|
||||||
|
dMemBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
|
||||||
|
SelectObject(dMemDC, dMemBmp);
|
||||||
|
dSMemBmp := CreateCompatibleBitmap(dMaskDC, dSize.X, dSize.Y);
|
||||||
|
SelectObject(dSMemDC, dSMemBmp);
|
||||||
|
dSaveBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
|
||||||
|
SelectObject(dSaveDC, dSaveBmp);
|
||||||
|
dSystemPalette16 := GetStockObject(DEFAULT_PALETTE);
|
||||||
|
dOldPal := SelectPalette(SrcDC, dSystemPalette16, False);
|
||||||
|
SelectPalette(SrcDC, dOldPal, False);
|
||||||
|
if dOldPal <> 0 then begin
|
||||||
|
SelectPalette(dMemDC, dOldPal, True);
|
||||||
|
SelectPalette(dSaveDC, dOldPal, True);
|
||||||
|
end else begin
|
||||||
|
SelectPalette(dMemDC, dSystemPalette16, True);
|
||||||
|
SelectPalette(dSaveDC, dSystemPalette16, True);
|
||||||
|
end;
|
||||||
|
RealizePalette(dMemDC);
|
||||||
|
RealizePalette(dSaveDC);
|
||||||
|
|
||||||
|
BitBlt(dSMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
|
||||||
|
BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
|
||||||
|
BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, SrcDC, 0, 0, SrcErase);
|
||||||
|
dcrText := SetTextColor(dDstDC, $0);
|
||||||
|
dcrBack := SetBkColor(dDstDC, $FFFFFF);
|
||||||
|
ilSaveOriginal;
|
||||||
|
ilDragDraw;
|
||||||
|
except
|
||||||
|
Bitmap.Free;
|
||||||
|
dMask.Free;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcDragShow.Destroy;
|
||||||
|
begin
|
||||||
|
ilRestoreOriginal;
|
||||||
|
SetTextColor(dDstDC, dcrText);
|
||||||
|
SetBkColor(dDstDC, dcrBack);
|
||||||
|
DeleteObject(dMemBmp);
|
||||||
|
DeleteObject(dSaveBmp);
|
||||||
|
DeleteObject(dSMemBmp);
|
||||||
|
DeleteDC(dMemDC);
|
||||||
|
DeleteDC(dSMemDC);
|
||||||
|
DeleteDC(dSaveDC);
|
||||||
|
SetStretchBltMode(dDstDC, dStretchBltMode);
|
||||||
|
ReleaseDC(0,dDstDC);
|
||||||
|
dDragging := False;
|
||||||
|
Bitmap.Free;
|
||||||
|
dMask.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.DragMove(X, Y: Integer);
|
||||||
|
var
|
||||||
|
NewRect, Union : TRect;
|
||||||
|
UnionSize : TPoint;
|
||||||
|
WorkDC : hDC;
|
||||||
|
WorkBM : hBitmap;
|
||||||
|
begin
|
||||||
|
if not dDragging then exit;
|
||||||
|
dec(X, DeltaX);
|
||||||
|
dec(Y, DeltaY);
|
||||||
|
{if we didn't move, get out}
|
||||||
|
if (X = dRect.Left) and (Y = dRect.Top) then exit;
|
||||||
|
{let's see where we're going}
|
||||||
|
NewRect := Rect(X, Y, X + dSize.X - 1, Y + dSize.Y - 1);
|
||||||
|
{if drag image not currently shown, just update next draw position and exit}
|
||||||
|
if not dHaveOriginal then begin
|
||||||
|
dRect := NewRect;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{do the old and new positions overlap?}
|
||||||
|
if ord(IntersectRect(Union, dRect, NewRect)) <> 0 then begin
|
||||||
|
{rect old and new combined:}
|
||||||
|
UnionRect(Union, NewRect, dRect);
|
||||||
|
{size of union:}
|
||||||
|
UnionSize.X := Union.Right - Union.Left + 1;
|
||||||
|
UnionSize.Y := Union.Bottom - Union.Top + 1;
|
||||||
|
{create combination buffer}
|
||||||
|
WorkDC := CreateCompatibleDC(0);
|
||||||
|
WorkBM := CreateCompatibleBitmap(dDstDC, UnionSize.X, UnionSize.Y);
|
||||||
|
SelectObject(WorkDC, WorkBM);
|
||||||
|
if dOldPal <> 0 then
|
||||||
|
SelectPalette(WorkDC, dOldPal, True)
|
||||||
|
else
|
||||||
|
SelectPalette(WorkDC, dSystemPalette16, True);
|
||||||
|
RealizePalette(WorkDC);
|
||||||
|
{copy screen section (including old image) to local buffer}
|
||||||
|
BitBlt(WorkDC, 0, 0, UnionSize.X, UnionSize.Y, dDstDC, Union.Left, Union.Top, SRCCOPY);
|
||||||
|
{"repair" by restoring background for old image}
|
||||||
|
BitBlt(WorkDC, dRect.Left - Union.Left, dRect.Top - Union.Top,
|
||||||
|
dSize.X, dSize.Y, dSaveDC, 0, 0, SRCCOPY);
|
||||||
|
{save background so we can do the same next time}
|
||||||
|
BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, SrcCopy);
|
||||||
|
{write image at new position into local buffer}
|
||||||
|
BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
|
||||||
|
BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
|
||||||
|
{copy combined image to screen}
|
||||||
|
BitBlt(dDstDC, Union.Left, Union.Top, UnionSize.X, UnionSize.Y, WorkDC, 0, 0, SRCCOPY);
|
||||||
|
dRect := NewRect;
|
||||||
|
DeleteDC(WorkDC);
|
||||||
|
DeleteObject(WorkBM);
|
||||||
|
end else begin
|
||||||
|
{images dont overlap, so we might as well do the draw in two steps}
|
||||||
|
ilRestoreOriginal;
|
||||||
|
dRect := NewRect;
|
||||||
|
ilSaveOriginal;
|
||||||
|
ilDragDraw;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.HideDragImage;
|
||||||
|
begin
|
||||||
|
ilRestoreOriginal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.ilDragDraw;
|
||||||
|
begin
|
||||||
|
BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
|
||||||
|
BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.ilRestoreOriginal;
|
||||||
|
begin
|
||||||
|
if not dHaveOriginal then exit;
|
||||||
|
BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSaveDC, 0, 0, SrcCopy);
|
||||||
|
dHaveOriginal := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.ilSaveOriginal;
|
||||||
|
begin
|
||||||
|
BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, dDstDC, dRect.Left, dRect.Top, SrcCopy);
|
||||||
|
dHaveOriginal := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcDragShow.ShowDragImage;
|
||||||
|
begin
|
||||||
|
ilSaveOriginal;
|
||||||
|
ilDragDraw;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
1124
components/orpheus/ovcedcal.pas
Normal file
1124
components/orpheus/ovcedcal.pas
Normal file
File diff suppressed because it is too large
Load Diff
599
components/orpheus/ovcedclc.pas
Normal file
599
components/orpheus/ovcedclc.pas
Normal file
@ -0,0 +1,599 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCEDCLC.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcedclc;
|
||||||
|
{-numeric edit field with popup calculator}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, {$IFDEF VERSION4}{$IFNDEF LCL} MultiMon, {$ENDIF}{$ENDIF}
|
||||||
|
OvcBase, OvcCalc, OvcEdPop, OvcMisc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomNumberEdit = class(TOvcEdPopup)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
FAllowIncDec : Boolean;
|
||||||
|
FCalculator : TOvcCalculator;
|
||||||
|
|
||||||
|
{internal variables}
|
||||||
|
PopupClosing : Boolean;
|
||||||
|
HoldCursor : TCursor;
|
||||||
|
WasAutoScroll : Boolean;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetAsFloat : Double;
|
||||||
|
function GetAsInteger : LongInt;
|
||||||
|
function GetAsString : string;
|
||||||
|
function GetPopupColors : TOvcCalcColors;
|
||||||
|
function GetPopupDecimals : Integer;
|
||||||
|
function GetPopupFont : TFont;
|
||||||
|
function GetPopupHeight : Integer;
|
||||||
|
function GetPopupWidth : Integer;
|
||||||
|
function GetReadOnly : Boolean;
|
||||||
|
procedure SetAsFloat(Value : Double);
|
||||||
|
procedure SetAsInteger(Value : LongInt);
|
||||||
|
procedure SetAsString(const Value : string);
|
||||||
|
procedure SetPopupColors(Value : TOvcCalcColors);
|
||||||
|
procedure SetPopupDecimals(Value : Integer);
|
||||||
|
procedure SetPopupFont(Value : TFont);
|
||||||
|
procedure SetPopupHeight(Value : Integer);
|
||||||
|
procedure SetPopupWidth(Value : Integer);
|
||||||
|
procedure SetReadOnly(Value : Boolean);
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure PopupButtonPressed(Sender : TObject; Button : TOvcCalculatorButton);
|
||||||
|
procedure PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
|
||||||
|
procedure PopupKeyPress(Sender : TObject; var Key : Char);
|
||||||
|
procedure PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure DoExit;
|
||||||
|
override;
|
||||||
|
procedure GlyphChanged;
|
||||||
|
override;
|
||||||
|
procedure KeyDown(var Key : Word; Shift : TShiftState);
|
||||||
|
override;
|
||||||
|
procedure KeyPress(var Key : Char);
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
property AllowIncDec : Boolean
|
||||||
|
read FAllowIncDec write FAllowIncDec;
|
||||||
|
property PopupColors : TOvcCalcColors
|
||||||
|
read GetPopupColors write SetPopupColors;
|
||||||
|
property PopupDecimals : Integer
|
||||||
|
read GetPopupDecimals write SetPopupDecimals;
|
||||||
|
property PopupFont : TFont
|
||||||
|
read GetPopupFont write SetPopupFont;
|
||||||
|
property PopupHeight : Integer
|
||||||
|
read GetPopupHeight write SetPopupHeight;
|
||||||
|
property PopupWidth : Integer
|
||||||
|
read GetPopupWidth write SetPopupWidth;
|
||||||
|
property ReadOnly : Boolean
|
||||||
|
read GetReadOnly write SetReadOnly;
|
||||||
|
|
||||||
|
public
|
||||||
|
{.Z+}
|
||||||
|
constructor Create(AOwner : TComponent);
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
procedure PopupClose(Sender : TObject);
|
||||||
|
override;
|
||||||
|
procedure PopupOpen;
|
||||||
|
override;
|
||||||
|
|
||||||
|
property AsInteger : LongInt
|
||||||
|
read GetAsInteger
|
||||||
|
write SetAsInteger;
|
||||||
|
|
||||||
|
{public properties}
|
||||||
|
property Calculator : TOvcCalculator
|
||||||
|
read FCalculator;
|
||||||
|
property AsFloat : Double
|
||||||
|
read GetAsFloat write SetAsFloat;
|
||||||
|
property AsString : string
|
||||||
|
read GetAsString write SetAsString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcNumberEdit = class(TOvcCustomNumberEdit)
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property About;
|
||||||
|
property AllowIncDec;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property AutoSelect;
|
||||||
|
{$ENDIF}
|
||||||
|
property AutoSize;
|
||||||
|
property BorderStyle;
|
||||||
|
property ButtonGlyph;
|
||||||
|
property Color;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property HideSelection;
|
||||||
|
{$ENDIF}
|
||||||
|
property LabelInfo;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupAnchor;
|
||||||
|
property PopupColors;
|
||||||
|
property PopupDecimals;
|
||||||
|
property PopupFont;
|
||||||
|
property PopupHeight;
|
||||||
|
property PopupWidth;
|
||||||
|
property PopupMenu;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property ShowButton;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
{events}
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnPopupClose;
|
||||||
|
property OnPopupOpen;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcCustomNumberEdit ***}
|
||||||
|
|
||||||
|
constructor TOvcCustomNumberEdit.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
FAllowIncDec := False;
|
||||||
|
|
||||||
|
{load button glyph}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
|
||||||
|
{$ELSE}
|
||||||
|
FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
|
||||||
|
{$ENDIF}
|
||||||
|
FButton.Glyph.Assign(FButtonGlyph);
|
||||||
|
|
||||||
|
FCalculator := TOvcCalculator.CreateEx(Self, True);
|
||||||
|
FCalculator.OnButtonPressed := PopupButtonPressed;
|
||||||
|
FCalculator.OnExit := PopupClose;
|
||||||
|
FCalculator.OnKeyDown := PopupKeyDown;
|
||||||
|
FCalculator.OnKeyPress := PopupKeyPress;
|
||||||
|
FCalculator.OnMouseDown := PopupMouseDown;
|
||||||
|
FCalculator.Visible := False; {to avoid flash at 0,0}
|
||||||
|
FCalculator.Options := [coShowItemCount];
|
||||||
|
FCalculator.BorderStyle := bsSingle;
|
||||||
|
FCalculator.ParentFont := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.DoExit;
|
||||||
|
begin
|
||||||
|
if not PopupActive then
|
||||||
|
inherited DoExit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetAsFloat : Double;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
S : string;
|
||||||
|
begin
|
||||||
|
S := Text;
|
||||||
|
for I := Length(S) downto 1 do
|
||||||
|
if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then
|
||||||
|
Delete(S, I, 1);
|
||||||
|
Result := StrToFloat(S);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetAsInteger : LongInt;
|
||||||
|
begin
|
||||||
|
Result := Round(GetAsFloat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetAsString : string;
|
||||||
|
begin
|
||||||
|
Result := Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetPopupColors : TOvcCalcColors;
|
||||||
|
begin
|
||||||
|
Result := FCalculator.Colors;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetPopupDecimals : Integer;
|
||||||
|
begin
|
||||||
|
Result := FCalculator.Decimals;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetPopupFont : TFont;
|
||||||
|
begin
|
||||||
|
Result := FCalculator.Font;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetPopupHeight : Integer;
|
||||||
|
begin
|
||||||
|
Result := FCalculator.Height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetPopupWidth : Integer;
|
||||||
|
begin
|
||||||
|
Result := FCalculator.Width;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomNumberEdit.GetReadOnly : Boolean;
|
||||||
|
begin
|
||||||
|
Result := inherited ReadOnly;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.GlyphChanged;
|
||||||
|
begin
|
||||||
|
inherited GlyphChanged;
|
||||||
|
|
||||||
|
if FButtonGlyph.Empty then
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
|
||||||
|
{$ELSE}
|
||||||
|
FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.KeyDown(var Key : Word; Shift : TShiftState);
|
||||||
|
begin
|
||||||
|
inherited KeyDown(Key, Shift);
|
||||||
|
|
||||||
|
if (Key = VK_DOWN) and (ssAlt in Shift) then
|
||||||
|
PopupOpen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.KeyPress(var Key : Char);
|
||||||
|
var
|
||||||
|
D : Double;
|
||||||
|
X : Integer;
|
||||||
|
L : Integer;
|
||||||
|
begin
|
||||||
|
inherited KeyPress(Key);
|
||||||
|
|
||||||
|
if not ((Key = #22) or (Key = #3) or (Key = #24)) then begin
|
||||||
|
if not (Key in [#27, '0'..'9', '.', DecimalSeparator,
|
||||||
|
#8, '+', '-', '*', '/']) then begin
|
||||||
|
Key := #0;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
MessageBeep(0);
|
||||||
|
{$ENDIF}
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Disallow more than one DecimalSeparator in the number}
|
||||||
|
if (SelLength <> Length(Text))
|
||||||
|
and (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) > 0)
|
||||||
|
then begin
|
||||||
|
Key := #0;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
MessageBeep(0);
|
||||||
|
{$ENDIF}
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FAllowIncDec and (Key in ['+', '-']) then begin
|
||||||
|
if Text = '' then
|
||||||
|
Text := '0';
|
||||||
|
D := StrToFloat(Text);
|
||||||
|
X := SelStart;
|
||||||
|
L := SelLength;
|
||||||
|
|
||||||
|
if Key = '+' then
|
||||||
|
Text := FloatToStr(D+1)
|
||||||
|
else {'-'}
|
||||||
|
Text := FloatToStr(D-1);
|
||||||
|
|
||||||
|
SelStart := X;
|
||||||
|
SelLength := L;
|
||||||
|
|
||||||
|
Key := #0; {clear key}
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Key in ['+', '*', '/']) then begin
|
||||||
|
PopUpOpen;
|
||||||
|
FCalculator.KeyPress(Key);
|
||||||
|
Key := #0; {clear key}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupButtonPressed(Sender : TObject;
|
||||||
|
Button : TOvcCalculatorButton);
|
||||||
|
begin
|
||||||
|
case Button of
|
||||||
|
cbEqual :
|
||||||
|
begin
|
||||||
|
{get the current value}
|
||||||
|
Text := FloatToStr(FCalculator.DisplayValue);
|
||||||
|
Modified := True;
|
||||||
|
|
||||||
|
{hide the calculator}
|
||||||
|
PopupClose(Sender);
|
||||||
|
SetFocus;
|
||||||
|
SelStart := Length(Text);
|
||||||
|
SelLength := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupClose(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if not FCalculator.Visible then
|
||||||
|
Exit; {already closed, exit}
|
||||||
|
|
||||||
|
if PopupClosing then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
PopupClosing := True; {avoid recursion}
|
||||||
|
try
|
||||||
|
inherited PopupClose(Sender);
|
||||||
|
|
||||||
|
if GetCapture = FCalculator.Handle then
|
||||||
|
ReleaseCapture;
|
||||||
|
|
||||||
|
SetFocus;
|
||||||
|
FCalculator.Hide; {hide the calculator}
|
||||||
|
TForm(FCalculator.Parent).AutoScroll := WasAutoScroll;
|
||||||
|
Cursor := HoldCursor;
|
||||||
|
|
||||||
|
{change parentage so that we control the window handle destruction}
|
||||||
|
FCalculator.Parent := Self;
|
||||||
|
finally
|
||||||
|
PopupClosing := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
|
||||||
|
var
|
||||||
|
X : Integer;
|
||||||
|
begin
|
||||||
|
case Key of
|
||||||
|
|
||||||
|
VK_TAB :
|
||||||
|
begin
|
||||||
|
if Shift = [ssShift] then begin
|
||||||
|
PopupClose(Sender);
|
||||||
|
PostMessage(Handle, WM_KeyDown, VK_TAB, Integer(ssShift));
|
||||||
|
end else if Shift = [] then begin
|
||||||
|
PopupClose(Sender);
|
||||||
|
PostMessage(Handle, WM_KeyDown, VK_TAB, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
VK_UP : if Shift = [ssAlt] then begin
|
||||||
|
PopupClose(Sender);
|
||||||
|
X := SelStart;
|
||||||
|
SetFocus;
|
||||||
|
SelStart := X;
|
||||||
|
SelLength := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupKeyPress(Sender : TObject; var Key : Char);
|
||||||
|
var
|
||||||
|
X : Integer;
|
||||||
|
begin
|
||||||
|
case Key of
|
||||||
|
#27 :
|
||||||
|
begin
|
||||||
|
PopupClose(Sender);
|
||||||
|
X := SelStart;
|
||||||
|
SetFocus;
|
||||||
|
SelStart := X;
|
||||||
|
SelLength := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||||
|
var
|
||||||
|
P : TPoint;
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
P := Point(X,Y);
|
||||||
|
if not PtInRect(FCalculator.ClientRect, P) then
|
||||||
|
PopUpClose(Sender);
|
||||||
|
|
||||||
|
{convert to our coordinate system}
|
||||||
|
P := ScreenToClient(FCalculator.ClientToScreen(P));
|
||||||
|
|
||||||
|
if PtInRect(ClientRect, P) then begin
|
||||||
|
I := SelStart;
|
||||||
|
SetFocus;
|
||||||
|
SelStart := I;
|
||||||
|
SelLength := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.PopupOpen;
|
||||||
|
var
|
||||||
|
P : TPoint;
|
||||||
|
R : TRect;
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
F : TCustomForm;
|
||||||
|
MonInfo : TMonitorInfo;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
if FCalculator.Visible then
|
||||||
|
Exit; {already popped up, exit}
|
||||||
|
|
||||||
|
inherited PopupOpen;
|
||||||
|
|
||||||
|
FCalculator.Parent := GetImmediateParentForm(Self);
|
||||||
|
if FCalculator.Parent is TForm then begin
|
||||||
|
WasAutoScroll := TForm(FCalculator.Parent).AutoScroll;
|
||||||
|
TForm(FCalculator.Parent).AutoScroll := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{set 3d to be the same as our own}
|
||||||
|
FCalculator.ParentCtl3D := False;
|
||||||
|
FCalculator.Ctl3D := False;
|
||||||
|
|
||||||
|
{determine the proper position}
|
||||||
|
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
F := GetParentForm(Self);
|
||||||
|
if Assigned(F) then begin
|
||||||
|
FillChar(MonInfo, SizeOf(MonInfo), #0);
|
||||||
|
MonInfo.cbSize := SizeOf(MonInfo);
|
||||||
|
GetMonitorInfo(F.Monitor.Handle, @MonInfo);
|
||||||
|
R := MonInfo.rcWork;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
if FPopupAnchor = paLeft then
|
||||||
|
P := ClientToScreen(Point(-3, Height-4))
|
||||||
|
else {paRight}
|
||||||
|
P := ClientToScreen(Point(Width-FCalculator.Width-1, Height-2));
|
||||||
|
if not Ctl3D then begin
|
||||||
|
Inc(P.X, 3);
|
||||||
|
Inc(P.Y, 3);
|
||||||
|
end;
|
||||||
|
if P.Y + FCalculator.Height >= R.Bottom then
|
||||||
|
P.Y := P.Y - FCalculator.Height - Height;
|
||||||
|
if P.X + FCalculator.Width >= R.Right then
|
||||||
|
P.X := R.Right - FCalculator.Width - 1;
|
||||||
|
if P.X <= R.Left then
|
||||||
|
P.X := R.Left + 1;
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
MoveWindow(FCalculator.Handle, P.X, P.Y, FCalculator.Width, FCalculator.Height, False);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
HoldCursor := Cursor;
|
||||||
|
Cursor := crArrow;
|
||||||
|
FCalculator.PressButton(cbClear);
|
||||||
|
FCalculator.Show;
|
||||||
|
FCalculator.Visible := True;
|
||||||
|
if Text <> '' then
|
||||||
|
FCalculator.PushOperand(AsFloat)
|
||||||
|
else
|
||||||
|
FCalculator.PushOperand(0);
|
||||||
|
FCalculator.SetFocus;
|
||||||
|
|
||||||
|
SetCapture(FCalculator.Handle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetAsFloat(Value : Double);
|
||||||
|
begin
|
||||||
|
Text := FloatToStr(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetAsInteger(Value : LongInt);
|
||||||
|
begin
|
||||||
|
Text := IntToStr(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetAsString(const Value : string);
|
||||||
|
begin
|
||||||
|
Text := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetPopupColors(Value : TOvcCalcColors);
|
||||||
|
begin
|
||||||
|
FCalculator.Colors := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetPopupDecimals(Value : Integer);
|
||||||
|
begin
|
||||||
|
FCalculator.Decimals := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetPopupFont(Value : TFont);
|
||||||
|
begin
|
||||||
|
if Assigned(Value) then
|
||||||
|
FCalculator.Font.Assign(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetPopupHeight(Value : Integer);
|
||||||
|
begin
|
||||||
|
FCalculator.Height := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetPopupWidth(Value : Integer);
|
||||||
|
begin
|
||||||
|
FCalculator.Width := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomNumberEdit.SetReadOnly(Value : Boolean);
|
||||||
|
begin
|
||||||
|
inherited ReadOnly := Value;
|
||||||
|
|
||||||
|
FButton.Enabled := not ReadOnly;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
418
components/orpheus/ovceditf.pas
Normal file
418
components/orpheus/ovceditf.pas
Normal file
@ -0,0 +1,418 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCEDITF.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
{$J+} {Writable constants}
|
||||||
|
|
||||||
|
unit ovceditf;
|
||||||
|
{-old style base edit field class w/ attached label}
|
||||||
|
{to be deprecated in a future release}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, OvcBase, OvcConst, OvcData, OvcExcpt, OvcVer, OvcMisc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomEdit = class(TCustomEdit)
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FController : TOvcController;
|
||||||
|
FLabelInfo : TOvcLabelInfo;
|
||||||
|
{property methods}
|
||||||
|
function GetAbout : string;
|
||||||
|
function GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
procedure SetAbout(const Value : string);
|
||||||
|
procedure SetController(Value : TOvcController);
|
||||||
|
{internal methods}
|
||||||
|
procedure LabelChange(Sender : TObject);
|
||||||
|
procedure LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
procedure PositionLabel;
|
||||||
|
{VCL message methods}
|
||||||
|
procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
|
||||||
|
procedure OrAssignLabel(var Msg : TMessage); message OM_ASSIGNLABEL;
|
||||||
|
procedure OrPositionLabel(var Msg : TMessage); message OM_POSITIONLABEL;
|
||||||
|
procedure OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
message OM_RECORDLABELPOSITION;
|
||||||
|
protected
|
||||||
|
{descendants can set the value of this variable after calling inherited }
|
||||||
|
{create to set the default location and point-of-reference (POR) for the}
|
||||||
|
{attached label. if dlpTopLeft, the default location and POR will be at }
|
||||||
|
{the top left of the control. if dlpBottomLeft, the default location and}
|
||||||
|
{POR will be at the bottom left}
|
||||||
|
DefaultLabelPosition : TOvcLabelPosition;
|
||||||
|
procedure CreateWnd; override;
|
||||||
|
procedure Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
override;
|
||||||
|
function ControllerAssigned : Boolean;
|
||||||
|
property About : string read GetAbout write SetAbout stored False;
|
||||||
|
property LabelInfo : TOvcLabelInfo read FLabelInfo write FLabelInfo;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||||
|
property AttachedLabel : TOvcAttachedLabel read GetAttachedLabel;
|
||||||
|
property Controller : TOvcController read FController write SetController;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcEdit = class(TOvcCustomEdit)
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property BiDiMode;
|
||||||
|
property ParentBiDiMode;
|
||||||
|
{$ENDIF}
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property About;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property AutoSelect;
|
||||||
|
{$ENDIF}
|
||||||
|
property AutoSize;
|
||||||
|
property BorderStyle;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Controller;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property HideSelection;
|
||||||
|
property ImeMode;
|
||||||
|
property ImeName;
|
||||||
|
{$ENDIF}
|
||||||
|
property LabelInfo;
|
||||||
|
property MaxLength;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property OEMConvert;
|
||||||
|
{$ENDIF}
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PasswordChar;
|
||||||
|
property PopupMenu;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property Text;
|
||||||
|
property Visible;
|
||||||
|
{events}
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property OnEndDock;
|
||||||
|
property OnStartDock;
|
||||||
|
{$ENDIF}
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{===== TOvcCustomEdit ================================================}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.CMVisibleChanged(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if LabelInfo.Visible then
|
||||||
|
AttachedLabel.Visible := Visible;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TOvcCustomEdit.ControllerAssigned : Boolean;
|
||||||
|
begin
|
||||||
|
Result := Assigned(FController);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
constructor TOvcCustomEdit.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
{set default position and reference point}
|
||||||
|
DefaultLabelPosition := lpTopLeft;
|
||||||
|
|
||||||
|
FLabelInfo := TOvcLabelInfo.Create;
|
||||||
|
FLabelInfo.OnChange := LabelChange;
|
||||||
|
FLabelInfo.OnAttach := LabelAttach;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.CreateWnd;
|
||||||
|
var
|
||||||
|
OurForm : TWinControl;
|
||||||
|
begin
|
||||||
|
OurForm := GetImmediateParentForm(Self);
|
||||||
|
|
||||||
|
{do this only when the component is first dropped on the form, not during loading}
|
||||||
|
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
|
||||||
|
ResolveController(OurForm, FController);
|
||||||
|
|
||||||
|
if not Assigned(FController) and not (csLoading in ComponentState) then begin
|
||||||
|
{try to find a controller on this form that we can use}
|
||||||
|
FController := FindController(OurForm);
|
||||||
|
|
||||||
|
{if not found and we are not designing, use default controller}
|
||||||
|
if not Assigned(FController) and not (csDesigning in ComponentState) then
|
||||||
|
FController := DefaultController;
|
||||||
|
end;
|
||||||
|
|
||||||
|
inherited CreateWnd;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TOvcCustomEdit.Destroy;
|
||||||
|
begin
|
||||||
|
{detatch and destroy label, if any}
|
||||||
|
FLabelInfo.Visible := False;
|
||||||
|
|
||||||
|
{destroy label info}
|
||||||
|
FLabelInfo.Free;
|
||||||
|
FLabelInfo := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TOvcCustomEdit.GetAttachedLabel : TOvcAttachedLabel;
|
||||||
|
begin
|
||||||
|
if not FLabelInfo.Visible then
|
||||||
|
raise Exception.Create(GetOrphStr(SCLabelNotAttached));
|
||||||
|
|
||||||
|
Result := FLabelInfo.ALabel;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function TOvcCustomEdit.GetAbout : string;
|
||||||
|
begin
|
||||||
|
Result := OrVersionStr;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.LabelAttach(Sender : TObject; Value : Boolean);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
S :string;
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Value then begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
|
||||||
|
FLabelInfo.ALabel.Parent := Parent;
|
||||||
|
|
||||||
|
S := GenerateComponentName(PF, Name + 'Label');
|
||||||
|
FLabelInfo.ALabel.Name := S;
|
||||||
|
FLabelInfo.ALabel.Caption := S;
|
||||||
|
|
||||||
|
FLabelInfo.SetOffsets(0, 0);
|
||||||
|
PositionLabel;
|
||||||
|
FLabelInfo.ALabel.BringToFront;
|
||||||
|
{turn off auto size}
|
||||||
|
TLabel(FLabelInfo.ALabel).AutoSize := False;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if Assigned(PF) then begin
|
||||||
|
FLabelInfo.ALabel.Free;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.LabelChange(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.Notification(AComponent : TComponent; Operation: TOperation);
|
||||||
|
var
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF : TWinControl;
|
||||||
|
{$ELSE}
|
||||||
|
PF : TForm;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
|
||||||
|
if Operation = opRemove then
|
||||||
|
if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
|
||||||
|
{$IFDEF VERSION5}
|
||||||
|
PF := GetImmediateParentForm(Self);
|
||||||
|
{$ELSE}
|
||||||
|
PF := TForm(GetParentForm(Self));
|
||||||
|
{$ENDIF}
|
||||||
|
if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
|
||||||
|
FLabelInfo.FVisible := False;
|
||||||
|
FLabelInfo.ALabel := nil;
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (AComponent = FController) and (Operation = opRemove) then
|
||||||
|
FController := nil
|
||||||
|
else if (Operation = opInsert) and (FController = nil) then begin
|
||||||
|
if (AComponent is TOvcController) then
|
||||||
|
FController := TOvcController(AComponent);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.OrAssignLabel(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.OrPositionLabel(var Msg : TMessage);
|
||||||
|
const
|
||||||
|
DX : Integer = 0;
|
||||||
|
DY : Integer = 0;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
|
||||||
|
end else begin
|
||||||
|
DX := FLabelInfo.ALabel.Left - Left;
|
||||||
|
DY := FLabelInfo.ALabel.Top - Top - Height;
|
||||||
|
end;
|
||||||
|
if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
|
||||||
|
PositionLabel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.OrRecordLabelPosition(var Msg : TMessage);
|
||||||
|
begin
|
||||||
|
if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
|
||||||
|
{if the label was cut and then pasted, this will complete the reattachment}
|
||||||
|
FLabelInfo.FVisible := True;
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
|
||||||
|
else
|
||||||
|
FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
|
||||||
|
FLabelInfo.ALabel.Top - Top - Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.PositionLabel;
|
||||||
|
begin
|
||||||
|
if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
|
||||||
|
(FLabelInfo.ALabel.Parent <> nil) and
|
||||||
|
not (csLoading in ComponentState) then begin
|
||||||
|
|
||||||
|
if DefaultLabelPosition = lpTopLeft then begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end else begin
|
||||||
|
FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
|
||||||
|
FLabelInfo.OffsetY + Top + Height,
|
||||||
|
FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
begin
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
|
||||||
|
if not HandleAllocated then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if HandleAllocated then
|
||||||
|
PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.SetController(Value : TOvcController);
|
||||||
|
begin
|
||||||
|
FController := Value;
|
||||||
|
if Value <> nil then
|
||||||
|
Value.FreeNotification(Self);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcCustomEdit.SetAbout(const Value : string);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
341
components/orpheus/ovcedpop.pas
Normal file
341
components/orpheus/ovcedpop.pas
Normal file
@ -0,0 +1,341 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCEDPOP.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
{$J+} {Writable constants}
|
||||||
|
|
||||||
|
unit ovcedpop;
|
||||||
|
{-base popup edit field class}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, OvcEditF;
|
||||||
|
|
||||||
|
const
|
||||||
|
MsgClose = WM_USER+100;
|
||||||
|
MsgOpen = WM_USER+101;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcEdButton = class(TBitBtn)
|
||||||
|
public
|
||||||
|
procedure Click;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcPopupEvent =
|
||||||
|
procedure(Sender : TObject) of object;
|
||||||
|
|
||||||
|
TOvcPopupAnchor = (paLeft, paRight);
|
||||||
|
|
||||||
|
TOvcEdPopup = class(TOvcCustomEdit)
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FButton : TOvcEdButton;
|
||||||
|
FButtonGlyph : TBitmap;
|
||||||
|
FPopupActive : Boolean;
|
||||||
|
FPopupAnchor : TOvcPopupAnchor;
|
||||||
|
FOnPopupClose : TOvcPopupEvent;
|
||||||
|
FOnPopupOpen : TOvcPopupEvent;
|
||||||
|
FShowButton : Boolean;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetButtonGlyph : TBitmap;
|
||||||
|
procedure SetButtonGlyph(Value : TBitmap);
|
||||||
|
procedure SetShowButton(Value : Boolean);
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
function GetButtonWidth : Integer;
|
||||||
|
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
procedure CMDialogKey(var Msg : TCMDialogKey);
|
||||||
|
message CM_DIALOGKEY;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure CreateParams(var Params : TCreateParams);
|
||||||
|
override;
|
||||||
|
procedure CreateWnd;
|
||||||
|
override;
|
||||||
|
function GetButtonEnabled : Boolean;
|
||||||
|
dynamic;
|
||||||
|
procedure GlyphChanged;
|
||||||
|
dynamic;
|
||||||
|
procedure Loaded;
|
||||||
|
override;
|
||||||
|
|
||||||
|
procedure OnMsgClose(var M : TMessage);
|
||||||
|
message MsgClose;
|
||||||
|
procedure OnMsgOpen(var M : TMessage);
|
||||||
|
message MsgOpen;
|
||||||
|
|
||||||
|
property PopupAnchor : TOvcPopupAnchor
|
||||||
|
read FPopupAnchor write FPopupAnchor;
|
||||||
|
property ShowButton : Boolean
|
||||||
|
read FShowButton write SetShowButton;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(AOwner : TComponent);
|
||||||
|
override;
|
||||||
|
destructor Destroy;
|
||||||
|
override;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
||||||
|
override;
|
||||||
|
|
||||||
|
property ButtonGlyph : TBitmap
|
||||||
|
read GetButtonGlyph
|
||||||
|
write SetButtonGlyph;
|
||||||
|
|
||||||
|
procedure PopupClose(Sender : TObject);
|
||||||
|
dynamic;
|
||||||
|
procedure PopupOpen;
|
||||||
|
dynamic;
|
||||||
|
|
||||||
|
property OnPopupClose : TOvcPopupEvent
|
||||||
|
read FOnPopupClose
|
||||||
|
write FOnPopupClose;
|
||||||
|
|
||||||
|
property OnPopupOpen : TOvcPopupEvent
|
||||||
|
read FOnPopupOpen
|
||||||
|
write FOnPopupOpen;
|
||||||
|
|
||||||
|
property PopupActive : Boolean
|
||||||
|
read FPopupActive;
|
||||||
|
|
||||||
|
property Controller;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{*** TOvcEdButton ***}
|
||||||
|
|
||||||
|
procedure TOvcEdButton.Click;
|
||||||
|
begin
|
||||||
|
TOvcEdPopup(Parent).PopupOpen;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcEdPopup ***}
|
||||||
|
|
||||||
|
constructor TOvcEdPopup.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
FShowButton := True;
|
||||||
|
FButton := TOvcEdButton.Create(Self);
|
||||||
|
FButton.Visible := True;
|
||||||
|
FButton.Parent := Self;
|
||||||
|
FButton.Caption := '';
|
||||||
|
FButton.TabStop := False;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
FButton.Style := bsNew;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
FButtonGlyph := TBitmap.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.CreateParams(var Params : TCreateParams);
|
||||||
|
begin
|
||||||
|
inherited CreateParams(Params);
|
||||||
|
|
||||||
|
Params.Style := Params.Style or WS_CLIPCHILDREN;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited CreateWnd;
|
||||||
|
|
||||||
|
{force button placement}
|
||||||
|
SetBounds(Left, Top, Width, Height);
|
||||||
|
|
||||||
|
FButton.Enabled := GetButtonEnabled;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TOvcEdPopup.Destroy;
|
||||||
|
begin
|
||||||
|
{destroy button}
|
||||||
|
FButton.Free;
|
||||||
|
FButton := nil;
|
||||||
|
|
||||||
|
{destroy button glyph}
|
||||||
|
FButtonGlyph.Free;
|
||||||
|
FButtonGlyph := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcEdPopup.GetButtonEnabled : Boolean;
|
||||||
|
begin
|
||||||
|
Result := not ReadOnly;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcEdPopup.GetButtonWidth : Integer;
|
||||||
|
begin
|
||||||
|
if FShowButton then begin
|
||||||
|
Result := GetSystemMetrics(SM_CXHSCROLL);
|
||||||
|
if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
|
||||||
|
if FButtonGlyph.Width + 4 > Result then
|
||||||
|
Result := FButtonGlyph.Width + 4;
|
||||||
|
end else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcEdPopup.GetButtonGlyph : TBitmap;
|
||||||
|
begin
|
||||||
|
if not Assigned(FButtonGlyph) then
|
||||||
|
FButtonGlyph := TBitmap.Create;
|
||||||
|
|
||||||
|
Result := FButtonGlyph
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.GlyphChanged;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.Loaded;
|
||||||
|
begin
|
||||||
|
inherited Loaded;
|
||||||
|
|
||||||
|
if Assigned(FButtonGlyph) then
|
||||||
|
FButton.Glyph.Assign(FButtonGlyph);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.OnMsgClose(var M : TMessage);
|
||||||
|
begin
|
||||||
|
if (Assigned(FOnPopupClose)) then
|
||||||
|
FOnPopupClose(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.OnMsgOpen(var M : TMessage);
|
||||||
|
begin
|
||||||
|
if (Assigned(FOnPopupOpen)) then
|
||||||
|
FOnPopupOpen(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.PopupClose;
|
||||||
|
begin
|
||||||
|
FPopupActive := False;
|
||||||
|
PostMessage(Handle, MsgClose, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.PopupOpen;
|
||||||
|
begin
|
||||||
|
FPopupActive := True;
|
||||||
|
PostMessage(Handle, MsgOpen, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
|
||||||
|
var
|
||||||
|
H : Integer;
|
||||||
|
begin
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
|
||||||
|
if not HandleAllocated then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if not FShowButton then begin
|
||||||
|
FButton.Height := 0;
|
||||||
|
FButton.Width := 0;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
H := ClientHeight;
|
||||||
|
if BorderStyle = bsNone then begin
|
||||||
|
FButton.Height := H;
|
||||||
|
FButton.Width := GetButtonWidth;
|
||||||
|
FButton.Left := Width - FButton.Width;
|
||||||
|
FButton.Top := 0;
|
||||||
|
end else if Ctl3D then begin
|
||||||
|
FButton.Height := H;
|
||||||
|
FButton.Width := GetButtonWidth;
|
||||||
|
FButton.Left := Width - FButton.Width - 4;
|
||||||
|
FButton.Top := 0;
|
||||||
|
end else begin
|
||||||
|
FButton.Height := H - 2;
|
||||||
|
FButton.Width := GetButtonWidth;
|
||||||
|
FButton.Left := Width - FButton.Width - 1;
|
||||||
|
FButton.Top := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.SetButtonGlyph(Value : TBitmap);
|
||||||
|
begin
|
||||||
|
if not Assigned(FButtonGlyph) then
|
||||||
|
FButtonGlyph := TBitmap.Create;
|
||||||
|
|
||||||
|
if not Assigned(Value) then begin
|
||||||
|
FButtonGlyph.Free;
|
||||||
|
FButtonGlyph := TBitmap.Create;
|
||||||
|
end else
|
||||||
|
FButtonGlyph.Assign(Value);
|
||||||
|
|
||||||
|
GlyphChanged;
|
||||||
|
|
||||||
|
FButton.Glyph.Assign(FButtonGlyph);
|
||||||
|
SetBounds(Left, Top, Width, Height);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcEdPopup.SetShowButton(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShowButton then begin
|
||||||
|
FShowButton := Value;
|
||||||
|
{force resize and redisplay of button}
|
||||||
|
SetBounds(Left, Top, Width, Height);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
procedure TOvcEdPopup.CMDialogKey(var Msg : TCMDialogKey);
|
||||||
|
begin
|
||||||
|
if PopupActive then begin
|
||||||
|
with Msg do begin
|
||||||
|
if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
|
||||||
|
PopupClose(Self);
|
||||||
|
Result := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
706
components/orpheus/ovcedtim.pas
Normal file
706
components/orpheus/ovcedtim.pas
Normal file
@ -0,0 +1,706 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCEDTIM.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcedtim;
|
||||||
|
{-time edit field}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Buttons, Classes, Controls, Forms, Graphics, Menus,
|
||||||
|
StdCtrls, SysUtils, OvcConst, OvcData, OvcExcpt, OvcIntl, OvcMisc,
|
||||||
|
OvcEditF, OvcDate;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcTimeField = (tfHours, tfMinutes, tfSeconds);
|
||||||
|
TOvcTimeMode = (tmClock, tmDuration);
|
||||||
|
TOvcDurationDisplay = (ddHMS, ddHM, ddMS, ddHHH, ddMMM, ddSSS);
|
||||||
|
|
||||||
|
TOvcGetTimeEvent = procedure(Sender : TObject; var Value : string)
|
||||||
|
of object;
|
||||||
|
TOvcPreParseTimeEvent = procedure(Sender : TObject; var Value : string)
|
||||||
|
of object;
|
||||||
|
|
||||||
|
TOvcCustomTimeEdit = class(TOvcCustomEdit)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FDurationDisplay : TOvcDurationDisplay;
|
||||||
|
FNowString : string;
|
||||||
|
FDefaultToPM : Boolean;
|
||||||
|
FPrimaryField : TOvcTimeField;
|
||||||
|
FShowSeconds : Boolean;
|
||||||
|
FShowUnits : Boolean;
|
||||||
|
FTime : TDateTime;
|
||||||
|
FTimeMode : TOvcTimeMode;
|
||||||
|
FUnitsLength : Integer;
|
||||||
|
|
||||||
|
{event variables}
|
||||||
|
FOnGetTime : TOvcGetTimeEvent;
|
||||||
|
FOnPreParseTime : TOvcPreParseTimeEvent;
|
||||||
|
FOnSetTime : TNotifyEvent;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetAsHours : LongInt;
|
||||||
|
function GetAsMinutes : LongInt;
|
||||||
|
function GetAsSeconds : LongInt;
|
||||||
|
function GetTime : TDateTime;
|
||||||
|
procedure SetAsHours(Value : LongInt);
|
||||||
|
procedure SetAsMinutes(Value : LongInt);
|
||||||
|
procedure SetAsSeconds(Value : LongInt);
|
||||||
|
procedure SetDurationDisplay(Value : TOvcDurationDisplay);
|
||||||
|
procedure SetShowSeconds(Value : Boolean);
|
||||||
|
procedure SetShowUnits(Value : Boolean);
|
||||||
|
procedure SetTimeMode(Value : TOvcTimeMode);
|
||||||
|
procedure SetUnitsLength(Value : Integer);
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure ParseFields(const Value : string; S : TStringList);
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure DoExit;
|
||||||
|
override;
|
||||||
|
procedure SetTime(Value : TDateTime);
|
||||||
|
procedure SetTimeText(Value : string);
|
||||||
|
dynamic;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
{protected properties}
|
||||||
|
property DefaultToPM : Boolean
|
||||||
|
read FDefaultToPM write FDefaultToPM;
|
||||||
|
property DurationDisplay : TOvcDurationDisplay
|
||||||
|
read FDurationDisplay write SetDurationDisplay;
|
||||||
|
property NowString : string
|
||||||
|
read FNowString write FNowString;
|
||||||
|
property PrimaryField : TOvcTimeField
|
||||||
|
read FPrimaryField write FPrimaryField;
|
||||||
|
property ShowSeconds : Boolean
|
||||||
|
read FShowSeconds write SetShowSeconds;
|
||||||
|
property ShowUnits : Boolean
|
||||||
|
read FShowUnits write SetShowUnits;
|
||||||
|
property TimeMode : TOvcTimeMode
|
||||||
|
read FTimeMode write SetTimeMode;
|
||||||
|
property UnitsLength : Integer
|
||||||
|
read FUnitsLength write SetUnitsLength;
|
||||||
|
|
||||||
|
{protected events}
|
||||||
|
property OnGetTime : TOvcGetTimeEvent
|
||||||
|
read FOnGetTime write FOnGetTime;
|
||||||
|
property OnPreParseTime : TOvcPreParseTimeEvent
|
||||||
|
read FOnPreParseTime write FOnPreParseTime;
|
||||||
|
property OnSetTime : TNotifyEvent
|
||||||
|
read FOnSetTime write FOnSetTime;
|
||||||
|
|
||||||
|
public
|
||||||
|
{.Z+}
|
||||||
|
constructor Create(AOwner : TComponent);
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
function FormatTime(Value : TDateTime) : string;
|
||||||
|
dynamic;
|
||||||
|
|
||||||
|
{public properties}
|
||||||
|
property AsDateTime : TDateTime
|
||||||
|
read GetTime write SetTime;
|
||||||
|
property AsHours : LongInt
|
||||||
|
read GetAsHours write SetAsHours;
|
||||||
|
property AsMinutes : LongInt
|
||||||
|
read GetAsMinutes write SetAsMinutes;
|
||||||
|
property AsSeconds : LongInt
|
||||||
|
read GetAsSeconds write SetAsSeconds;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcTimeEdit = class(TOvcCustomTimeEdit)
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property About;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property AutoSelect;
|
||||||
|
{$ENDIF}
|
||||||
|
property AutoSize;
|
||||||
|
property BorderStyle;
|
||||||
|
property CharCase;
|
||||||
|
property Color;
|
||||||
|
property Controller;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DefaultToPM;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property DurationDisplay;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property HideSelection;
|
||||||
|
property ImeMode;
|
||||||
|
property ImeName;
|
||||||
|
{$ENDIF}
|
||||||
|
property LabelInfo;
|
||||||
|
property MaxLength;
|
||||||
|
property NowString;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
property OEMConvert;
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property ParentBiDiMode;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property PrimaryField;
|
||||||
|
property ReadOnly;
|
||||||
|
property ShowHint;
|
||||||
|
property ShowSeconds;
|
||||||
|
property ShowUnits;
|
||||||
|
property TabOrder;
|
||||||
|
property TabStop;
|
||||||
|
property TimeMode;
|
||||||
|
property UnitsLength;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
{inherited events}
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property OnEndDock;
|
||||||
|
{$ENDIF}
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnGetTime;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnPreParseTime;
|
||||||
|
property OnSetTime;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
procedure DateTimeToHMS(D : TDateTime; var H, M, S : LongInt);
|
||||||
|
var
|
||||||
|
HS, Days : Double;
|
||||||
|
begin
|
||||||
|
HS := 1 / 86400 / 2; {half second portion of a day}
|
||||||
|
Days := Trunc(D);
|
||||||
|
D := (D-Days) * 24;
|
||||||
|
H := Trunc(D + HS);
|
||||||
|
D := (D - H) * 60;
|
||||||
|
M := Trunc(D + HS);
|
||||||
|
S := Trunc((D - M + HS) * 60);
|
||||||
|
H := Trunc(H + Days * 24);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HMSToDateTime(H, M, S : LongInt) : TDateTime;
|
||||||
|
var
|
||||||
|
HID, MID, SID : Double;
|
||||||
|
begin
|
||||||
|
HID := 24;
|
||||||
|
MID := 24*60;
|
||||||
|
SID := 24*60*60;
|
||||||
|
Result := H / HID + M / MID + S / SID;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** TOvcCustomTimeEdit ***}
|
||||||
|
|
||||||
|
constructor TOvcCustomTimeEdit.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption];
|
||||||
|
|
||||||
|
FDurationDisplay := ddHMS;
|
||||||
|
FPrimaryField := tfHours;
|
||||||
|
FNowString := TimeSeparator;
|
||||||
|
FShowSeconds := False;
|
||||||
|
FTime := SysUtils.Time;
|
||||||
|
FTimeMode := tmClock;
|
||||||
|
FUnitsLength := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.DoExit;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
SetTimeText(Text);
|
||||||
|
except
|
||||||
|
SetFocus;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
inherited DoExit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomTimeEdit.FormatTime(Value : TDateTime) : string;
|
||||||
|
var
|
||||||
|
H, M, S : LongInt;
|
||||||
|
TimeMask : string;
|
||||||
|
begin
|
||||||
|
TimeMask := OvcIntlSup.InternationalTime(FShowSeconds);
|
||||||
|
|
||||||
|
if FTimeMode = tmClock then
|
||||||
|
Result := OvcIntlSup.TimeToTimeString(TimeMask, DateTimeToSTTime(Value), False)
|
||||||
|
else begin
|
||||||
|
DateTimeToHMS(Value, H, M, S);
|
||||||
|
if FShowUnits then begin
|
||||||
|
case FDurationDisplay of
|
||||||
|
ddHMS : Result :=
|
||||||
|
IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength) + ' ' +
|
||||||
|
InttoStr(M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength) + ' ' +
|
||||||
|
InttoStr(S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
|
||||||
|
ddHM : Result :=
|
||||||
|
IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength) + ' ' +
|
||||||
|
InttoStr(M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength);
|
||||||
|
ddMS : Result :=
|
||||||
|
InttoStr(H*60+M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength) + ' ' +
|
||||||
|
InttoStr(S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
|
||||||
|
ddHHH : Result :=
|
||||||
|
IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength);
|
||||||
|
ddMMM : Result :=
|
||||||
|
InttoStr(H*60+M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength);
|
||||||
|
ddSSS : Result :=
|
||||||
|
InttoStr((H*60+M)*60+S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
case FDurationDisplay of
|
||||||
|
ddHMS : Result := IntToStr(H) + TimeSeparator + InttoStr(M) + TimeSeparator + InttoStr(S);
|
||||||
|
ddHM : Result := IntToStr(H) + TimeSeparator + InttoStr(M);
|
||||||
|
ddMS : Result := IntToStr(H*60+M) + TimeSeparator + InttoStr(S);
|
||||||
|
ddHHH : Result := IntToStr(H);
|
||||||
|
ddMMM : Result := IntToStr(H*60+M);
|
||||||
|
ddSSS : Result := IntToStr((H*60+M)*60+S);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomTimeEdit.GetAsHours : LongInt;
|
||||||
|
var
|
||||||
|
H, M, S : LongInt;
|
||||||
|
begin
|
||||||
|
DateTimeToHMS(FTime, H, M, S);
|
||||||
|
Result := H;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomTimeEdit.GetAsMinutes : LongInt;
|
||||||
|
var
|
||||||
|
H, M, S : LongInt;
|
||||||
|
begin
|
||||||
|
DateTimeToHMS(FTime, H, M, S);
|
||||||
|
Result := H*60+M;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomTimeEdit.GetAsSeconds : LongInt;
|
||||||
|
var
|
||||||
|
H, M, S : LongInt;
|
||||||
|
begin
|
||||||
|
DateTimeToHMS(FTime, H, M, S);
|
||||||
|
Result := (H*60+M)*60+S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomTimeEdit.GetTime : TDateTime;
|
||||||
|
begin
|
||||||
|
SetTimeText(Text);
|
||||||
|
Result := FTime;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetAsHours(Value : LongInt);
|
||||||
|
var
|
||||||
|
D, H : Integer;
|
||||||
|
begin
|
||||||
|
H := Value;
|
||||||
|
D := H div 24;
|
||||||
|
H := H - D * 24;
|
||||||
|
SetTime(D + EncodeTime(H, 0, 0, 0));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetAsMinutes(Value : LongInt);
|
||||||
|
var
|
||||||
|
D, H, M : Integer;
|
||||||
|
begin
|
||||||
|
M := Value;
|
||||||
|
D := M div (24 * 60);
|
||||||
|
M := M - D * (24 * 60);
|
||||||
|
H := M div 60;
|
||||||
|
M := M - H * 60;
|
||||||
|
SetTime(D + EncodeTime(H, M, 0, 0));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetAsSeconds(Value : LongInt);
|
||||||
|
var
|
||||||
|
D, H, M, S : Integer;
|
||||||
|
begin
|
||||||
|
S := Value;
|
||||||
|
D := S div (24 * 60 * 60);
|
||||||
|
S := S - D * (24 * 60 * 60);
|
||||||
|
H := S div (60 * 60);
|
||||||
|
S := S - H * (60 * 60);
|
||||||
|
M := S div 60;
|
||||||
|
S := S - M * 60;
|
||||||
|
SetTime(D + EncodeTime(H, M, S, 0));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetDurationDisplay(Value : TOvcDurationDisplay);
|
||||||
|
begin
|
||||||
|
if Value <> FDurationDisplay then begin
|
||||||
|
FDurationDisplay := Value;
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
SetTime(FTime); {force redisplay with current options}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetShowSeconds(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShowSeconds then begin
|
||||||
|
FShowSeconds := Value;
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
SetTime(FTime); {force redisplay with current options}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetShowUnits(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShowUnits then begin
|
||||||
|
FShowUnits := Value;
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
SetTime(FTime); {force redisplay with current options}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetTime(Value : TDateTime);
|
||||||
|
begin
|
||||||
|
FTime := Value;
|
||||||
|
Modified := True;
|
||||||
|
|
||||||
|
if FTime < 0 then
|
||||||
|
Text := ''
|
||||||
|
else
|
||||||
|
Text := FormatTime(FTime);
|
||||||
|
|
||||||
|
if Assigned(FOnSetTime) then
|
||||||
|
FOnSetTime(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetTimeMode(Value : TOvcTimeMode);
|
||||||
|
begin
|
||||||
|
if Value <> FTimeMode then begin
|
||||||
|
FTimeMode := Value;
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
SetTime(FTime); {force redisplay with current options}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.ParseFields(const Value : string; S : TStringList);
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
I1 : Integer;
|
||||||
|
I2 : Integer;
|
||||||
|
T : string;
|
||||||
|
begin
|
||||||
|
{parse the string into subfields using a string list to hold the parts}
|
||||||
|
I1 := 1;
|
||||||
|
while (I1 <= Length(Value)) and not (Value[I1] in ['0'..'9', 'A'..'Z']) do
|
||||||
|
Inc(I1);
|
||||||
|
while I1 <= Length(Value) do begin
|
||||||
|
I2 := I1;
|
||||||
|
while (I2 <= Length(Value)) and (Value[I2] in ['0'..'9', 'A'..'Z']) do
|
||||||
|
Inc(I2);
|
||||||
|
|
||||||
|
T := Copy(Value, I1, I2-I1);
|
||||||
|
{if this is a combination of numbers and letters without sperators}
|
||||||
|
{representing multiple fields, split them up}
|
||||||
|
while Length(T) > 0 do begin
|
||||||
|
I := 1;
|
||||||
|
case T[1] of
|
||||||
|
'A'..'Z' : while T[I] in ['A'..'Z'] do Inc(I);
|
||||||
|
'0'..'9' : while T[I] in ['0'..'9'] do Inc(I);
|
||||||
|
end;
|
||||||
|
S.Add(Copy(T, 1, I-1));
|
||||||
|
Delete(T, 1, I-1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
while (I2 <= Length(Value)) and not (Value[I2] in ['0'..'9', 'A'..'Z']) do
|
||||||
|
Inc(I2);
|
||||||
|
I1 := I2;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetTimeText(Value : string);
|
||||||
|
var
|
||||||
|
Field : Integer;
|
||||||
|
Error : Integer;
|
||||||
|
Hours : Integer;
|
||||||
|
Minutes : Integer;
|
||||||
|
Seconds : Integer;
|
||||||
|
FieldList : TStringList;
|
||||||
|
S : string;
|
||||||
|
FieldCount : Integer;
|
||||||
|
Am, Pm, AmPm : string[1];
|
||||||
|
FoundUnits : Boolean;
|
||||||
|
V : Integer;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnPreParseTime) then
|
||||||
|
FOnPreParseTime(Self, Value);
|
||||||
|
|
||||||
|
if Assigned(FOnGetTime) then
|
||||||
|
FOnGetTime(Self, Value);
|
||||||
|
|
||||||
|
if (Value = '') then begin
|
||||||
|
FTime := 0;
|
||||||
|
Text := '';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if AnsiCompareText(Value, NowString) = 0 then begin
|
||||||
|
SetTime(SysUtils.Time);
|
||||||
|
Text := FormatTime(FTime);
|
||||||
|
end else begin
|
||||||
|
Value := AnsiUpperCase(Value);
|
||||||
|
FieldList := TStringList.Create;
|
||||||
|
try
|
||||||
|
{break entry into fields}
|
||||||
|
ParseFields(Value, FieldList);
|
||||||
|
|
||||||
|
Hours := -1;
|
||||||
|
Minutes := -1;
|
||||||
|
Seconds := -1;
|
||||||
|
if FTimeMode = tmDuration then begin
|
||||||
|
{if a single field entered, assume primary field}
|
||||||
|
if FieldList.Count = 1 then begin
|
||||||
|
case FPrimaryField of
|
||||||
|
tfHours : Hours := StrToIntDef(FieldList[0], -1);
|
||||||
|
tfMinutes : Minutes := StrToIntDef(FieldList[0], -1);
|
||||||
|
tfSeconds : Seconds := StrToIntDef(FieldList[0], -1);
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
FieldCount := FieldList.Count;
|
||||||
|
FoundUnits := False;
|
||||||
|
for Field := 1 to FieldCount do begin
|
||||||
|
if FoundUnits then begin
|
||||||
|
FoundUnits := False;
|
||||||
|
Continue; {skip this field - it is a unit field}
|
||||||
|
end;
|
||||||
|
S := FieldList[Field-1];
|
||||||
|
V := StrToIntDef(S, -1);
|
||||||
|
{if more fields, see if next field is units for this one}
|
||||||
|
if Field < FieldCount then begin
|
||||||
|
S := FieldList[Field]; {get next field value}
|
||||||
|
if not (S[1] in ['0'..'9']) then begin
|
||||||
|
if PartialCompare(S, GetOrphStr(SCHoursName)) then begin
|
||||||
|
Hours := V;
|
||||||
|
FoundUnits := True;
|
||||||
|
end else if PartialCompare(S, GetOrphStr(SCMinutesName)) then begin
|
||||||
|
Minutes := V;
|
||||||
|
FoundUnits := True;
|
||||||
|
end else if PartialCompare(S, GetOrphStr(SCSecondsName)) then begin
|
||||||
|
Seconds := V;
|
||||||
|
FoundUnits := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{uses "logical" units for the time field based on prior fields}
|
||||||
|
if not FoundUnits then begin
|
||||||
|
if Hours = -1 then
|
||||||
|
Hours := V
|
||||||
|
else if Minutes = -1 then
|
||||||
|
Minutes := V
|
||||||
|
else if Seconds = -1 then
|
||||||
|
Seconds := V;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{if a value assigned, set time and exit}
|
||||||
|
if (Hours > -1) or (Minutes > -1) or (Seconds > -1) then begin
|
||||||
|
if Hours = -1 then
|
||||||
|
Hours := 0;
|
||||||
|
if Minutes = -1 then
|
||||||
|
Minutes := 0;
|
||||||
|
if Seconds = -1 then
|
||||||
|
Seconds := 0;
|
||||||
|
SetTime(HMSToDateTime(Hours, Minutes, Seconds));
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{handle as "normal" time -- "hh:mm:ss tt" format or variations}
|
||||||
|
Hours := 0;
|
||||||
|
Minutes := 0;
|
||||||
|
Seconds := 0;
|
||||||
|
Error := 0;
|
||||||
|
|
||||||
|
{set default am/pm}
|
||||||
|
{in case user has deleted these window settings}
|
||||||
|
if (TimeAmString > '') and (TimePmString > '') then begin
|
||||||
|
Am := AnsiUpperCase(TimeAmString[1]);
|
||||||
|
Pm := AnsiUpperCase(TimePmString[1]);
|
||||||
|
end else begin
|
||||||
|
Am := 'A';
|
||||||
|
Pm := 'P'
|
||||||
|
end;
|
||||||
|
if FDefaultToPM then
|
||||||
|
AmPm := Pm
|
||||||
|
else
|
||||||
|
AmPm := Am;
|
||||||
|
|
||||||
|
{see if we're using a 24 hour time format}
|
||||||
|
if (Pos(Am, ShortTimeFormat) = 0) and
|
||||||
|
(Pos(Pm, ShortTimeFormat) = 0) then
|
||||||
|
AmPm := '';
|
||||||
|
|
||||||
|
FieldCount := FieldList.Count;
|
||||||
|
for Field := FieldCount-1 downto 0 do begin
|
||||||
|
S := AnsiUpperCase(FieldList[Field]);
|
||||||
|
if Pos(Am, S) > 0 then begin
|
||||||
|
AmPm := Am;
|
||||||
|
FieldList.Delete(Field);
|
||||||
|
Continue;
|
||||||
|
end;
|
||||||
|
if Pos(Pm, S) > 0 then begin
|
||||||
|
AmPm := Pm;
|
||||||
|
FieldList.Delete(Field);
|
||||||
|
Continue;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FieldCount := FieldList.Count;
|
||||||
|
for Field := 1 to FieldCount do begin
|
||||||
|
S := FieldList[Field-1];
|
||||||
|
case Field of
|
||||||
|
1 :
|
||||||
|
begin
|
||||||
|
if (S = '') or (S[1] in ['0'..'9']) then begin
|
||||||
|
V := StrToIntDef(S, 0);
|
||||||
|
if FTimeMode = tmDuration then begin
|
||||||
|
case FPrimaryField of
|
||||||
|
tfHours : Hours := V;
|
||||||
|
tfMinutes : Minutes := V;
|
||||||
|
tfSeconds : Seconds := V;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
Hours := V;
|
||||||
|
if (Hours < 12) and (AmPm = Pm) then
|
||||||
|
Inc(Hours, 12);
|
||||||
|
if not (Hours in [0..23]) then
|
||||||
|
Error := SCTimeConvertError;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Error > 0 then
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
2 :
|
||||||
|
begin
|
||||||
|
if (S = '') or (S[1] in ['0'..'9']) then begin
|
||||||
|
V := StrToIntDef(S, 0);
|
||||||
|
if FTimeMode = tmDuration then begin
|
||||||
|
case FPrimaryField of
|
||||||
|
tfHours : Minutes := V;
|
||||||
|
tfMinutes : Seconds := V;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
Minutes := V;
|
||||||
|
if not (Minutes in [0..59]) then
|
||||||
|
Error := SCTimeConvertError;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Error > 0 then
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
3 :
|
||||||
|
begin
|
||||||
|
if (S = '') or (S[1] in ['0'..'9']) then begin
|
||||||
|
V := StrToIntDef(S, 0);
|
||||||
|
if FTimeMode = tmDuration then begin
|
||||||
|
case FPrimaryField of
|
||||||
|
tfHours : Seconds := V;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
Seconds := V;
|
||||||
|
if not (Seconds in [0..59]) then
|
||||||
|
Error := SCTimeConvertError;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Error > 0 then
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{special handling for times at or just after midnight}
|
||||||
|
if (AmPm = Am) then
|
||||||
|
if (Hours = 12) or (Hours = 24) then
|
||||||
|
Hours := 0;
|
||||||
|
|
||||||
|
if Error > 0 then
|
||||||
|
raise EOvcException.Create(GetOrphStr(Error) + ' "' + Value + '"');
|
||||||
|
|
||||||
|
SetTime(HMSToDateTime(Hours, Minutes, Seconds));
|
||||||
|
|
||||||
|
finally
|
||||||
|
FieldList.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomTimeEdit.SetUnitsLength(Value : Integer);
|
||||||
|
begin
|
||||||
|
if Value <> FUnitsLength then begin
|
||||||
|
FUnitsLength := Value;
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
SetTime(FTime); {force redisplay with current options}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
4743
components/orpheus/ovcef.pas
Normal file
4743
components/orpheus/ovcef.pas
Normal file
File diff suppressed because it is too large
Load Diff
372
components/orpheus/ovcexcpt.pas
Normal file
372
components/orpheus/ovcexcpt.pas
Normal file
@ -0,0 +1,372 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCEXCPT.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcexcpt;
|
||||||
|
{-Exceptions unit}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
|
||||||
|
Classes, SysUtils, OvcData, OvcConst, OvcIntl;
|
||||||
|
|
||||||
|
type
|
||||||
|
{*** Base Orpheus exeption class ***}
|
||||||
|
EOvcException = class(Exception)
|
||||||
|
public
|
||||||
|
ErrorCode : LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** General ***}
|
||||||
|
ENoTimersAvailable = class(EOvcException)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Controller ***}
|
||||||
|
EControllerError = class(EOvcException);
|
||||||
|
ENoControllerAssigned = class(EControllerError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Command Processor ***}
|
||||||
|
ECmdProcessorError = class(EOvcException);
|
||||||
|
EDuplicateCommand = class(ECmdProcessorError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ETableNotFound = class(ECmdProcessorError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Entry Fields ***}
|
||||||
|
EEntryFieldError = class(EOvcException);
|
||||||
|
EInvalidDataType = class(EEntryFieldError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidPictureMask = class(EEntryFieldError)
|
||||||
|
public
|
||||||
|
constructor Create(const Mask : string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidRangeValue = class(EEntryFieldError)
|
||||||
|
public
|
||||||
|
constructor Create(DataType : Byte);
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidDateForMask = class(EEntryFieldError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Editors ***}
|
||||||
|
EEditorError = class(EOvcException)
|
||||||
|
public
|
||||||
|
constructor Create(const Msg : string; Error : Cardinal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidLineOrCol = class(EEditorError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidLineOrPara = class(EEditorError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Viewers ***}
|
||||||
|
EViewerError = class(EOvcException);
|
||||||
|
ERegionTooLarge = class(EViewerError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Notebook ***}
|
||||||
|
ENotebookError = class(EOvcException);
|
||||||
|
EInvalidPageIndex = class(ENotebookError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidTabFont = class(ENotebookError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Rotated Label ***}
|
||||||
|
ERotatedLabelError = class(EOvcException);
|
||||||
|
EInvalidLabelFont = class(ERotatedLabelError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Timer Pool ***}
|
||||||
|
ETimerPoolError = class(EOvcException);
|
||||||
|
EInvalidTriggerHandle = class(ETimerPoolError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Virtual ListBox ***}
|
||||||
|
EVirtualListBoxError = class(EOvcException);
|
||||||
|
EOnSelectNotAssigned = class(EVirtualListBoxError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EOnIsSelectedNotAssigned = class(EVirtualListBoxError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** Report View ***}
|
||||||
|
EReportViewError = class(EOvcException) { generic report view exception}
|
||||||
|
constructor Create(ErrorCode : Integer; Dummy : Byte);
|
||||||
|
constructor CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
|
||||||
|
end;
|
||||||
|
EUnknownView = class(EReportViewError); { unknown view name }
|
||||||
|
EItemNotFound = class(EReportViewError); { attempt to change/remove nonexistent item}
|
||||||
|
EItemAlreadyAdded = class(EReportViewError); { attempt to re-add existing item }
|
||||||
|
EUpdatePending = class(EReportViewError); { operation is invalid while updates are pending }
|
||||||
|
EItemIsNotGroup = class(EReportViewError); { item at specified line is not a group (IsGroup = False) }
|
||||||
|
ELineNoOutOfRange = class(EReportViewError); { specified line is invalid (out of range) }
|
||||||
|
ENotMultiSelect = class(EReportViewError); { operation is invalid while MultiSelect is false }
|
||||||
|
EItemNotInIndex = class(EReportViewError); { specified data item is not in index }
|
||||||
|
ENoActiveView = class(EReportViewError); { no active view }
|
||||||
|
EOnCompareNotAsgnd = class(EReportViewError); { unassigned OnCompareFields }
|
||||||
|
EGetAsFloatNotAsg = class(EReportViewError); { unassigned OnGetFieldAsFloat }
|
||||||
|
EOnFilterNotAsgnd = class(EReportViewError); { unassigned OnFilter }
|
||||||
|
|
||||||
|
{*** Sparse Array ***}
|
||||||
|
ESparseArrayError = class(EOvcException);
|
||||||
|
ESAEAtMaxSize = class(ESparseArrayError);
|
||||||
|
ESAEOutOfBounds = class(ESparseArrayError);
|
||||||
|
|
||||||
|
{*** Fixed Font ***}
|
||||||
|
EFixedFontError = class(EOvcException);
|
||||||
|
EInvalidFixedFont = class(EFixedFontError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EInvalidFontParam = class(EFixedFontError)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{*** MRU List ***}
|
||||||
|
EMenuMRUError = class(EOvcException);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{*** General ***}
|
||||||
|
|
||||||
|
constructor ENoTimersAvailable.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCNoTimersAvail));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Controller ***}
|
||||||
|
|
||||||
|
constructor ENoControllerAssigned.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCNoControllerAssigned));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Command Processor ***}
|
||||||
|
|
||||||
|
constructor ETableNotFound.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCTableNotFound));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EDuplicateCommand.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCDuplicateCommand));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Entry Fields ***}
|
||||||
|
|
||||||
|
constructor EInvalidDataType.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidDataType));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidPictureMask.Create(const Mask : string);
|
||||||
|
begin
|
||||||
|
inherited CreateFmt(GetOrphStr(SCInvalidPictureMask), [Mask]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidRangeValue.Create(DataType : Byte);
|
||||||
|
var
|
||||||
|
S : string;
|
||||||
|
begin
|
||||||
|
case DataType of
|
||||||
|
fsubLongInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(LongInt), High(LongInt)]);
|
||||||
|
fsubWord : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Word), High(Word)]);
|
||||||
|
fsubInteger : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(SmallInt), High(SmallInt)]);
|
||||||
|
fsubByte : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Byte), High(Byte)]);
|
||||||
|
fsubShortInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(ShortInt), High(ShortInt)]);
|
||||||
|
fsubReal : inherited Create(GetOrphStr(SCInvalidRealRange));
|
||||||
|
fsubExtended : inherited Create(GetOrphStr(SCInvalidExtendedRange));
|
||||||
|
fsubDouble : inherited Create(GetOrphStr(SCInvalidDoubleRange));
|
||||||
|
fsubSingle : inherited Create(GetOrphStr(SCInvalidSingleRange));
|
||||||
|
fsubComp : inherited Create(GetOrphStr(SCInvalidCompRange));
|
||||||
|
fsubDate :
|
||||||
|
begin
|
||||||
|
S := OvcIntlSup.InternationalDate(True);
|
||||||
|
inherited CreateFmt(GetOrphStr(SCInvalidDateRange), [S]);
|
||||||
|
end;
|
||||||
|
fsubTime :
|
||||||
|
begin
|
||||||
|
S := OvcIntlSup.InternationalTime(False);
|
||||||
|
inherited CreateFmt(GetOrphStr(SCInvalidTimeRange), [S]);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
inherited Create(GetOrphStr(SCInvalidRangeValue));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidDateForMask.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidDateForMask));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Editors ***}
|
||||||
|
|
||||||
|
constructor EEditorError.Create(const Msg : string; Error : Cardinal);
|
||||||
|
begin
|
||||||
|
ErrorCode := Error;
|
||||||
|
inherited Create(Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidLineOrCol.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidLineOrColumn), 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidLineOrPara.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidLineOrParaIndex), 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Viewers ***}
|
||||||
|
|
||||||
|
constructor ERegionTooLarge.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCRegionTooLarge));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Notebook ***}
|
||||||
|
|
||||||
|
constructor EInvalidPageIndex.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidPageIndex));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidTabFont.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidTabFont));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Rotated Label ***}
|
||||||
|
|
||||||
|
constructor EInvalidLabelFont.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidLabelFont));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Timer Pool ***}
|
||||||
|
|
||||||
|
constructor EInvalidTriggerHandle.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCBadTriggerHandle));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Virtual ListBox ***}
|
||||||
|
|
||||||
|
constructor EOnSelectNotAssigned.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCOnSelectNotAssigned));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EOnIsSelectedNotAssigned.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCOnIsSelectedNotAssigned));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** Fixed Font ***}
|
||||||
|
|
||||||
|
constructor EInvalidFixedFont.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCNonFixedFont));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EInvalidFontParam.Create;
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(SCInvalidFontParam));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor EReportViewError.Create(ErrorCode : Integer; Dummy : Byte);
|
||||||
|
begin
|
||||||
|
inherited Create(GetOrphStr(ErrorCode));
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor EReportViewError.CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
|
||||||
|
begin
|
||||||
|
inherited CreateFmt(GetOrphStr(ErrorCode),Args);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
1651
components/orpheus/ovcintl.pas
Normal file
1651
components/orpheus/ovcintl.pas
Normal file
File diff suppressed because it is too large
Load Diff
839
components/orpheus/ovclabel.pas
Normal file
839
components/orpheus/ovclabel.pas
Normal file
@ -0,0 +1,839 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCLABEL.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovclabel;
|
||||||
|
{-label component}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Classes, Controls, Graphics, StdCtrls, SysUtils,
|
||||||
|
OvcMisc, OvcVer;
|
||||||
|
|
||||||
|
type
|
||||||
|
{preset "looks"}
|
||||||
|
TOvcAppearance = (apNone, apCustom, apFlying, apRaised, apSunken, apShadow);
|
||||||
|
{preset color schemes}
|
||||||
|
TOvcColorScheme = (csCustom, csText, csWindows, csEmbossed, csGold, csSteel);
|
||||||
|
{options for varying the shadow/highlight for the label}
|
||||||
|
TOvcGraduateStyle = (gsNone, gsHorizontal, gsVertical);
|
||||||
|
{directions for shading (highlights and shadows)}
|
||||||
|
TOvcShadeDirection = (sdNone, sdUp, sdUpRight, sdRight, sdDownRight, sdDown,
|
||||||
|
sdDownLeft, sdLeft, sdUpLeft);
|
||||||
|
{options for varying the text of the label}
|
||||||
|
TOvcShadeStyle = (ssPlain, ssExtrude, ssGraduated);
|
||||||
|
|
||||||
|
TOvcDepth = 0..255;
|
||||||
|
|
||||||
|
const
|
||||||
|
lblDefAppearance = apRaised;
|
||||||
|
lblDefAutoSize = False;
|
||||||
|
lblDefColorScheme = csWindows;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
lblDefFontName = 'Times New Roman';
|
||||||
|
{$ELSE}
|
||||||
|
lblDefFontName = 'default';
|
||||||
|
{$ENDIF}
|
||||||
|
lblDefFontSize = 20;
|
||||||
|
lblDefGraduateFromColor = clGray;
|
||||||
|
lblDefGraduateStyle = gsNone;
|
||||||
|
lblDefHighlightColor = clWhite;
|
||||||
|
lblDefHighlightDepth = 1;
|
||||||
|
lblDefHighlightDirection = sdUpLeft;
|
||||||
|
lblDefHighlightStyle = ssPlain;
|
||||||
|
lblDefShadowColor = clBlack;
|
||||||
|
lblDefShadowDepth = 1;
|
||||||
|
lblDefShadowDirection = sdDownRight;
|
||||||
|
lblDefShadowStyle = ssPlain;
|
||||||
|
lblDefTransparent = True;
|
||||||
|
lblDefWordWrap = True;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomSettings = class(TPersistent)
|
||||||
|
private
|
||||||
|
{.Z+}
|
||||||
|
{property variables}
|
||||||
|
FGraduateFromColor : TColor;
|
||||||
|
FGraduateStyle : TOvcGraduateStyle;
|
||||||
|
FHighlightColor : TColor;
|
||||||
|
FHighlightDepth : TOvcDepth;
|
||||||
|
FHighlightDirection : TOvcShadeDirection;
|
||||||
|
FHighlightStyle : TOvcShadeStyle;
|
||||||
|
FShadowColor : TColor;
|
||||||
|
FShadowDepth : TOvcDepth;
|
||||||
|
FShadowDirection : TOvcShadeDirection;
|
||||||
|
FShadowStyle : TOvcShadeStyle;
|
||||||
|
|
||||||
|
{event variables}
|
||||||
|
FOnColorChange : TNotifyEvent;
|
||||||
|
FOnStyleChange : TNotifyEvent;
|
||||||
|
|
||||||
|
{internal variables}
|
||||||
|
FUpdating : Boolean;
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure DoOnColorChange;
|
||||||
|
procedure DoOnStyleChange;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
procedure SetGraduateFromColor(Value : TColor);
|
||||||
|
procedure SetGraduateStyle(Value : TOvcGraduateStyle);
|
||||||
|
procedure SetHighlightColor(Value : TColor);
|
||||||
|
procedure SetHighlightDepth(Value : TOvcDepth);
|
||||||
|
procedure SetHighlightDirection(Value : TOvcShadeDirection);
|
||||||
|
procedure SetHighlightStyle(Value : TOvcShadeStyle);
|
||||||
|
procedure SetShadowColor(Value : TColor);
|
||||||
|
procedure SetShadowDepth(Value : TOvcDepth);
|
||||||
|
procedure SetShadowDirection(Value : TOvcShadeDirection);
|
||||||
|
procedure SetShadowStyle(Value : TOvcShadeStyle);
|
||||||
|
{.Z-}
|
||||||
|
public
|
||||||
|
procedure Assign(Source : TPersistent);
|
||||||
|
override;
|
||||||
|
|
||||||
|
procedure BeginUpdate;
|
||||||
|
procedure EndUpdate;
|
||||||
|
|
||||||
|
{.Z+}
|
||||||
|
property OnColorChange : TNotifyEvent
|
||||||
|
read FOnColorChange write FOnColorChange;
|
||||||
|
property OnStyleChange : TNotifyEvent
|
||||||
|
read FOnStyleChange write FOnStyleChange;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
published
|
||||||
|
property GraduateFromColor : TColor
|
||||||
|
read FGraduateFromColor write SetGraduateFromColor default lblDefGraduateFromColor;
|
||||||
|
property GraduateStyle : TOvcGraduateStyle
|
||||||
|
read FGraduateStyle write SetGraduateStyle default lblDefGraduateStyle;
|
||||||
|
property HighlightColor : TColor
|
||||||
|
read FHighlightColor write SetHighlightColor default lblDefHighlightColor;
|
||||||
|
property HighlightDepth : TOvcDepth
|
||||||
|
read FHighlightDepth write SetHighlightDepth default lblDefHighlightDepth;
|
||||||
|
property HighlightDirection : TOvcShadeDirection
|
||||||
|
read FHighlightDirection write SetHighlightDirection default lblDefHighlightDirection;
|
||||||
|
property HighlightStyle : TOvcShadeStyle
|
||||||
|
read FHighlightStyle write SetHighlightStyle default lblDefHighlightStyle;
|
||||||
|
property ShadowColor : TColor
|
||||||
|
read FShadowColor write SetShadowColor default lblDefShadowColor;
|
||||||
|
property ShadowDepth : TOvcDepth
|
||||||
|
read FShadowDepth write SetShadowDepth default lblDefShadowDepth;
|
||||||
|
property ShadowDirection : TOvcShadeDirection
|
||||||
|
read FShadowDirection write SetShadowDirection default lblDefShadowDirection;
|
||||||
|
property ShadowStyle : TOvcShadeStyle
|
||||||
|
read FShadowStyle write SetShadowStyle default lblDefShadowStyle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcCustomLabel = class(TCustomLabel)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FAppearance : TOvcAppearance;
|
||||||
|
FColorScheme : TOvcColorScheme;
|
||||||
|
FCustomSettings : TOvcCustomSettings;
|
||||||
|
|
||||||
|
{interal variables}
|
||||||
|
eslSchemes : array [TOvcColorScheme, (cpHighlight, cpShadow, cpFace)] of TColor;
|
||||||
|
SettingColorScheme : Boolean;
|
||||||
|
SettingAppearance : Boolean;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetAbout : string;
|
||||||
|
function GetWordWrap : Boolean;
|
||||||
|
procedure SetAppearance(Value : TOvcAppearance);
|
||||||
|
procedure SetColorScheme(Value : TOvcColorScheme);
|
||||||
|
procedure SetWordWrap(Value : Boolean);
|
||||||
|
procedure SetAbout(const Value : string);
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure PaintPrim(CR : TRect; Flags : Word);
|
||||||
|
procedure ColorChanged(Sender : TObject);
|
||||||
|
procedure StyleChanged(Sender : TObject);
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure Paint;
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
{protected properties} {can be published by descendants}
|
||||||
|
property About : string
|
||||||
|
read GetAbout write SetAbout stored False;
|
||||||
|
property Appearance : TOvcAppearance
|
||||||
|
read FAppearance write SetAppearance default lblDefAppearance;
|
||||||
|
property ColorScheme : TOvcColorScheme
|
||||||
|
read FColorScheme write SetColorScheme default lblDefColorScheme;
|
||||||
|
property CustomSettings : TOvcCustomSettings
|
||||||
|
read FCustomSettings write FCustomSettings;
|
||||||
|
property WordWrap : Boolean
|
||||||
|
read GetWordWrap write SetWordWrap default lblDefWordWrap;
|
||||||
|
public
|
||||||
|
{.Z+}
|
||||||
|
constructor Create(AOwner : TComponent);
|
||||||
|
override;
|
||||||
|
destructor Destroy;
|
||||||
|
override;
|
||||||
|
|
||||||
|
{ - Hdc changed to TOvcHdc for BCB Compatibility }
|
||||||
|
procedure PaintTo(DC : TOvcHdc{Hdc}; CR : TRect; Flags : Word);
|
||||||
|
|
||||||
|
property AutoSize;
|
||||||
|
{.Z-}
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcLabel = class(TOvcCustomLabel)
|
||||||
|
published
|
||||||
|
{properties}
|
||||||
|
property About;
|
||||||
|
property Align;
|
||||||
|
property Alignment;
|
||||||
|
{$IFDEF VERSION 4}
|
||||||
|
property Anchors;
|
||||||
|
{$ENDIF}
|
||||||
|
property Appearance;
|
||||||
|
property Caption;
|
||||||
|
property Color;
|
||||||
|
property ColorScheme;
|
||||||
|
property Cursor;
|
||||||
|
property CustomSettings;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property FocusControl;
|
||||||
|
property Font;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont default False;
|
||||||
|
property ParentShowHint;
|
||||||
|
property ShowAccelChar;
|
||||||
|
property ShowHint;
|
||||||
|
property Transparent
|
||||||
|
default lblDefTransparent;
|
||||||
|
property Visible;
|
||||||
|
property WordWrap;
|
||||||
|
|
||||||
|
{events}
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{*** TOvcCustomSettings ***}
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.Assign(Source : TPersistent);
|
||||||
|
var
|
||||||
|
LS : TOvcCustomSettings absolute Source;
|
||||||
|
begin
|
||||||
|
if Assigned(Source) and (Source is TOvcCustomSettings) then begin
|
||||||
|
FGraduateFromColor := LS.GraduateFromColor;
|
||||||
|
FGraduateStyle := LS.GraduateStyle;
|
||||||
|
FHighlightColor := LS.HighlightColor;
|
||||||
|
FHighlightDepth := LS.HighlightDepth;
|
||||||
|
FHighlightDirection := LS.HighlightDirection;
|
||||||
|
FHighlightStyle := LS.HighlightStyle;
|
||||||
|
FShadowColor := LS.ShadowColor;
|
||||||
|
FShadowDepth := LS.ShadowDepth;
|
||||||
|
FShadowDirection := LS.ShadowDirection;
|
||||||
|
FShadowStyle := LS.ShadowStyle;
|
||||||
|
end else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.BeginUpdate;
|
||||||
|
begin
|
||||||
|
FUpdating := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.EndUpdate;
|
||||||
|
begin
|
||||||
|
FUpdating := False;
|
||||||
|
DoOnColorChange;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.DoOnColorChange;
|
||||||
|
begin
|
||||||
|
if not FUpdating and Assigned(FOnColorChange) then
|
||||||
|
FOnColorChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.DoOnStyleChange;
|
||||||
|
begin
|
||||||
|
if not FUpdating and Assigned(FOnStyleChange) then
|
||||||
|
FOnStyleChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetGraduateFromColor(Value : TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FGraduateFromColor then begin
|
||||||
|
FGraduateFromColor := Value;
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetGraduateStyle(Value : TOvcGraduateStyle);
|
||||||
|
begin
|
||||||
|
if Value <> FGraduateStyle then begin
|
||||||
|
FGraduateStyle := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetHighlightColor(Value : TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FHighlightColor then begin
|
||||||
|
FHighlightColor := Value;
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetHighlightDepth(Value : TOvcDepth);
|
||||||
|
begin
|
||||||
|
if Value <> FHighlightDepth then begin
|
||||||
|
FHighlightDepth := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetHighlightDirection(Value : TOvcShadeDirection);
|
||||||
|
begin
|
||||||
|
if Value <> FHighlightDirection then begin
|
||||||
|
FHighlightDirection := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetHighlightStyle(Value : TOvcShadeStyle);
|
||||||
|
begin
|
||||||
|
if Value <> FHighlightStyle then begin
|
||||||
|
FHighlightStyle := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetShadowColor(Value : TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowColor then begin
|
||||||
|
FShadowColor := Value;
|
||||||
|
DoOnColorChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetShadowDepth(Value : TOvcDepth);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowDepth then begin
|
||||||
|
FShadowDepth := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetShadowDirection(Value : TOvcShadeDirection);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowDirection then begin
|
||||||
|
FShadowDirection := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomSettings.SetShadowStyle(Value : TOvcShadeStyle);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowStyle then begin
|
||||||
|
FShadowStyle := Value;
|
||||||
|
DoOnStyleChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcCustomLabel ***}
|
||||||
|
|
||||||
|
constructor TOvcCustomLabel.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
eslSchemes[csWindows, cpHighlight] := lblDefHighlightColor;
|
||||||
|
eslSchemes[csWindows, cpFace] := clGray;
|
||||||
|
eslSchemes[csWindows, cpShadow] := lblDefShadowColor;
|
||||||
|
|
||||||
|
eslSchemes[csText, cpHighlight] := clWhite;
|
||||||
|
eslSchemes[csText, cpFace] := clBlack;
|
||||||
|
eslSchemes[csText, cpShadow] := clGray;
|
||||||
|
|
||||||
|
eslSchemes[csEmbossed, cpHighlight] := clWhite;
|
||||||
|
eslSchemes[csEmbossed, cpFace] := clSilver;
|
||||||
|
eslSchemes[csEmbossed, cpShadow] := clBlack;
|
||||||
|
|
||||||
|
eslSchemes[csGold, cpHighlight] := clYellow;
|
||||||
|
eslSchemes[csGold, cpFace] := clOlive;
|
||||||
|
eslSchemes[csGold, cpShadow] := clBlack;
|
||||||
|
|
||||||
|
eslSchemes[csSteel, cpHighlight] := clAqua;
|
||||||
|
eslSchemes[csSteel, cpFace] := clTeal;
|
||||||
|
eslSchemes[csSteel, cpShadow] := clNavy;
|
||||||
|
|
||||||
|
eslSchemes[csCustom, cpHighlight] := eslSchemes[csWindows,cpHighlight];
|
||||||
|
eslSchemes[csCustom, cpFace] := eslSchemes[csWindows,cpFace];
|
||||||
|
eslSchemes[csCustom, cpShadow] := eslSchemes[csWindows,cpShadow];
|
||||||
|
|
||||||
|
{initialize defaults}
|
||||||
|
FAppearance := lblDefAppearance;
|
||||||
|
FColorScheme := lblDefColorScheme;
|
||||||
|
FCustomSettings := TOvcCustomSettings.Create;
|
||||||
|
FCustomSettings.FGraduateFromColor := lblDefGraduateFromColor;
|
||||||
|
FCustomSettings.FGraduateStyle := lblDefGraduateStyle;
|
||||||
|
FCustomSettings.FHighlightColor := eslSchemes[csWindows, cpHighlight];
|
||||||
|
FCustomSettings.FHighlightDepth := lblDefHighlightDepth;
|
||||||
|
FCustomSettings.FHighlightDirection := lblDefHighlightDirection;
|
||||||
|
FCustomSettings.FHighlightStyle := lblDefHighlightStyle;
|
||||||
|
FCustomSettings.FShadowColor := eslSchemes[csWindows, cpShadow];
|
||||||
|
FCustomSettings.FShadowDepth := lblDefShadowDepth;
|
||||||
|
FCustomSettings.FShadowDirection := lblDefShadowDirection;
|
||||||
|
FCustomSettings.FShadowStyle := lblDefShadowStyle;
|
||||||
|
FCustomSettings.OnColorChange := ColorChanged;
|
||||||
|
FCustomSettings.OnStyleChange := StyleChanged;
|
||||||
|
|
||||||
|
AutoSize := lblDefAutoSize;
|
||||||
|
Height := 35;
|
||||||
|
Width := 150;
|
||||||
|
Transparent := lblDefTransparent;
|
||||||
|
Font.Name := lblDefFontName;
|
||||||
|
Font.Size := lblDefFontSize;
|
||||||
|
Font.Color := eslSchemes[FColorScheme, cpFace];
|
||||||
|
WordWrap := lblDefWordWrap;
|
||||||
|
|
||||||
|
SettingColorScheme := False;
|
||||||
|
SettingAppearance := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcCustomLabel.Destroy;
|
||||||
|
begin
|
||||||
|
FCustomSettings.Free;
|
||||||
|
FCustomSettings := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomLabel.GetAbout : string;
|
||||||
|
begin
|
||||||
|
Result := OrVersionStr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomLabel.GetWordWrap : Boolean;
|
||||||
|
begin
|
||||||
|
Result := inherited WordWrap;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.Paint;
|
||||||
|
const
|
||||||
|
Alignments : array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
||||||
|
Wrap : array[Boolean] of Word = (0, DT_WORDBREAK);
|
||||||
|
Prefix : array[Boolean] of Word = (DT_NOPREFIX, 0);
|
||||||
|
begin
|
||||||
|
PaintPrim(ClientRect, Wrap[WordWrap] or DT_EXPANDTABS or
|
||||||
|
Alignments[Alignment] or Prefix[ShowAccelChar]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.PaintPrim(CR : TRect; Flags : Word);
|
||||||
|
const
|
||||||
|
DrawingOffset : array [TOvcShadeDirection, (ioX, ioY)] of -1..1 =
|
||||||
|
((0,0),(0,-1),(+1,-1),(+1,0),(+1,+1),(0,+1),(-1,+1),(-1,0),(-1,-1));
|
||||||
|
BandCount = 16;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
MinOffset : Integer;
|
||||||
|
MaxOffset : Integer;
|
||||||
|
IX, IY : Integer;
|
||||||
|
IU, IV : Integer;
|
||||||
|
Limit : Integer;
|
||||||
|
Adjustment : Integer;
|
||||||
|
AdjustR : Double;
|
||||||
|
AdjustG : Double;
|
||||||
|
AdjustB : Double;
|
||||||
|
Step : Double;
|
||||||
|
RctTemp : TRect;
|
||||||
|
FromR : Byte;
|
||||||
|
FromG : Byte;
|
||||||
|
FromB : Byte;
|
||||||
|
ToR : Byte;
|
||||||
|
ToG : Byte;
|
||||||
|
ToB : Byte;
|
||||||
|
BmpTemp : TBitmap;
|
||||||
|
BmpWork : TBitmap;
|
||||||
|
CnvWork : TCanvas;
|
||||||
|
Buf : PChar;
|
||||||
|
begin
|
||||||
|
if not Assigned(FCustomSettings) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
{get offsets based on shadow and highlight directions and depths}
|
||||||
|
MinOffset := MinI(MinI(MinI(MinI(DrawingOffset[FCustomSettings.HighlightDirection, ioX] * FCustomSettings.HighlightDepth,
|
||||||
|
DrawingOffset[FCustomSettings.ShadowDirection, ioX] * FCustomSettings.ShadowDepth),
|
||||||
|
DrawingOffset[FCustomSettings.HighlightDirection, ioY] * FCustomSettings.HighlightDepth),
|
||||||
|
DrawingOffset[FCustomSettings.ShadowDirection, ioY] * FCustomSettings.ShadowDepth), 0);
|
||||||
|
MaxOffset := MaxI(MaxI(MaxI(MaxI(DrawingOffset[FCustomSettings.HighlightDirection, ioX] * FCustomSettings.HighlightDepth,
|
||||||
|
DrawingOffset[FCustomSettings.ShadowDirection, ioX] * FCustomSettings.ShadowDepth),
|
||||||
|
DrawingOffset[FCustomSettings.HighlightDirection, ioY] * FCustomSettings.HighlightDepth),
|
||||||
|
DrawingOffset[FCustomSettings.ShadowDirection, ioY] * FCustomSettings.ShadowDepth), 0);
|
||||||
|
|
||||||
|
if Flags and DT_CENTER <> 0 then
|
||||||
|
Adjustment := (MaxOffset - MinOffset) div 2
|
||||||
|
else if Flags and DT_RIGHT <> 0 then
|
||||||
|
Adjustment := MaxOffset - MinOffset
|
||||||
|
else
|
||||||
|
Adjustment := 0;
|
||||||
|
|
||||||
|
{create temporary drawing surfaces}
|
||||||
|
BmpTemp := TBitmap.Create;
|
||||||
|
BmpWork := TBitmap.Create;
|
||||||
|
try
|
||||||
|
BmpTemp.Height := CR.Bottom-CR.Top;
|
||||||
|
BmpTemp.Width := CR.Right-CR.Left;
|
||||||
|
BmpTemp.Canvas.Font := Self.Font;
|
||||||
|
|
||||||
|
BmpWork.Height := CR.Bottom-CR.Top;
|
||||||
|
BmpWork.Width := CR.Right-CR.Left;
|
||||||
|
BmpWork.Canvas.Font := Self.Font;
|
||||||
|
|
||||||
|
{get copy of our canvas}
|
||||||
|
BmpWork.Canvas.CopyRect(CR, Self.Canvas, CR);
|
||||||
|
|
||||||
|
{set starting point for text - IX, IY}
|
||||||
|
IX := 0; IY := 0;
|
||||||
|
if not Transparent then begin
|
||||||
|
BmpWork.Canvas.Brush.Color := Self.Color;
|
||||||
|
BmpWork.Canvas.Brush.Style := bsSolid;
|
||||||
|
BmpWork.Canvas.FillRect(CR);
|
||||||
|
end;
|
||||||
|
BmpWork.Canvas.Brush.Style := bsClear;
|
||||||
|
|
||||||
|
Buf := StrAlloc(GetTextLen+1);
|
||||||
|
try
|
||||||
|
{get label's caption}
|
||||||
|
GetTextBuf(Buf, GetTextLen+1);
|
||||||
|
|
||||||
|
{prepare for extruding shadow, if requested}
|
||||||
|
GetRGB(FCustomSettings.ShadowColor, FromR, FromG, FromB);
|
||||||
|
AdjustR := 0;
|
||||||
|
AdjustG := 0;
|
||||||
|
AdjustB := 0;
|
||||||
|
Limit := FCustomSettings.ShadowDepth;
|
||||||
|
if (FCustomSettings.ShadowStyle <> ssPlain) and (FCustomSettings.ShadowDepth > 1) then begin
|
||||||
|
Limit := 1;
|
||||||
|
{find changes in RGB colors}
|
||||||
|
if FCustomSettings.ShadowStyle = ssGraduated then begin
|
||||||
|
GetRGB(Font.Color, ToR, ToG, ToB);
|
||||||
|
AdjustR := (ToR - FromR) / (FCustomSettings.ShadowDepth - 1);
|
||||||
|
AdjustG := (ToG - FromG) / (FCustomSettings.ShadowDepth - 1);
|
||||||
|
AdjustB := (ToB - FromB) / (FCustomSettings.ShadowDepth - 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
CnvWork := BmpWork.Canvas;
|
||||||
|
|
||||||
|
{process for each copy of the shadow}
|
||||||
|
for I := FCustomSettings.ShadowDepth downto Limit do begin
|
||||||
|
CnvWork.Font.Color :=
|
||||||
|
RGB(FromR + Round(AdjustR * (FCustomSettings.ShadowDepth - I)),
|
||||||
|
FromG + Round(AdjustG * (FCustomSettings.ShadowDepth - I)),
|
||||||
|
FromB + Round(AdjustB * (FCustomSettings.ShadowDepth - I)));
|
||||||
|
{create a rect that is offset for the shadow}
|
||||||
|
RctTemp:= Rect(
|
||||||
|
CR.Left - MinOffset -Adjustment + DrawingOffset[FCustomSettings.ShadowDirection, ioX] * I,
|
||||||
|
CR.Top - MinOffset + DrawingOffset[FCustomSettings.ShadowDirection, ioY] * I,
|
||||||
|
CR.Right - MinOffset - Adjustment + DrawingOffset[FCustomSettings.ShadowDirection, ioX] * I,
|
||||||
|
CR.Bottom - MinOffset + DrawingOffset[FCustomSettings.ShadowDirection, ioY] * I);
|
||||||
|
{draw shadow text with alignment}
|
||||||
|
DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{prepare for extruding highlight, if requested}
|
||||||
|
GetRGB(FCustomSettings.HighlightColor, FromR, FromG, FromB);
|
||||||
|
AdjustR := 0;
|
||||||
|
AdjustG := 0;
|
||||||
|
AdjustB := 0;
|
||||||
|
Limit := FCustomSettings.HighlightDepth;
|
||||||
|
if (FCustomSettings.HighlightStyle <> ssPlain) and (FCustomSettings.HighlightDepth > 1) then begin
|
||||||
|
Limit := 1;
|
||||||
|
if FCustomSettings.HighlightStyle = ssGraduated then begin {find changes in RGB Colors}
|
||||||
|
GetRGB(Font.Color, ToR, ToG, ToB);
|
||||||
|
AdjustR := (ToR - FromR) / (FCustomSettings.HighlightDepth - 1);
|
||||||
|
AdjustG := (ToG - FromG) / (FCustomSettings.HighlightDepth - 1);
|
||||||
|
AdjustB := (ToB - FromB) / (FCustomSettings.HighlightDepth - 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CnvWork := BmpWork.Canvas;
|
||||||
|
|
||||||
|
{process for each copy of the highlight}
|
||||||
|
for I := FCustomSettings.HighlightDepth downto Limit do begin
|
||||||
|
CnvWork.Font.Color :=
|
||||||
|
RGB(FromR + Round(AdjustR * (FCustomSettings.HighlightDepth - I)),
|
||||||
|
FromG + Round(AdjustG * (FCustomSettings.HighlightDepth - I)),
|
||||||
|
FromB + Round(AdjustB * (FCustomSettings.HighlightDepth - I)));
|
||||||
|
{create a rect that is offset for the highlight}
|
||||||
|
RctTemp:= Rect(
|
||||||
|
CR.Left - MinOffset - Adjustment + DrawingOffset[FCustomSettings.HighlightDirection, ioX] * I,
|
||||||
|
CR.Top - MinOffset + DrawingOffset[FCustomSettings.HighlightDirection, ioY] * I,
|
||||||
|
CR.Right - MinOffset - Adjustment + DrawingOffset[FCustomSettings.HighlightDirection, ioX] * I,
|
||||||
|
CR.Bottom - MinOffset + DrawingOffset[FCustomSettings.HighlightDirection, ioY] * I);
|
||||||
|
{draw highlight text with alignment}
|
||||||
|
DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FCustomSettings.GraduateStyle <> gsNone then begin
|
||||||
|
{copy original canvas to work area}
|
||||||
|
BmpTemp.Canvas.CopyRect(CR, BmpWork.Canvas, CR);
|
||||||
|
{choose an unusual color}
|
||||||
|
BmpTemp.Canvas.Font.Color := $00FE09F1;
|
||||||
|
BmpTemp.Canvas.Brush.Style := bsClear;
|
||||||
|
CnvWork := BmpTemp.Canvas;
|
||||||
|
end else begin
|
||||||
|
BmpWork.Canvas.Font.Color := Font.Color; {restore original font Color}
|
||||||
|
CnvWork := BmpWork.Canvas;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{create a rect that is offset for the original text}
|
||||||
|
RctTemp:= Rect(CR.Left - MinOffset - Adjustment,
|
||||||
|
CR.Top - MinOffset,
|
||||||
|
CR.Right - MinOffset - Adjustment,
|
||||||
|
CR.Bottom - MinOffset);
|
||||||
|
|
||||||
|
{draw original text with alignment}
|
||||||
|
DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
|
||||||
|
finally
|
||||||
|
StrDispose(Buf);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FCustomSettings.GraduateStyle <> gsNone then begin
|
||||||
|
{transfer graduations from temporary canvas}
|
||||||
|
{calculate start point and extent}
|
||||||
|
Limit := BmpWork.Canvas.TextWidth(Caption);
|
||||||
|
IV := IY - MinOffset;
|
||||||
|
|
||||||
|
if Flags and DT_CENTER <> 0 then
|
||||||
|
IU := (CR.Right-CR.Left - Limit) div 2 - MinOffset - Adjustment
|
||||||
|
else if Flags and DT_RIGHT <> 0 then
|
||||||
|
IU := CR.Bottom-CR.Top - MaxOffset - Limit
|
||||||
|
else
|
||||||
|
IU := IX - MinOffset;
|
||||||
|
|
||||||
|
if FCustomSettings.GraduateStyle = gsVertical then
|
||||||
|
Limit := CR.Bottom-CR.Top-1
|
||||||
|
else
|
||||||
|
Dec(Limit);
|
||||||
|
|
||||||
|
{calculate change in color at each step}
|
||||||
|
GetRGB(FCustomSettings.GraduateFromColor, FromR, FromG, FromB);
|
||||||
|
GetRGB(Font.Color, ToR, ToG, ToB);
|
||||||
|
AdjustR := (ToR - FromR) / Pred(BandCount);
|
||||||
|
AdjustG := (ToG - FromG) / Pred(BandCount);
|
||||||
|
AdjustB := (ToB - FromB) / Pred(BandCount);
|
||||||
|
|
||||||
|
Step := Limit / Pred(BandCount);
|
||||||
|
|
||||||
|
{and draw it onto the canvas}
|
||||||
|
BmpWork.Canvas.Brush.Style := bsSolid;
|
||||||
|
for I := 0 to Pred(BandCount) do begin
|
||||||
|
BmpWork.Canvas.Brush.Color := RGB(FromR + Round(AdjustR * I),
|
||||||
|
FromG + Round(AdjustG * I),
|
||||||
|
FromB + Round(AdjustB * I));
|
||||||
|
if FCustomSettings.GraduateStyle = gsVertical then
|
||||||
|
RctTemp := Rect(0, IV + Round(I*Step), CR.Right-CR.Left, IV + Round((I+1)*Step))
|
||||||
|
else
|
||||||
|
RctTemp := Rect(IU + Round(I*Step), 0, IU + Round((I+1)*Step), CR.Bottom-CR.Top);
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
BmpWork.Canvas.BrushCopy(RctTemp, BmpTemp, RctTemp, BmpTemp.Canvas.Font.Color);
|
||||||
|
{$ELSE}
|
||||||
|
BrushCopy(BmpWork.Canvas, RctTemp, BmpTemp, RctTemp, BmpTemp.Canvas.Font.Color);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Canvas.CopyRect(CR, BmpWork.Canvas, CR);
|
||||||
|
finally
|
||||||
|
BmpTemp.Free;
|
||||||
|
BmpWork.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ - Hdc changed to TOvcHdc for BCB compatibility}
|
||||||
|
procedure TOvcCustomLabel.PaintTo(DC : TOvcHdc {Hdc}; CR : TRect; Flags : Word);
|
||||||
|
begin
|
||||||
|
Canvas.Handle := DC;
|
||||||
|
try
|
||||||
|
if not Transparent then begin
|
||||||
|
Canvas.Brush.Color := Self.Color;
|
||||||
|
Canvas.Brush.Style := bsSolid;
|
||||||
|
{clear complete client area}
|
||||||
|
Canvas.FillRect(Rect(0, 0, CR.Right, CR.Bottom));
|
||||||
|
end;
|
||||||
|
Canvas.Brush.Style := bsClear;
|
||||||
|
PaintPrim(CR, Flags)
|
||||||
|
finally
|
||||||
|
Canvas.Handle := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.SetAppearance(Value : TOvcAppearance);
|
||||||
|
begin
|
||||||
|
if FAppearance <> Value then begin
|
||||||
|
SettingAppearance := True;
|
||||||
|
try
|
||||||
|
FAppearance := Value;
|
||||||
|
FCustomSettings.BeginUpdate;
|
||||||
|
try
|
||||||
|
FCustomSettings.HighlightColor := eslSchemes[ColorScheme,cpHighlight];
|
||||||
|
case FAppearance of
|
||||||
|
apRaised:
|
||||||
|
begin
|
||||||
|
FCustomSettings.HighlightDirection := sdUpLeft;
|
||||||
|
FCustomSettings.ShadowDirection := sdDownRight;
|
||||||
|
FCustomSettings.HighlightDepth := 1;
|
||||||
|
FCustomSettings.ShadowDepth := 1;
|
||||||
|
end;
|
||||||
|
apSunken:
|
||||||
|
begin
|
||||||
|
FCustomSettings.HighlightDirection := sdDownRight;
|
||||||
|
FCustomSettings.ShadowDirection := sdUpLeft;
|
||||||
|
FCustomSettings.HighlightDepth := 1;
|
||||||
|
FCustomSettings.ShadowDepth := 1;
|
||||||
|
end;
|
||||||
|
apShadow:
|
||||||
|
begin
|
||||||
|
FCustomSettings.HighlightDirection := sdNone;
|
||||||
|
FCustomSettings.ShadowDirection := sdDownRight;
|
||||||
|
FCustomSettings.HighlightDepth := 0;
|
||||||
|
FCustomSettings.ShadowDepth := 2;
|
||||||
|
end;
|
||||||
|
apFlying:
|
||||||
|
begin
|
||||||
|
FCustomSettings.HighlightDirection := sdDownRight;
|
||||||
|
FCustomSettings.ShadowDirection := sdDownRight;
|
||||||
|
FCustomSettings.HighlightDepth :=1;
|
||||||
|
FCustomSettings.ShadowDepth :=5;
|
||||||
|
{flying has two shadows}
|
||||||
|
FCustomSettings.HighlightColor := eslSchemes[ColorScheme, cpShadow];
|
||||||
|
end;
|
||||||
|
apNone:
|
||||||
|
begin
|
||||||
|
FCustomSettings.HighlightDirection := sdNone;
|
||||||
|
FCustomSettings.ShadowDirection := sdNone;
|
||||||
|
FCustomSettings.HighlightDepth :=0;
|
||||||
|
FCustomSettings.ShadowDepth :=0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FCustomSettings.EndUpdate;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SettingAppearance := False;
|
||||||
|
Perform(CM_TEXTCHANGED, 0, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.SetColorScheme(Value : TOvcColorScheme);
|
||||||
|
begin
|
||||||
|
if FColorScheme <> Value then begin
|
||||||
|
SettingColorScheme := True;
|
||||||
|
try
|
||||||
|
FColorScheme := Value;
|
||||||
|
FCustomSettings.BeginUpdate;
|
||||||
|
try
|
||||||
|
FCustomSettings.HighlightColor := eslSchemes[FColorScheme, cpHighlight];
|
||||||
|
Font.Color := eslSchemes[FColorScheme, cpFace];
|
||||||
|
FCustomSettings.ShadowColor := eslSchemes[FColorScheme, cpShadow];
|
||||||
|
if FColorScheme <> csCustom then begin
|
||||||
|
eslSchemes[csCustom, cpHighlight] := eslSchemes[FColorScheme, cpHighlight];
|
||||||
|
eslSchemes[csCustom, cpFace] := eslSchemes[FColorScheme, cpFace];
|
||||||
|
eslSchemes[csCustom, cpShadow] := eslSchemes[FColorScheme, cpShadow];
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FCustomSettings.EndUpdate;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SettingColorScheme := False;
|
||||||
|
Perform(CM_TEXTCHANGED, 0, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.ColorChanged(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
Invalidate;
|
||||||
|
|
||||||
|
if not SettingColorScheme then
|
||||||
|
FColorScheme := csCustom;
|
||||||
|
|
||||||
|
if not SettingColorScheme then
|
||||||
|
Perform(CM_COLORCHANGED, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.StyleChanged(Sender : TObject);
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
Invalidate;
|
||||||
|
|
||||||
|
if not SettingAppearance then begin
|
||||||
|
FAppearance := apCustom;
|
||||||
|
Perform(CM_TEXTCHANGED, 0, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.SetAbout(const Value : string);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomLabel.SetWordWrap(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> WordWrap then begin
|
||||||
|
inherited WordWrap := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
382
components/orpheus/ovclbl0.lfm
Normal file
382
components/orpheus/ovclbl0.lfm
Normal file
@ -0,0 +1,382 @@
|
|||||||
|
object frmOvcLabel: TfrmOvcLabel
|
||||||
|
Left = 328
|
||||||
|
Top = 198
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Style Manager'
|
||||||
|
ClientHeight = 456
|
||||||
|
Height = 456
|
||||||
|
ClientWidth = 577
|
||||||
|
Width = 577
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Style = []
|
||||||
|
OnCreate = FormCreate
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Width = 577
|
||||||
|
Height = 97
|
||||||
|
Align = alTop
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Style = []
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
object OvcLabel: TOvcLabel
|
||||||
|
Left = 1
|
||||||
|
Top = 1
|
||||||
|
Width = 575
|
||||||
|
Height = 95
|
||||||
|
Align = alClient
|
||||||
|
Alignment = taCenter
|
||||||
|
Appearance = apCustom
|
||||||
|
Caption = 'Orpheus Labels'
|
||||||
|
ColorScheme = csCustom
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clGray
|
||||||
|
Font.Height = -27
|
||||||
|
Font.Style = []
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Button1: TButton
|
||||||
|
Left = 418
|
||||||
|
Top = 427
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'OK'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
object Button2: TButton
|
||||||
|
Left = 500
|
||||||
|
Top = 427
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'Cancel'
|
||||||
|
ModalResult = 2
|
||||||
|
TabOrder = 5
|
||||||
|
end
|
||||||
|
object Panel2: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 364
|
||||||
|
Width = 393
|
||||||
|
Height = 91
|
||||||
|
TabOrder = 3
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 4
|
||||||
|
Top = 4
|
||||||
|
Width = 57
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Style Name:'
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 256
|
||||||
|
Top = 5
|
||||||
|
Width = 61
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Appearance:'
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 256
|
||||||
|
Top = 48
|
||||||
|
Width = 69
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Color Scheme:'
|
||||||
|
end
|
||||||
|
object SchemeCb: TComboBox
|
||||||
|
Left = 4
|
||||||
|
Top = 20
|
||||||
|
Width = 233
|
||||||
|
Height = 21
|
||||||
|
Style = csDropDownList
|
||||||
|
ItemHeight = 13
|
||||||
|
Items.Strings = (
|
||||||
|
'one'
|
||||||
|
'two')
|
||||||
|
MaxLength = 255
|
||||||
|
Sorted = True
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = SchemeCbChange
|
||||||
|
end
|
||||||
|
object SaveAsBtn: TButton
|
||||||
|
Left = 4
|
||||||
|
Top = 55
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Save &As...'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = SaveAsBtnClick
|
||||||
|
end
|
||||||
|
object DeleteBtn: TButton
|
||||||
|
Left = 161
|
||||||
|
Top = 55
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = '&Delete'
|
||||||
|
TabOrder = 2
|
||||||
|
OnClick = DeleteBtnClick
|
||||||
|
end
|
||||||
|
object AppearanceCb: TComboBox
|
||||||
|
Left = 256
|
||||||
|
Top = 20
|
||||||
|
Width = 126
|
||||||
|
Height = 21
|
||||||
|
ItemHeight = 13
|
||||||
|
TabOrder = 3
|
||||||
|
OnChange = AppearanceCbChange
|
||||||
|
end
|
||||||
|
object ColorSchemeCb: TComboBox
|
||||||
|
Left = 256
|
||||||
|
Top = 62
|
||||||
|
Width = 126
|
||||||
|
Height = 21
|
||||||
|
ItemHeight = 13
|
||||||
|
TabOrder = 4
|
||||||
|
OnChange = ColorSchemeCbChange
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Panel3: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 97
|
||||||
|
Width = 577
|
||||||
|
Height = 189
|
||||||
|
TabOrder = 1
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 152
|
||||||
|
Top = 83
|
||||||
|
Width = 70
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Gradient Color:'
|
||||||
|
end
|
||||||
|
object Label5: TLabel
|
||||||
|
Left = 294
|
||||||
|
Top = 83
|
||||||
|
Width = 71
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Highlight Color:'
|
||||||
|
end
|
||||||
|
object Label6: TLabel
|
||||||
|
Left = 437
|
||||||
|
Top = 83
|
||||||
|
Width = 69
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Shadow Color:'
|
||||||
|
end
|
||||||
|
object HighlightDirectionLbl: TLabel
|
||||||
|
Left = 304
|
||||||
|
Top = 128
|
||||||
|
Width = 50
|
||||||
|
Height = 32
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Highlight Direction:'
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object ShadowDirectionLbl: TLabel
|
||||||
|
Left = 447
|
||||||
|
Top = 128
|
||||||
|
Width = 50
|
||||||
|
Height = 32
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Shadow Direction:'
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label7: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 65
|
||||||
|
Width = 53
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Text Color/'
|
||||||
|
end
|
||||||
|
object Label8: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 78
|
||||||
|
Width = 86
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Gradient To Color:'
|
||||||
|
end
|
||||||
|
object GraduateRg: TRadioGroup
|
||||||
|
Left = 150
|
||||||
|
Top = 3
|
||||||
|
Width = 137
|
||||||
|
Height = 73
|
||||||
|
Caption = 'Text &Gradient Style'
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'None'
|
||||||
|
'Horizontal'
|
||||||
|
'Vertical')
|
||||||
|
OnClick = GraduateRgClick
|
||||||
|
end
|
||||||
|
object ShadowRg: TRadioGroup
|
||||||
|
Left = 436
|
||||||
|
Top = 3
|
||||||
|
Width = 137
|
||||||
|
Height = 73
|
||||||
|
Caption = '&Shadow Style'
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Plain'
|
||||||
|
'Extrude'
|
||||||
|
'Graduate')
|
||||||
|
OnClick = ShadowRgClick
|
||||||
|
end
|
||||||
|
object HighlightRg: TRadioGroup
|
||||||
|
Left = 293
|
||||||
|
Top = 3
|
||||||
|
Width = 137
|
||||||
|
Height = 73
|
||||||
|
Caption = '&Highlight Style'
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Plain'
|
||||||
|
'Extrude'
|
||||||
|
'Graduate')
|
||||||
|
OnClick = HighlightRgClick
|
||||||
|
end
|
||||||
|
object FromColorCcb: TOvcColorComboBox
|
||||||
|
Left = 151
|
||||||
|
Top = 99
|
||||||
|
Width = 137
|
||||||
|
Height = 22
|
||||||
|
ItemHeight = 12
|
||||||
|
SelectedColor = clBlack
|
||||||
|
TabOrder = 4
|
||||||
|
Text = 'Black'
|
||||||
|
OnChange = FromColorCcbChange
|
||||||
|
end
|
||||||
|
object HighlightColorCcb: TOvcColorComboBox
|
||||||
|
Left = 293
|
||||||
|
Top = 99
|
||||||
|
Width = 137
|
||||||
|
Height = 22
|
||||||
|
ItemHeight = 12
|
||||||
|
SelectedColor = clBlack
|
||||||
|
TabOrder = 5
|
||||||
|
Text = 'Black'
|
||||||
|
OnChange = HighlightColorCcbChange
|
||||||
|
end
|
||||||
|
object ShadowColorCcb: TOvcColorComboBox
|
||||||
|
Left = 436
|
||||||
|
Top = 99
|
||||||
|
Width = 137
|
||||||
|
Height = 22
|
||||||
|
ItemHeight = 12
|
||||||
|
SelectedColor = clBlack
|
||||||
|
TabOrder = 6
|
||||||
|
Text = 'Black'
|
||||||
|
OnChange = ShadowColorCcbChange
|
||||||
|
end
|
||||||
|
object FontColorCcb: TOvcColorComboBox
|
||||||
|
Left = 7
|
||||||
|
Top = 99
|
||||||
|
Width = 137
|
||||||
|
Height = 22
|
||||||
|
ItemHeight = 12
|
||||||
|
SelectedColor = clBlack
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Black'
|
||||||
|
OnChange = FontColorCcbChange
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Panel4: TPanel
|
||||||
|
Left = 0
|
||||||
|
Top = 286
|
||||||
|
Width = 577
|
||||||
|
Height = 78
|
||||||
|
TabOrder = 2
|
||||||
|
object Label9: TLabel
|
||||||
|
Left = 20
|
||||||
|
Top = 8
|
||||||
|
Width = 105
|
||||||
|
Height = 13
|
||||||
|
Alignment = taRightJustify
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Font Size: '
|
||||||
|
end
|
||||||
|
object FontSizeLbl: TLabel
|
||||||
|
Left = 500
|
||||||
|
Top = 8
|
||||||
|
Width = 6
|
||||||
|
Height = 13
|
||||||
|
Caption = '0'
|
||||||
|
end
|
||||||
|
object HighlightDepthLbl: TLabel
|
||||||
|
Left = 500
|
||||||
|
Top = 32
|
||||||
|
Width = 6
|
||||||
|
Height = 13
|
||||||
|
Caption = '0'
|
||||||
|
end
|
||||||
|
object ShadowDepthLbl: TLabel
|
||||||
|
Left = 500
|
||||||
|
Top = 56
|
||||||
|
Width = 6
|
||||||
|
Height = 13
|
||||||
|
Caption = '0'
|
||||||
|
end
|
||||||
|
object Label10: TLabel
|
||||||
|
Left = 20
|
||||||
|
Top = 32
|
||||||
|
Width = 105
|
||||||
|
Height = 13
|
||||||
|
Alignment = taRightJustify
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Highlight Depth: '
|
||||||
|
end
|
||||||
|
object Label11: TLabel
|
||||||
|
Left = 20
|
||||||
|
Top = 56
|
||||||
|
Width = 105
|
||||||
|
Height = 13
|
||||||
|
Alignment = taRightJustify
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Shadow Depth: '
|
||||||
|
end
|
||||||
|
object FontSizeSb: TScrollBar
|
||||||
|
Left = 132
|
||||||
|
Top = 8
|
||||||
|
Width = 357
|
||||||
|
Height = 14
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = FontSizeSbChange
|
||||||
|
end
|
||||||
|
object ShadowDepthSb: TScrollBar
|
||||||
|
Left = 132
|
||||||
|
Top = 56
|
||||||
|
Width = 357
|
||||||
|
Height = 14
|
||||||
|
Max = 50
|
||||||
|
TabOrder = 2
|
||||||
|
OnChange = ShadowDepthSbChange
|
||||||
|
end
|
||||||
|
object HighlightDepthSb: TScrollBar
|
||||||
|
Left = 132
|
||||||
|
Top = 32
|
||||||
|
Width = 357
|
||||||
|
Height = 14
|
||||||
|
Max = 50
|
||||||
|
TabOrder = 1
|
||||||
|
OnChange = HighlightDepthSbChange
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object OvcController1: TOvcController
|
||||||
|
EntryCommands.TableList = (
|
||||||
|
'Default'
|
||||||
|
True
|
||||||
|
()
|
||||||
|
'WordStar'
|
||||||
|
False
|
||||||
|
()
|
||||||
|
'Grid'
|
||||||
|
False
|
||||||
|
())
|
||||||
|
Epoch = 1900
|
||||||
|
end
|
||||||
|
end
|
||||||
92
components/orpheus/ovclbl0.lrs
Normal file
92
components/orpheus/ovclbl0.lrs
Normal file
@ -0,0 +1,92 @@
|
|||||||
|
LazarusResources.Add('TfrmOvcLabel','FORMDATA',[
|
||||||
|
'TPF0'#12'TfrmOvcLabel'#11'frmOvcLabel'#4'Left'#3'H'#1#3'Top'#3#198#0#11'Bord'
|
||||||
|
+'erStyle'#7#8'bsDialog'#7'Caption'#6#13'Style Manager'#12'ClientHeight'#3#200
|
||||||
|
+#1#6'Height'#3#200#1#11'ClientWidth'#3'A'#2#5'Width'#3'A'#2#12'Font.Charset'
|
||||||
|
+#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2
|
||||||
|
+#245#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'
|
||||||
|
+#10'TextHeight'#2#13#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3
|
||||||
|
+'A'#2#6'Height'#2'a'#5'Align'#7#5'alTop'#12'Font.Charset'#7#15'DEFAULT_CHARS'
|
||||||
|
+'ET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10'Font.Style'
|
||||||
|
+#11#0#10'ParentFont'#8#8'TabOrder'#2#0#0#9'TOvcLabel'#8'OvcLabel'#4'Left'#2#1
|
||||||
|
+#3'Top'#2#1#5'Width'#3'?'#2#6'Height'#2'_'#5'Align'#7#8'alClient'#9'Alignmen'
|
||||||
|
+'t'#7#8'taCenter'#10'Appearance'#7#8'apCustom'#7'Caption'#6#14'Orpheus Label'
|
||||||
|
+'s'#11'ColorScheme'#7#8'csCustom'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10
|
||||||
|
+'Font.Color'#7#6'clGray'#11'Font.Height'#2#229#10'Font.Style'#11#0#10'Parent'
|
||||||
|
+'Font'#8#0#0#0#7'TButton'#7'Button1'#4'Left'#3#162#1#3'Top'#3#171#1#5'Width'
|
||||||
|
+#2'K'#6'Height'#2#25#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#8'T'
|
||||||
|
+'abOrder'#2#4#0#0#7'TButton'#7'Button2'#4'Left'#3#244#1#3'Top'#3#171#1#5'Wid'
|
||||||
|
+'th'#2'K'#6'Height'#2#25#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2
|
||||||
|
+#2#8'TabOrder'#2#5#0#0#6'TPanel'#6'Panel2'#4'Left'#2#0#3'Top'#3'l'#1#5'Width'
|
||||||
|
+#3#137#1#6'Height'#2'['#8'TabOrder'#2#3#0#6'TLabel'#6'Label1'#4'Left'#2#4#3
|
||||||
|
+'Top'#2#4#5'Width'#2'9'#6'Height'#2#13#7'Caption'#6#11'Style Name:'#0#0#6'TL'
|
||||||
|
+'abel'#6'Label2'#4'Left'#3#0#1#3'Top'#2#5#5'Width'#2'='#6'Height'#2#13#7'Cap'
|
||||||
|
+'tion'#6#11'Appearance:'#0#0#6'TLabel'#6'Label3'#4'Left'#3#0#1#3'Top'#2'0'#5
|
||||||
|
+'Width'#2'E'#6'Height'#2#13#7'Caption'#6#13'Color Scheme:'#0#0#9'TComboBox'#8
|
||||||
|
+'SchemeCb'#4'Left'#2#4#3'Top'#2#20#5'Width'#3#233#0#6'Height'#2#21#5'Style'#7
|
||||||
|
+#14'csDropDownList'#10'ItemHeight'#2#13#13'Items.Strings'#1#6#3'one'#6#3'two'
|
||||||
|
+#0#9'MaxLength'#3#255#0#6'Sorted'#9#8'TabOrder'#2#0#8'OnChange'#7#14'SchemeC'
|
||||||
|
+'bChange'#0#0#7'TButton'#9'SaveAsBtn'#4'Left'#2#4#3'Top'#2'7'#5'Width'#2'K'#6
|
||||||
|
+'Height'#2#25#7'Caption'#6#11'Save &As...'#8'TabOrder'#2#1#7'OnClick'#7#14'S'
|
||||||
|
+'aveAsBtnClick'#0#0#7'TButton'#9'DeleteBtn'#4'Left'#3#161#0#3'Top'#2'7'#5'Wi'
|
||||||
|
+'dth'#2'K'#6'Height'#2#25#7'Caption'#6#7'&Delete'#8'TabOrder'#2#2#7'OnClick'
|
||||||
|
+#7#14'DeleteBtnClick'#0#0#9'TComboBox'#12'AppearanceCb'#4'Left'#3#0#1#3'Top'
|
||||||
|
+#2#20#5'Width'#2'~'#6'Height'#2#21#10'ItemHeight'#2#13#8'TabOrder'#2#3#8'OnC'
|
||||||
|
+'hange'#7#18'AppearanceCbChange'#0#0#9'TComboBox'#13'ColorSchemeCb'#4'Left'#3
|
||||||
|
+#0#1#3'Top'#2'>'#5'Width'#2'~'#6'Height'#2#21#10'ItemHeight'#2#13#8'TabOrder'
|
||||||
|
+#2#4#8'OnChange'#7#19'ColorSchemeCbChange'#0#0#0#6'TPanel'#6'Panel3'#4'Left'
|
||||||
|
+#2#0#3'Top'#2'a'#5'Width'#3'A'#2#6'Height'#3#189#0#8'TabOrder'#2#1#0#6'TLabe'
|
||||||
|
+'l'#6'Label4'#4'Left'#3#152#0#3'Top'#2'S'#5'Width'#2'F'#6'Height'#2#13#7'Cap'
|
||||||
|
+'tion'#6#15'Gradient Color:'#0#0#6'TLabel'#6'Label5'#4'Left'#3'&'#1#3'Top'#2
|
||||||
|
+'S'#5'Width'#2'G'#6'Height'#2#13#7'Caption'#6#16'Highlight Color:'#0#0#6'TLa'
|
||||||
|
+'bel'#6'Label6'#4'Left'#3#181#1#3'Top'#2'S'#5'Width'#2'E'#6'Height'#2#13#7'C'
|
||||||
|
+'aption'#6#13'Shadow Color:'#0#0#6'TLabel'#21'HighlightDirectionLbl'#4'Left'
|
||||||
|
+#3'0'#1#3'Top'#3#128#0#5'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8#7'Caption'
|
||||||
|
+#6#20'Highlight Direction:'#8'WordWrap'#9#0#0#6'TLabel'#18'ShadowDirectionLb'
|
||||||
|
+'l'#4'Left'#3#191#1#3'Top'#3#128#0#5'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8
|
||||||
|
+#7'Caption'#6#17'Shadow Direction:'#8'WordWrap'#9#0#0#6'TLabel'#6'Label7'#4
|
||||||
|
+'Left'#2#8#3'Top'#2'A'#5'Width'#2'5'#6'Height'#2#13#7'Caption'#6#11'Text Col'
|
||||||
|
+'or/'#0#0#6'TLabel'#6'Label8'#4'Left'#2#8#3'Top'#2'N'#5'Width'#2'V'#6'Height'
|
||||||
|
+#2#13#7'Caption'#6#18'Gradient To Color:'#0#0#11'TRadioGroup'#10'GraduateRg'
|
||||||
|
+#4'Left'#3#150#0#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6#20
|
||||||
|
+'Text &Gradient Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#4'None'#6#10'H'
|
||||||
|
+'orizontal'#6#8'Vertical'#0#7'OnClick'#7#15'GraduateRgClick'#0#0#11'TRadioGr'
|
||||||
|
+'oup'#8'ShadowRg'#4'Left'#3#180#1#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'
|
||||||
|
+#7'Caption'#6#13'&Shadow Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Pla'
|
||||||
|
+'in'#6#7'Extrude'#6#8'Graduate'#0#7'OnClick'#7#13'ShadowRgClick'#0#0#11'TRad'
|
||||||
|
+'ioGroup'#11'HighlightRg'#4'Left'#3'%'#1#3'Top'#2#3#5'Width'#3#137#0#6'Heigh'
|
||||||
|
+'t'#2'I'#7'Caption'#6#16'&Highlight Style'#9'ItemIndex'#2#0#13'Items.Strings'
|
||||||
|
+#1#6#5'Plain'#6#7'Extrude'#6#8'Graduate'#0#7'OnClick'#7#16'HighlightRgClick'
|
||||||
|
+#0#0#17'TOvcColorComboBox'#12'FromColorCcb'#4'Left'#3#151#0#3'Top'#2'c'#5'Wi'
|
||||||
|
+'dth'#3#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBla'
|
||||||
|
+'ck'#8'TabOrder'#2#4#4'Text'#6#5'Black'#8'OnChange'#7#18'FromColorCcbChange'
|
||||||
|
+#0#0#17'TOvcColorComboBox'#17'HighlightColorCcb'#4'Left'#3'%'#1#3'Top'#2'c'#5
|
||||||
|
+'Width'#3#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clB'
|
||||||
|
+'lack'#8'TabOrder'#2#5#4'Text'#6#5'Black'#8'OnChange'#7#23'HighlightColorCcb'
|
||||||
|
+'Change'#0#0#17'TOvcColorComboBox'#14'ShadowColorCcb'#4'Left'#3#180#1#3'Top'
|
||||||
|
,#2'c'#5'Width'#3#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7
|
||||||
|
+#7'clBlack'#8'TabOrder'#2#6#4'Text'#6#5'Black'#8'OnChange'#7#20'ShadowColorC'
|
||||||
|
+'cbChange'#0#0#17'TOvcColorComboBox'#12'FontColorCcb'#4'Left'#2#7#3'Top'#2'c'
|
||||||
|
+#5'Width'#3#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'c'
|
||||||
|
+'lBlack'#8'TabOrder'#2#0#4'Text'#6#5'Black'#8'OnChange'#7#18'FontColorCcbCha'
|
||||||
|
+'nge'#0#0#0#6'TPanel'#6'Panel4'#4'Left'#2#0#3'Top'#3#30#1#5'Width'#3'A'#2#6
|
||||||
|
+'Height'#2'N'#8'TabOrder'#2#2#0#6'TLabel'#6'Label9'#4'Left'#2#20#3'Top'#2#8#5
|
||||||
|
+'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7
|
||||||
|
+'Caption'#6#11'Font Size: '#0#0#6'TLabel'#11'FontSizeLbl'#4'Left'#3#244#1#3
|
||||||
|
+'Top'#2#8#5'Width'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#17'Hig'
|
||||||
|
+'hlightDepthLbl'#4'Left'#3#244#1#3'Top'#2' '#5'Width'#2#6#6'Height'#2#13#7'C'
|
||||||
|
+'aption'#6#1'0'#0#0#6'TLabel'#14'ShadowDepthLbl'#4'Left'#3#244#1#3'Top'#2'8'
|
||||||
|
+#5'Width'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#7'Label10'#4'Le'
|
||||||
|
+'ft'#2#20#3'Top'#2' '#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRight'
|
||||||
|
+'Justify'#8'AutoSize'#8#7'Caption'#6#17'Highlight Depth: '#0#0#6'TLabel'#7'L'
|
||||||
|
+'abel11'#4'Left'#2#20#3'Top'#2'8'#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7
|
||||||
|
+#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#14'Shadow Depth: '#0#0#10'TSc'
|
||||||
|
+'rollBar'#10'FontSizeSb'#4'Left'#3#132#0#3'Top'#2#8#5'Width'#3'e'#1#6'Height'
|
||||||
|
+#2#14#8'TabOrder'#2#0#8'OnChange'#7#16'FontSizeSbChange'#0#0#10'TScrollBar'
|
||||||
|
+#13'ShadowDepthSb'#4'Left'#3#132#0#3'Top'#2'8'#5'Width'#3'e'#1#6'Height'#2#14
|
||||||
|
+#3'Max'#2'2'#8'TabOrder'#2#2#8'OnChange'#7#19'ShadowDepthSbChange'#0#0#10'TS'
|
||||||
|
+'crollBar'#16'HighlightDepthSb'#4'Left'#3#132#0#3'Top'#2' '#5'Width'#3'e'#1#6
|
||||||
|
+'Height'#2#14#3'Max'#2'2'#8'TabOrder'#2#1#8'OnChange'#7#22'HighlightDepthSbC'
|
||||||
|
+'hange'#0#0#0#14'TOvcController'#14'OvcController1'#23'EntryCommands.TableLi'
|
||||||
|
+'st'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1#0#0#5'Epoch'#3'l'
|
||||||
|
+#7#0#0#0
|
||||||
|
]);
|
||||||
610
components/orpheus/ovclbl0.pas
Normal file
610
components/orpheus/ovclbl0.pas
Normal file
@ -0,0 +1,610 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCLBL0.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovclbl0;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, Buttons, {$ENDIF}
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms,
|
||||||
|
Dialogs, StdCtrls, ExtCtrls,
|
||||||
|
{$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
|
||||||
|
Menus, IniFiles, OvcLbl2, TypInfo, OvcCmbx, OvcClrCb, OvcLabel, OvcBase,
|
||||||
|
OvcData;
|
||||||
|
|
||||||
|
type
|
||||||
|
TfrmOvcLabel = class(TForm)
|
||||||
|
Panel1: TPanel;
|
||||||
|
OvcLabel: TOvcLabel;
|
||||||
|
Button1: TButton;
|
||||||
|
Button2: TButton;
|
||||||
|
Panel2: TPanel;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
SchemeCb: TComboBox;
|
||||||
|
SaveAsBtn: TButton;
|
||||||
|
DeleteBtn: TButton;
|
||||||
|
Panel3: TPanel;
|
||||||
|
Label4: TLabel;
|
||||||
|
Label5: TLabel;
|
||||||
|
Label6: TLabel;
|
||||||
|
Label7: TLabel;
|
||||||
|
Label8: TLabel;
|
||||||
|
GraduateRg: TRadioGroup;
|
||||||
|
ShadowRg: TRadioGroup;
|
||||||
|
HighlightRg: TRadioGroup;
|
||||||
|
FromColorCcb: TOvcColorComboBox;
|
||||||
|
HighlightColorCcb: TOvcColorComboBox;
|
||||||
|
ShadowColorCcb: TOvcColorComboBox;
|
||||||
|
HighlightDirectionLbl: TLabel;
|
||||||
|
ShadowDirectionLbl: TLabel;
|
||||||
|
FontColorCcb: TOvcColorComboBox;
|
||||||
|
Panel4: TPanel;
|
||||||
|
Label9: TLabel;
|
||||||
|
Label10: TLabel;
|
||||||
|
Label11: TLabel;
|
||||||
|
FontSizeSb: TScrollBar;
|
||||||
|
FontSizeLbl: TLabel;
|
||||||
|
HighlightDepthLbl: TLabel;
|
||||||
|
ShadowDepthLbl: TLabel;
|
||||||
|
ShadowDepthSb: TScrollBar;
|
||||||
|
HighlightDepthSb: TScrollBar;
|
||||||
|
AppearanceCb: TComboBox;
|
||||||
|
ColorSchemeCb: TComboBox;
|
||||||
|
OvcController1: TOvcController;
|
||||||
|
procedure FontSizeSbChange(Sender: TObject);
|
||||||
|
procedure HighlightDepthSbChange(Sender: TObject);
|
||||||
|
procedure ShadowDepthSbChange(Sender: TObject);
|
||||||
|
procedure GraduateRgClick(Sender: TObject);
|
||||||
|
procedure HighlightRgClick(Sender: TObject);
|
||||||
|
procedure ShadowRgClick(Sender: TObject);
|
||||||
|
procedure FromColorCcbChange(Sender: TObject);
|
||||||
|
procedure HighlightColorCcbChange(Sender: TObject);
|
||||||
|
procedure ShadowColorCcbChange(Sender: TObject);
|
||||||
|
procedure FontColorCcbChange(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure SaveAsBtnClick(Sender: TObject);
|
||||||
|
procedure DeleteBtnClick(Sender: TObject);
|
||||||
|
procedure SchemeCbChange(Sender: TObject);
|
||||||
|
procedure AppearanceCbChange(Sender: TObject);
|
||||||
|
procedure ColorSchemeCbChange(Sender: TObject);
|
||||||
|
private
|
||||||
|
public
|
||||||
|
HighlightDirectionDp : TOvcDirectionPicker;
|
||||||
|
ShadowDirectionDp : TOvcDirectionPicker;
|
||||||
|
SettingScheme : Boolean;
|
||||||
|
SettingCb : Boolean;
|
||||||
|
|
||||||
|
procedure DeleteScheme(const S : string);
|
||||||
|
procedure HighlightDirectionChange(Sender: TObject);
|
||||||
|
procedure ShadowDirectionChange(Sender: TObject);
|
||||||
|
procedure SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
{component editor for the notebook pages}
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
TOvcLabelEditor = class(TDefaultEditor)
|
||||||
|
{$ELSE}
|
||||||
|
TOvcLabelEditor = class(TDefaultComponentEditor)
|
||||||
|
{$ENDIF}
|
||||||
|
public
|
||||||
|
procedure ExecuteVerb(Index : Integer);
|
||||||
|
override;
|
||||||
|
function GetVerb(Index : Integer) : AnsiString;
|
||||||
|
override;
|
||||||
|
function GetVerbCount : Integer;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{property editor for the special settings class}
|
||||||
|
TOvcCustomSettingsProperty = class(TClassProperty)
|
||||||
|
public
|
||||||
|
procedure Edit;
|
||||||
|
override;
|
||||||
|
function GetAttributes : TPropertyAttributes;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EditOvcLabel(L : TOvcLabel) : Boolean;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
OvcLbl1;
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{$R *.DFM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
const
|
||||||
|
IniFileName = 'orpheus.ini';
|
||||||
|
// Note: Location of this file needs to consider platform differences.
|
||||||
|
// Currently creates it in Lazarus folder (Windows) or root folder (OS X).
|
||||||
|
|
||||||
|
function EditOvcLabel(L : TOvcLabel) : Boolean;
|
||||||
|
var
|
||||||
|
D : TfrmOvcLabel;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
D := TfrmOvcLabel.Create(Application);
|
||||||
|
try
|
||||||
|
D.OvcLabel.Font.Assign(L.Font);
|
||||||
|
D.OvcLabel.CustomSettings.Assign(L.CustomSettings);
|
||||||
|
|
||||||
|
D.FontSizeSb.Position := L.Font.Size;
|
||||||
|
D.HighlightDepthSB.Position := L.CustomSettings.HighlightDepth;
|
||||||
|
D.ShadowDepthSB.Position := L.CustomSettings.ShadowDepth;
|
||||||
|
|
||||||
|
D.GraduateRg.ItemIndex := Ord(L.CustomSettings.GraduateStyle);
|
||||||
|
D.HighlightRg.ItemIndex := Ord(L.CustomSettings.HighlightStyle);
|
||||||
|
D.ShadowRg.ItemIndex := Ord(L.CustomSettings.ShadowStyle);
|
||||||
|
|
||||||
|
D.FontColorCcb.SelectedColor := L.Font.Color;
|
||||||
|
D.FromColorCcb.SelectedColor := L.CustomSettings.GraduateFromColor;
|
||||||
|
D.HighlightColorCcb.SelectedColor := L.CustomSettings.HighlightColor;
|
||||||
|
D.ShadowColorCcb.SelectedColor := L.CustomSettings.ShadowColor;
|
||||||
|
|
||||||
|
D.HighlightDirectionDp.Direction := Ord(L.CustomSettings.HighlightDirection)-1;
|
||||||
|
D.ShadowDirectionDp.Direction := Ord(L.CustomSettings.ShadowDirection)-1;
|
||||||
|
|
||||||
|
if D.ShowModal = mrOK then begin
|
||||||
|
L.CustomSettings.BeginUpdate;
|
||||||
|
try
|
||||||
|
L.Font.Assign(D.OvcLabel.Font);
|
||||||
|
L.CustomSettings.Assign(D.OvcLabel.CustomSettings);
|
||||||
|
finally
|
||||||
|
L.CustomSettings.EndUpdate;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
D.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcLabelEditor ***}
|
||||||
|
|
||||||
|
procedure TOvcLabelEditor.ExecuteVerb(Index : Integer);
|
||||||
|
begin
|
||||||
|
if EditOvcLabel(TOvcLabel(Component)) then
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Designer.Modified;
|
||||||
|
{$ELSE}
|
||||||
|
Modified;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcLabelEditor.GetVerb(Index : Integer) : AnsiString;
|
||||||
|
begin
|
||||||
|
Result := 'Style Manager...';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcLabelEditor.GetVerbCount : Integer;
|
||||||
|
begin
|
||||||
|
Result := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcCustomSettingsProperty ***}
|
||||||
|
|
||||||
|
procedure TOvcCustomSettingsProperty.Edit;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
C : TComponent;
|
||||||
|
L : TOvcLabel;
|
||||||
|
M : TOvcLabel;
|
||||||
|
begin
|
||||||
|
C := TComponent(GetComponent(0));
|
||||||
|
if C is TOvcCustomLabel then begin
|
||||||
|
L := TOvcLabel(C);
|
||||||
|
if EditOvcLabel(L) then begin
|
||||||
|
{if more than one component selected, apply changes to others}
|
||||||
|
for I := 2 to PropCount do begin
|
||||||
|
M := TOvcLabel(GetComponent(Pred(I)));
|
||||||
|
M.CustomSettings.BeginUpdate;
|
||||||
|
try
|
||||||
|
M.Font.Assign(L.Font);
|
||||||
|
M.CustomSettings.Assign(L.CustomSettings);
|
||||||
|
finally
|
||||||
|
M.CustomSettings.EndUpdate;
|
||||||
|
end;
|
||||||
|
M.Invalidate;
|
||||||
|
end;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Designer.Modified;
|
||||||
|
{$ELSE}
|
||||||
|
Modified;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomSettingsProperty.GetAttributes: TPropertyAttributes;
|
||||||
|
begin
|
||||||
|
Result := [paSubProperties, paMultiSelect, paDialog, paReadOnly]
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*** TOvcLabelFrm ***}
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.FontSizeSbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.Font.Size := FontSizeSb.Position;
|
||||||
|
FontSizeLbl.Caption := IntToStr(OvcLabel.Font.Size);
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.HighlightDepthSbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.HighlightDepth := HighlightDepthSb.Position;
|
||||||
|
HighlightDepthLbl.Caption := IntToStr(OvcLabel.CustomSettings.HighlightDepth);
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.ShadowDepthSbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.ShadowDepth := ShadowDepthSb.Position;
|
||||||
|
ShadowDepthLbl.Caption := IntToStr(OvcLabel.CustomSettings.ShadowDepth);
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.GraduateRgClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
case GraduateRg.ItemIndex of
|
||||||
|
0 : OvcLabel.CustomSettings.GraduateStyle := gsNone;
|
||||||
|
1 : OvcLabel.CustomSettings.GraduateStyle := gsHorizontal;
|
||||||
|
2 : OvcLabel.CustomSettings.GraduateStyle := gsVertical;
|
||||||
|
end;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.HighlightRgClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
case HighlightRg.ItemIndex of
|
||||||
|
0 : OvcLabel.CustomSettings.HighlightStyle := ssPlain;
|
||||||
|
1 : OvcLabel.CustomSettings.HighlightStyle := ssExtrude;
|
||||||
|
2 : OvcLabel.CustomSettings.HighlightStyle := ssGraduated;
|
||||||
|
end;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.ShadowRgClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
case ShadowRg.ItemIndex of
|
||||||
|
0 : OvcLabel.CustomSettings.ShadowStyle := ssPlain;
|
||||||
|
1 : OvcLabel.CustomSettings.ShadowStyle := ssExtrude;
|
||||||
|
2 : OvcLabel.CustomSettings.ShadowStyle := ssGraduated;
|
||||||
|
end;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.FromColorCcbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.GraduateFromColor := FromColorCcb.SelectedColor;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.HighlightColorCcbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.HighlightColor := HighlightColorCcb.SelectedColor;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.ShadowColorCcbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.ShadowColor := ShadowColorCcb.SelectedColor;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.FontColorCcbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.Font.Color := FontColorCcb.SelectedColor;
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.FormCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
Ini : TIniFile;
|
||||||
|
A : TOvcAppearance;
|
||||||
|
C : TOvcColorScheme;
|
||||||
|
begin
|
||||||
|
Top := (Screen.Height - Height) div 3;
|
||||||
|
Left := (Screen.Width - Width) div 2;
|
||||||
|
|
||||||
|
{load scheme names into combo box}
|
||||||
|
Ini := TIniFile.Create(IniFileName);
|
||||||
|
try
|
||||||
|
SchemeCb.Items.Clear;
|
||||||
|
Ini.ReadSection('Schemes', SchemeCb.Items);
|
||||||
|
finally
|
||||||
|
Ini.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{create direction pickers}
|
||||||
|
HighlightDirectionDp := TOvcDirectionPicker.Create(Self);
|
||||||
|
HighlightDirectionDp.Top := HighlightDirectionLbl.Top;
|
||||||
|
HighlightDirectionDp.Left := HighlightDirectionLbl.Left + HighlightDirectionLbl.Width;
|
||||||
|
HighlightDirectionDp.Width := 50;
|
||||||
|
HighlightDirectionDp.Height := 50;
|
||||||
|
HighlightDirectionDp.NumDirections := 8;
|
||||||
|
HighlightDirectionDp.OnChange := HighlightDirectionChange;
|
||||||
|
HighlightDirectionDp.Parent := HighlightDirectionLbl.Parent;
|
||||||
|
HighlightDirectionDp.Visible := True;
|
||||||
|
|
||||||
|
ShadowDirectionDp := TOvcDirectionPicker.Create(Self);
|
||||||
|
ShadowDirectionDp.Top := ShadowDirectionLbl.Top;
|
||||||
|
ShadowDirectionDp.Left := ShadowDirectionLbl.Left + ShadowDirectionLbl.Width;
|
||||||
|
ShadowDirectionDp.Width := 50;
|
||||||
|
ShadowDirectionDp.Height := 50;
|
||||||
|
ShadowDirectionDp.NumDirections := 8;
|
||||||
|
ShadowDirectionDp.OnChange := ShadowDirectionChange;
|
||||||
|
ShadowDirectionDp.Parent := ShadowDirectionLbl.Parent;
|
||||||
|
ShadowDirectionDp.Visible := True;
|
||||||
|
|
||||||
|
{initialize appearance and color scheme ComboBoxes using rtti}
|
||||||
|
for A := Low(TOvcAppearance) to High(TOvcAppearance) do
|
||||||
|
AppearanceCb.Items.Add(GetEnumName(TypeInfo(TOvcAppearance), Ord(A)));
|
||||||
|
for C := Low(TOvcColorScheme) to High(TOvcColorScheme) do
|
||||||
|
ColorSchemeCb.Items.Add(GetEnumName(TypeInfo(TOvcColorScheme), Ord(C)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.SaveAsBtnClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
Ini : TIniFile;
|
||||||
|
S : string;
|
||||||
|
begin
|
||||||
|
with TfrmSaveScheme.Create(Self) do begin
|
||||||
|
if (ShowModal = mrOK) and (SchemeNameEd.Text > '') then begin
|
||||||
|
S := SchemeNameEd.Text;
|
||||||
|
Ini := TIniFile.Create(IniFileName);
|
||||||
|
try
|
||||||
|
{delete scheme}
|
||||||
|
DeleteScheme(S);
|
||||||
|
|
||||||
|
{add scheme name to list of schemes}
|
||||||
|
Ini.WriteInteger('Schemes', S, 0);
|
||||||
|
|
||||||
|
{create new scheme section and add values}
|
||||||
|
Ini.WriteInteger(S, 'GraduateStyle', Ord(OvcLabel.CustomSettings.GraduateStyle));
|
||||||
|
Ini.WriteInteger(S, 'HighlightStyle', Ord(OvcLabel.CustomSettings.HighlightStyle));
|
||||||
|
Ini.WriteInteger(S, 'ShadowStyle', Ord(OvcLabel.CustomSettings.ShadowStyle));
|
||||||
|
Ini.WriteString(S, 'GraduateFromColor', ColorToString(OvcLabel.CustomSettings.GraduateFromColor));
|
||||||
|
Ini.WriteString(S, 'HighlightColor', ColorToString(OvcLabel.CustomSettings.HighlightColor));
|
||||||
|
Ini.WriteString(S, 'ShadowColor', ColorToString(OvcLabel.CustomSettings.ShadowColor));
|
||||||
|
Ini.WriteInteger(S, 'HighlightDirection', Ord(OvcLabel.CustomSettings.HighlightDirection));
|
||||||
|
Ini.WriteInteger(S, 'ShadowDirection', Ord(OvcLabel.CustomSettings.ShadowDirection));
|
||||||
|
Ini.WriteString(S, 'FontColor', ColorToString(OvcLabel.Font.Color));
|
||||||
|
Ini.WriteString(S, 'FontName', OvcLabel.Font.Name);
|
||||||
|
Ini.WriteInteger(S, 'FontPitch', Ord(OvcLabel.Font.Pitch));
|
||||||
|
Ini.WriteInteger(S, 'FontSize', OvcLabel.Font.Size);
|
||||||
|
Ini.WriteBool(S, 'FontBold', fsBold in OvcLabel.Font.Style);
|
||||||
|
Ini.WriteBool(S, 'FontItalic', fsItalic in OvcLabel.Font.Style);
|
||||||
|
Ini.WriteBool(S, 'FontUnderline', fsUnderline in OvcLabel.Font.Style);
|
||||||
|
Ini.WriteBool(S, 'FontStrikeOut', fsStrikeOut in OvcLabel.Font.Style);
|
||||||
|
Ini.WriteInteger(S, 'HighlightDepth', OvcLabel.CustomSettings.HighlightDepth);
|
||||||
|
Ini.WriteInteger(S, 'ShadowDepth', OvcLabel.CustomSettings.ShadowDepth);
|
||||||
|
finally
|
||||||
|
Ini.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{add item to the ComboBox, if its not there already}
|
||||||
|
if SchemeCb.Items.IndexOf(S) < 0 then
|
||||||
|
SchemeCb.Items.Add(S);
|
||||||
|
end;
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.DeleteBtnClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
begin
|
||||||
|
I := SchemeCb.ItemIndex;
|
||||||
|
if I > -1 then begin
|
||||||
|
DeleteScheme(SchemeCb.Items[I]);
|
||||||
|
{delete the entry from the combo box}
|
||||||
|
SchemeCb.Items.Delete(I);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.DeleteScheme(const S : string);
|
||||||
|
var
|
||||||
|
Ini : TIniFile;
|
||||||
|
begin
|
||||||
|
{delete the scheme entry from the ini file}
|
||||||
|
Ini := TIniFile.Create(IniFileName);
|
||||||
|
try
|
||||||
|
{delete the section}
|
||||||
|
Ini.EraseSection(S);
|
||||||
|
{delete the scheme name}
|
||||||
|
Ini.DeleteKey('Schemes', S);
|
||||||
|
finally
|
||||||
|
Ini.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.SchemeCbChange(Sender: TObject);
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
Ini : TIniFile;
|
||||||
|
S : string;
|
||||||
|
begin
|
||||||
|
I := SchemeCb.ItemIndex;
|
||||||
|
if I > -1 then begin
|
||||||
|
S := SchemeCb.Items[I];
|
||||||
|
Ini := TIniFile.Create(IniFileName);
|
||||||
|
SettingScheme := True;
|
||||||
|
try
|
||||||
|
OvcLabel.CustomSettings.GraduateStyle := TOvcGraduateStyle(Ini.ReadInteger(S, 'GraduateStyle', 0));
|
||||||
|
OvcLabel.CustomSettings.HighlightStyle := TOvcShadeStyle(Ini.ReadInteger(S, 'HighlightStyle', 0));
|
||||||
|
OvcLabel.CustomSettings.ShadowStyle := TOvcShadeStyle(Ini.ReadInteger(S, 'ShadowStyle', 0));
|
||||||
|
OvcLabel.CustomSettings.GraduateFromColor := StringToColor(Ini.ReadString(S, 'GraduateFromColor', '0'));
|
||||||
|
OvcLabel.CustomSettings.HighlightColor := StringToColor(Ini.ReadString(S, 'HighlightColor', '0'));
|
||||||
|
OvcLabel.CustomSettings.ShadowColor := StringToColor(Ini.ReadString(S, 'ShadowColor', '0'));
|
||||||
|
OvcLabel.CustomSettings.HighlightDirection := TOvcShadeDirection(Ini.ReadInteger(S, 'HighlightDirection', 0));
|
||||||
|
OvcLabel.CustomSettings.ShadowDirection := TOvcShadeDirection(Ini.ReadInteger(S, 'ShadowDirection', 0));
|
||||||
|
OvcLabel.CustomSettings.HighlightDepth := Ini.ReadInteger(S, 'HighlightDepth', 1);
|
||||||
|
OvcLabel.CustomSettings.ShadowDepth := Ini.ReadInteger(S, 'ShadowDepth', 1);
|
||||||
|
|
||||||
|
OvcLabel.Font.Color := StringToColor(Ini.ReadString(S, 'FontColor', '0'));
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
OvcLabel.Font.Name := Ini.ReadString(S, 'FontName', 'Times New Roman');
|
||||||
|
{$ELSE}
|
||||||
|
OvcLabel.Font.Name := Ini.ReadString(S, 'FontName', 'default');
|
||||||
|
{$ENDIF}
|
||||||
|
OvcLabel.Font.Pitch := TFontPitch(Ini.ReadInteger(S, 'FontPitch', 0));
|
||||||
|
OvcLabel.Font.Size := Ini.ReadInteger(S, 'FontSize', 10);
|
||||||
|
OvcLabel.Font.Style := [];
|
||||||
|
if Ini.ReadBool(S, 'FontBold', False) then
|
||||||
|
OvcLabel.Font.Style := OvcLabel.Font.Style + [fsBold];
|
||||||
|
if Ini.ReadBool(S, 'FontItalic', False) then
|
||||||
|
OvcLabel.Font.Style := OvcLabel.Font.Style + [fsItalic];
|
||||||
|
if Ini.ReadBool(S, 'FontUnderline', False) then
|
||||||
|
OvcLabel.Font.Style := OvcLabel.Font.Style + [fsUnderline];
|
||||||
|
if Ini.ReadBool(S, 'FontStrikeOut', False) then
|
||||||
|
OvcLabel.Font.Style := OvcLabel.Font.Style + [fsStrikeOut];
|
||||||
|
|
||||||
|
FontSizeSb.Position := OvcLabel.Font.Size;
|
||||||
|
HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
|
||||||
|
ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
|
||||||
|
GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
|
||||||
|
HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
|
||||||
|
ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
|
||||||
|
FontColorCcb.SelectedColor := OvcLabel.Font.Color;
|
||||||
|
FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
|
||||||
|
HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
|
||||||
|
ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
|
||||||
|
HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
|
||||||
|
ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
|
||||||
|
finally
|
||||||
|
SettingScheme := False;
|
||||||
|
Ini.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.HighlightDirectionChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.HighlightDirection :=
|
||||||
|
TOvcShadeDirection(HighlightDirectionDp.Direction+1);
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.ShadowDirectionChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
OvcLabel.CustomSettings.ShadowDirection :=
|
||||||
|
TOvcShadeDirection(ShadowDirectionDp.Direction+1);
|
||||||
|
SchemeChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.SchemeChange;
|
||||||
|
begin
|
||||||
|
if not SettingScheme then
|
||||||
|
SchemeCb.ItemIndex := -1;
|
||||||
|
|
||||||
|
if not SettingCb then begin
|
||||||
|
AppearanceCb.ItemIndex := -1;
|
||||||
|
ColorSchemeCb.ItemIndex := -1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.AppearanceCbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if AppearanceCb.ItemIndex > -1 then begin
|
||||||
|
SettingScheme := True;
|
||||||
|
SettingCb := True;
|
||||||
|
try
|
||||||
|
OvcLabel.Appearance := TOvcAppearance(AppearanceCb.ItemIndex);
|
||||||
|
|
||||||
|
FontSizeSb.Position := OvcLabel.Font.Size;
|
||||||
|
HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
|
||||||
|
ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
|
||||||
|
GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
|
||||||
|
HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
|
||||||
|
ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
|
||||||
|
FontColorCcb.SelectedColor := OvcLabel.Font.Color;
|
||||||
|
FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
|
||||||
|
HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
|
||||||
|
ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
|
||||||
|
HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
|
||||||
|
ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
|
||||||
|
finally
|
||||||
|
SettingCb := False;
|
||||||
|
SettingScheme := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmOvcLabel.ColorSchemeCbChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if ColorSchemeCb.ItemIndex > -1 then begin
|
||||||
|
SettingScheme := True;
|
||||||
|
SettingCb := True;
|
||||||
|
try
|
||||||
|
OvcLabel.ColorScheme := TOvcColorScheme(ColorSchemeCb.ItemIndex);
|
||||||
|
|
||||||
|
FontSizeSb.Position := OvcLabel.Font.Size;
|
||||||
|
HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
|
||||||
|
ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
|
||||||
|
GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
|
||||||
|
HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
|
||||||
|
ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
|
||||||
|
FontColorCcb.SelectedColor := OvcLabel.Font.Color;
|
||||||
|
FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
|
||||||
|
HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
|
||||||
|
ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
|
||||||
|
HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
|
||||||
|
ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
|
||||||
|
finally
|
||||||
|
SettingCb := False;
|
||||||
|
SettingScheme := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{$I ovclbl0.lrs} {Include form's resource file}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
52
components/orpheus/ovclbl1.lfm
Normal file
52
components/orpheus/ovclbl1.lfm
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
object frmSaveScheme: TfrmSaveScheme
|
||||||
|
Left = 347
|
||||||
|
Top = 298
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Save Style'
|
||||||
|
ClientHeight = 85
|
||||||
|
Height = 85
|
||||||
|
ClientWidth = 348
|
||||||
|
Width = 348
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Style = []
|
||||||
|
OnCreate = FormCreate
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 4
|
||||||
|
Top = 8
|
||||||
|
Width = 85
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Save this style as:'
|
||||||
|
end
|
||||||
|
object SchemeNameEd: TEdit
|
||||||
|
Left = 4
|
||||||
|
Top = 24
|
||||||
|
Width = 341
|
||||||
|
Height = 21
|
||||||
|
MaxLength = 255
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object OkBtn: TButton
|
||||||
|
Left = 192
|
||||||
|
Top = 56
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'OK'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object CancelBtn: TButton
|
||||||
|
Left = 272
|
||||||
|
Top = 56
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'Cancel'
|
||||||
|
ModalResult = 2
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
15
components/orpheus/ovclbl1.lrs
Normal file
15
components/orpheus/ovclbl1.lrs
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
LazarusResources.Add('TfrmSaveScheme','FORMDATA',[
|
||||||
|
'TPF0'#14'TfrmSaveScheme'#13'frmSaveScheme'#4'Left'#3'['#1#3'Top'#3'*'#1#11'B'
|
||||||
|
+'orderStyle'#7#8'bsDialog'#7'Caption'#6#10'Save Style'#12'ClientHeight'#2'U'
|
||||||
|
+#6'Height'#2'U'#11'ClientWidth'#3'\'#1#5'Width'#3'\'#1#12'Font.Charset'#7#15
|
||||||
|
+'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
|
||||||
|
+'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#10'Tex'
|
||||||
|
+'tHeight'#2#13#0#6'TLabel'#6'Label1'#4'Left'#2#4#3'Top'#2#8#5'Width'#2'U'#6
|
||||||
|
+'Height'#2#13#7'Caption'#6#19'Save this style as:'#0#0#5'TEdit'#12'SchemeNam'
|
||||||
|
+'eEd'#4'Left'#2#4#3'Top'#2#24#5'Width'#3'U'#1#6'Height'#2#21#9'MaxLength'#3
|
||||||
|
+#255#0#8'TabOrder'#2#0#0#0#7'TButton'#5'OkBtn'#4'Left'#3#192#0#3'Top'#2'8'#5
|
||||||
|
+'Width'#2'K'#6'Height'#2#25#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2
|
||||||
|
+#1#8'TabOrder'#2#1#0#0#7'TButton'#9'CancelBtn'#4'Left'#3#16#1#3'Top'#2'8'#5
|
||||||
|
+'Width'#2'K'#6'Height'#2#25#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResul'
|
||||||
|
+'t'#2#2#8'TabOrder'#2#2#0#0#0
|
||||||
|
]);
|
||||||
77
components/orpheus/ovclbl1.pas
Normal file
77
components/orpheus/ovclbl1.pas
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCLBL1.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovclbl1;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, Buttons, {$ENDIF}
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
StdCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TfrmSaveScheme = class(TForm)
|
||||||
|
Label1: TLabel;
|
||||||
|
SchemeNameEd: TEdit;
|
||||||
|
OkBtn: TButton;
|
||||||
|
CancelBtn: TButton;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
{$R *.DFM}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
procedure TfrmSaveScheme.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Top := (Screen.Height - Height) div 3;
|
||||||
|
Left := (Screen.Width - Width) div 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{$I ovclbl1.lrs} {Include form's resource file}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
end.
|
||||||
290
components/orpheus/ovclbl2.pas
Normal file
290
components/orpheus/ovclbl2.pas
Normal file
@ -0,0 +1,290 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCLABEL.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovclbl2;
|
||||||
|
{-direction picker component}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
|
||||||
|
Classes, Controls, Graphics, OvcBase, OvcData, OvcMisc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomDirectionPicker = class(TOvcGraphicControl)
|
||||||
|
protected {private}
|
||||||
|
{property variables}
|
||||||
|
FDirection : Integer;
|
||||||
|
FNumDirections : Integer;
|
||||||
|
FSelectedBitmap : TBitmap;
|
||||||
|
FShowCenter : Boolean;
|
||||||
|
FDirectionBitmap : TBitmap;
|
||||||
|
|
||||||
|
{event variables}
|
||||||
|
FOnChange : TNotifyEvent;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
procedure SetDirection(Value : Integer);
|
||||||
|
procedure SetSelectedBitmap(Value : TBitmap);
|
||||||
|
procedure SetNumDirections(Value : Integer);
|
||||||
|
procedure SetShowCenter(Value : Boolean);
|
||||||
|
procedure SetDirectionBitmap(Value : TBitmap);
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||||
|
override;
|
||||||
|
procedure Paint;
|
||||||
|
override;
|
||||||
|
|
||||||
|
property Direction : Integer
|
||||||
|
read FDirection write SetDirection default 0;
|
||||||
|
property NumDirections : Integer
|
||||||
|
read FNumDirections write SetNumDirections default 8;
|
||||||
|
property SelectedBitmap : TBitmap
|
||||||
|
read FSelectedBitmap write SetSelectedBitmap;
|
||||||
|
property ShowCenter : Boolean
|
||||||
|
read FShowCenter write SetShowCenter default True;
|
||||||
|
property DirectionBitmap : TBitmap
|
||||||
|
read FDirectionBitmap write SetDirectionBitmap;
|
||||||
|
|
||||||
|
property OnChange : TNotifyEvent
|
||||||
|
read FOnChange write FOnChange;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(AComponent : TComponent);
|
||||||
|
override;
|
||||||
|
destructor Destroy;
|
||||||
|
override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcDirectionPicker = class(TOvcCustomDirectionPicker)
|
||||||
|
published
|
||||||
|
property Direction;
|
||||||
|
property Enabled;
|
||||||
|
property SelectedBitmap;
|
||||||
|
property NumDirections;
|
||||||
|
property ShowCenter;
|
||||||
|
property DirectionBitmap;
|
||||||
|
|
||||||
|
property OnChange;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
DToR = Pi / 180;
|
||||||
|
|
||||||
|
constructor TOvcCustomDirectionPicker.Create(AComponent : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AComponent);
|
||||||
|
|
||||||
|
ControlStyle := [csClickEvents, csDoubleClicks];
|
||||||
|
|
||||||
|
Width := 50;
|
||||||
|
Height := 50;
|
||||||
|
|
||||||
|
FDirection := -1;
|
||||||
|
FNumDirections := 8;
|
||||||
|
FShowCenter := True;
|
||||||
|
|
||||||
|
{create and load the bitmap images}
|
||||||
|
{resource are in ovcreg.rc}
|
||||||
|
FDirectionBitmap := TBitmap.Create;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
FDirectionBitmap.Handle := LoadBitmap(HInstance, 'ORBLUEDOT');
|
||||||
|
{$ELSE}
|
||||||
|
FDirectionBitmap.LoadFromLazarusResource('ORBLUEDOT');
|
||||||
|
{$ENDIF}
|
||||||
|
FSelectedBitmap := TBitmap.Create;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
FSelectedBitmap.Handle := LoadBitmap(HInstance, 'ORREDDOT');
|
||||||
|
{$ELSE}
|
||||||
|
FSelectedBitmap.LoadFromLazarusResource('ORREDDOT');
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOvcCustomDirectionPicker.Destroy;
|
||||||
|
begin
|
||||||
|
{destroy bitmaps}
|
||||||
|
FDirectionBitmap.Free;
|
||||||
|
FDirectionBitmap := nil;
|
||||||
|
FSelectedBitmap.Free;
|
||||||
|
FSelectedBitmap := nil;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
BW : Integer;
|
||||||
|
Angle : Extended;
|
||||||
|
Diameter : Integer;
|
||||||
|
Radius : Integer;
|
||||||
|
X1, Y1 : Integer;
|
||||||
|
Distance : Integer;
|
||||||
|
BestDirection : Integer;
|
||||||
|
BestDistance : Integer;
|
||||||
|
begin
|
||||||
|
inherited MouseDown(Button, Shift, X, Y);
|
||||||
|
|
||||||
|
if (Button = mbLeft) and Enabled then begin
|
||||||
|
BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
|
||||||
|
Diameter := MinI(Height, Width)-2*BW;
|
||||||
|
Radius := Diameter div 2;
|
||||||
|
|
||||||
|
if FShowCenter then begin
|
||||||
|
{initialize at center (-1)}
|
||||||
|
BestDistance := Round(Sqrt(Sqr(Radius+BW-X) + Sqr(Radius+BW-Y)));
|
||||||
|
BestDirection := -1;
|
||||||
|
end else begin
|
||||||
|
BestDistance := Width*2;
|
||||||
|
BestDirection := FDirection;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for I := 0 to Pred(FNumDirections) do begin
|
||||||
|
Angle := (I * (360/FNumDirections) + 90) * DToR;
|
||||||
|
X1 := Round(Radius * (1-Cos(Angle))) + BW;
|
||||||
|
Y1 := Round(Radius * (1-Sin(Angle))) + BW;
|
||||||
|
Distance := Round(Sqrt(Sqr(X1-X) + Sqr(Y1-Y)));
|
||||||
|
if Distance < BestDistance then begin
|
||||||
|
BestDistance := Distance;
|
||||||
|
BestDirection := I;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Direction := BestDirection;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.Paint;
|
||||||
|
var
|
||||||
|
I : Integer;
|
||||||
|
BW : Integer;
|
||||||
|
BW2 : Integer;
|
||||||
|
Angle : Extended;
|
||||||
|
Diameter : Integer;
|
||||||
|
Radius : Integer;
|
||||||
|
X, Y : Integer;
|
||||||
|
begin
|
||||||
|
BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
|
||||||
|
Diameter := MinI(Height, Width)-2*BW;
|
||||||
|
Radius := Diameter div 2;
|
||||||
|
|
||||||
|
if FShowCenter then
|
||||||
|
Canvas.Draw(Radius+BW, Radius+BW, FDirectionBitmap);
|
||||||
|
for I := 0 to Pred(FNumDirections) do begin
|
||||||
|
Angle := (I * (360/FNumDirections) + 90) * DToR;
|
||||||
|
X := Round(Radius * (1-Cos(Angle)));
|
||||||
|
Y := Round(Radius * (1-Sin(Angle)));
|
||||||
|
Canvas.Draw(X+BW, Y+BW, FDirectionBitmap);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{draw the dot for the selected direction}
|
||||||
|
BW2 := (MaxI(FSelectedBitmap.Width, FSelectedBitmap.Height)-BW) div 2; {adjustment for larger bitmap}
|
||||||
|
if FDirection = -1 then begin
|
||||||
|
if FShowCenter then
|
||||||
|
Canvas.Draw(Radius+BW-BW2, Radius+BW-BW2, FSelectedBitmap)
|
||||||
|
end else begin
|
||||||
|
Angle := (FDirection * (360/FNumDirections) + 90) * DToR;
|
||||||
|
X := Round(Radius * (1-Cos(Angle)));
|
||||||
|
Y := Round(Radius * (1-Sin(Angle)));
|
||||||
|
Canvas.Draw(X+BW-BW2, Y+BW-BW2, FSelectedBitmap);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.SetDirection(Value : Integer);
|
||||||
|
begin
|
||||||
|
if csLoading in ComponentState then begin
|
||||||
|
FDirection := Value;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Value <> FDirection) and (Value >= -1) and (Value < FNumDirections) then begin
|
||||||
|
FDirection := Value;
|
||||||
|
Invalidate;
|
||||||
|
if Assigned(FOnChange) then
|
||||||
|
FOnChange(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.SetSelectedBitmap(Value : TBitmap);
|
||||||
|
begin
|
||||||
|
if Assigned(Value) then
|
||||||
|
FSelectedBitmap.Assign(Value)
|
||||||
|
else
|
||||||
|
FSelectedBitmap.ReleaseHandle;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.SetNumDirections(Value : Integer);
|
||||||
|
begin
|
||||||
|
if (Value <> FNumDirections) and (Value >= 2) then begin
|
||||||
|
FNumDirections := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.SetShowCenter(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShowCenter then begin
|
||||||
|
FShowCenter := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomDirectionPicker.SetDirectionBitmap(Value : TBitmap);
|
||||||
|
begin
|
||||||
|
if Assigned(Value) then
|
||||||
|
FDirectionBitmap.Assign(Value)
|
||||||
|
else
|
||||||
|
FDirectionBitmap.ReleaseHandle;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
if Classes.GetClass(TOvcDirectionPicker.ClassName) = nil then
|
||||||
|
Classes.RegisterClass(TOvcDirectionPicker);
|
||||||
|
end.
|
||||||
1115
components/orpheus/ovcmisc.pas
Normal file
1115
components/orpheus/ovcmisc.pas
Normal file
File diff suppressed because it is too large
Load Diff
1808
components/orpheus/ovcnf.pas
Normal file
1808
components/orpheus/ovcnf.pas
Normal file
File diff suppressed because it is too large
Load Diff
1006
components/orpheus/ovcpb.pas
Normal file
1006
components/orpheus/ovcpb.pas
Normal file
File diff suppressed because it is too large
Load Diff
1599
components/orpheus/ovcreg.lrs
Normal file
1599
components/orpheus/ovcreg.lrs
Normal file
File diff suppressed because it is too large
Load Diff
514
components/orpheus/ovcrlbl.pas
Normal file
514
components/orpheus/ovcrlbl.pas
Normal file
@ -0,0 +1,514 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCRLBL.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcrlbl;
|
||||||
|
{-Rotated label component}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
||||||
|
Classes, Controls, Graphics, SysUtils,
|
||||||
|
OvcBase, OvcMisc;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOvcCustomRotatedLabel = class(TOvcGraphicControl)
|
||||||
|
{.Z+}
|
||||||
|
protected {private}
|
||||||
|
{property instance variables}
|
||||||
|
FAlignment : TAlignment;
|
||||||
|
FAutoSize : Boolean;
|
||||||
|
FCaption : string;
|
||||||
|
FFontAngle : Integer;
|
||||||
|
FOriginX : Integer;
|
||||||
|
FOriginY : Integer;
|
||||||
|
FShadowColor : TColor; {color for text shadowing}
|
||||||
|
FShadowedText : Boolean; {true to draw shadowed text}
|
||||||
|
|
||||||
|
{internal variables}
|
||||||
|
rlBusy : Boolean;
|
||||||
|
|
||||||
|
{property methods}
|
||||||
|
function GetTransparent : Boolean;
|
||||||
|
procedure SetAlignment(Value : TAlignment);
|
||||||
|
procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
|
||||||
|
procedure SetCaption(const Value : string);
|
||||||
|
procedure SetOriginX(Value : Integer);
|
||||||
|
procedure SetOriginY(Value : Integer);
|
||||||
|
procedure SetShadowColor(const Value : TColor);
|
||||||
|
procedure SetShadowedText(Value : Boolean);
|
||||||
|
procedure SetTransparent(Value : Boolean);
|
||||||
|
procedure SetFontAngle(Value : Integer);
|
||||||
|
|
||||||
|
{internal methods}
|
||||||
|
procedure lblAdjustSize;
|
||||||
|
{-adjust horizontal and/or vertical size of control}
|
||||||
|
procedure lblDrawText(var R : TRect; Flags : Word);
|
||||||
|
{-draw the label text}
|
||||||
|
|
||||||
|
{VCL message handling methods}
|
||||||
|
procedure CMFontChanged(var Msg : TMessage);
|
||||||
|
message CM_FONTCHANGED;
|
||||||
|
procedure CMTextChanged(var Mes : TMessage);
|
||||||
|
message CM_TEXTCHANGED;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure Loaded;
|
||||||
|
override;
|
||||||
|
procedure Paint;
|
||||||
|
override;
|
||||||
|
procedure SetName(const NewName : TComponentName);
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
property Alignment : TAlignment
|
||||||
|
read FAlignment write SetAlignment;
|
||||||
|
property AutoSize : Boolean
|
||||||
|
read FAutoSize write SetAutoSize;
|
||||||
|
property Caption : string
|
||||||
|
read FCaption write SetCaption;
|
||||||
|
property FontAngle : Integer
|
||||||
|
read FFontAngle write SetFontAngle;
|
||||||
|
property OriginX : Integer
|
||||||
|
read FOriginX write SetOriginX;
|
||||||
|
property OriginY : Integer
|
||||||
|
read FOriginY write SetOriginY;
|
||||||
|
property ShadowColor : TColor
|
||||||
|
read FShadowColor write SetShadowColor;
|
||||||
|
property ShadowedText : Boolean
|
||||||
|
read FShadowedText write SetShadowedText;
|
||||||
|
property Transparent : Boolean
|
||||||
|
read GetTransparent write SetTransparent;
|
||||||
|
|
||||||
|
public
|
||||||
|
{.Z+}
|
||||||
|
constructor Create(AOwner: TComponent);
|
||||||
|
override;
|
||||||
|
{.Z-}
|
||||||
|
|
||||||
|
{public properties}
|
||||||
|
property Canvas;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOvcRotatedLabel = class(TOvcCustomRotatedLabel)
|
||||||
|
published
|
||||||
|
{$IFDEF VERSION4}
|
||||||
|
property Anchors;
|
||||||
|
property Constraints;
|
||||||
|
property DragKind;
|
||||||
|
{$ENDIF}
|
||||||
|
property Align;
|
||||||
|
property Alignment default taLeftJustify;
|
||||||
|
property AutoSize;
|
||||||
|
property Caption;
|
||||||
|
property Color;
|
||||||
|
property DragCursor;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property FontAngle default 0;
|
||||||
|
property Height default 20;
|
||||||
|
property OriginX default 0;
|
||||||
|
property OriginY default 0;
|
||||||
|
property ParentColor;
|
||||||
|
{property ParentFont;}
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShadowColor default clBtnShadow;
|
||||||
|
property ShadowedText;
|
||||||
|
property ShowHint;
|
||||||
|
property Transparent default False;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
{events}
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{*** TOvcCustomRotatedLabel ***}
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.CMFontChanged(var Msg : TMessage);
|
||||||
|
var
|
||||||
|
TM : TTextMetric;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if csLoading in ComponentState then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if FFontAngle <> 0 then begin
|
||||||
|
{check if the current font can be rotated}
|
||||||
|
Canvas.Font := Self.Font;
|
||||||
|
GetTextMetrics(Canvas.Handle, TM);
|
||||||
|
if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
|
||||||
|
{force zero font angle}
|
||||||
|
FontAngle := 0;
|
||||||
|
end;
|
||||||
|
lblAdjustSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.CMTextChanged(var Mes : TMessage);
|
||||||
|
begin
|
||||||
|
lblAdjustSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TOvcCustomRotatedLabel.Create(AOwner : TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
|
||||||
|
ControlStyle := ControlStyle + [csReplicatable, csOpaque];
|
||||||
|
|
||||||
|
{default property values}
|
||||||
|
FAlignment := taLeftJustify;
|
||||||
|
FFontAngle := 0;
|
||||||
|
FOriginX := 0;
|
||||||
|
FOriginY := 0;
|
||||||
|
FShadowColor := clBtnShadow;
|
||||||
|
FShadowedText := False;
|
||||||
|
|
||||||
|
Font.Name := 'Arial';
|
||||||
|
Height := 20;
|
||||||
|
Width := 130;
|
||||||
|
|
||||||
|
if csDesigning in ComponentState then
|
||||||
|
lblAdjustSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOvcCustomRotatedLabel.GetTransparent : Boolean;
|
||||||
|
begin
|
||||||
|
Result := not (csOpaque in ControlStyle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.lblAdjustSize;
|
||||||
|
{-adjust horizontal and/or vertical size of control}
|
||||||
|
var
|
||||||
|
R : TRect;
|
||||||
|
W, H, X, Y : Integer;
|
||||||
|
begin
|
||||||
|
if rlBusy then {avoid reentrance}
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
rlBusy := True;
|
||||||
|
try
|
||||||
|
if not (csLoading in ComponentState) and AutoSize then begin
|
||||||
|
R := ClientRect;
|
||||||
|
Canvas.Font := Font;
|
||||||
|
W := Canvas.TextWidth(Caption);
|
||||||
|
H := Canvas.TextHeight(Caption);
|
||||||
|
if FFontAngle <> 0 then begin
|
||||||
|
{adjust height and width as necessary}
|
||||||
|
{width (X) of text at new angle}
|
||||||
|
X := Round(W * Cos(FFontAngle*Pi/180));
|
||||||
|
{height (y) of text at new angle}
|
||||||
|
Y := Round(W * Sin(FFontAngle*Pi/180));
|
||||||
|
R.Bottom := Abs(Y) + 2*H;
|
||||||
|
R.Right := Abs(X) + 2*H;
|
||||||
|
if X < 0 then
|
||||||
|
FOriginX := R.Right-H
|
||||||
|
else
|
||||||
|
FOriginX := H;
|
||||||
|
if Y < 0 then
|
||||||
|
FOriginY := H
|
||||||
|
else begin
|
||||||
|
if X < 0 then
|
||||||
|
FOriginY := R.Bottom - H
|
||||||
|
else
|
||||||
|
FOriginY := R.Bottom - H - H div 2;
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
FOriginX := 0;
|
||||||
|
FOriginY := 0;
|
||||||
|
R.Right := W;
|
||||||
|
R.Bottom := H;
|
||||||
|
end;
|
||||||
|
|
||||||
|
SetBounds(Left, Top, R.Right, R.Bottom);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
rlBusy := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.lblDrawText(var R : TRect; Flags : Word);
|
||||||
|
{-paint the controls display or calculate a TRect to fit text}
|
||||||
|
var
|
||||||
|
HoldColor : TColor;
|
||||||
|
T : string;
|
||||||
|
XO, YO : Integer;
|
||||||
|
A : Integer;
|
||||||
|
Buf : array[0..255] of Char;
|
||||||
|
{$IFDEF LCL}
|
||||||
|
FontHand : hFont;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
T := Caption;
|
||||||
|
if (Flags and DT_CALCRECT <> 0) and (T = '') then
|
||||||
|
T := ' ';
|
||||||
|
|
||||||
|
Flags := Flags or DT_NOPREFIX;
|
||||||
|
|
||||||
|
{use our font}
|
||||||
|
Canvas.Font := Font;
|
||||||
|
|
||||||
|
{create the rotated font}
|
||||||
|
if FFontAngle <> 0 then
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
Canvas.Font.Handle := CreateRotatedFont(Font, FFontAngle);
|
||||||
|
{$ELSE} //Workaround for now - Qt widgetset not setting Handle?
|
||||||
|
FontHand := CreateRotatedFont(Font, FFontAngle);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{force disabled text color, if not enabled}
|
||||||
|
if not Enabled then
|
||||||
|
Canvas.Font.Color := clGrayText;
|
||||||
|
|
||||||
|
{draw the text}
|
||||||
|
StrPLCopy(Buf, T, 255);
|
||||||
|
if FFontAngle = 0 then begin
|
||||||
|
{draw shadow first, if selected}
|
||||||
|
if FShadowedText then begin
|
||||||
|
HoldColor := Canvas.Font.Color;
|
||||||
|
Canvas.Font.Color := FShadowColor;
|
||||||
|
if not Transparent then begin
|
||||||
|
SetBkMode(Canvas.Handle, OPAQUE);
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
end;
|
||||||
|
OffsetRect(R, +2, +1);
|
||||||
|
DrawText(Canvas.Handle, @Buf, -1, R, Flags);
|
||||||
|
Canvas.Font.Color := HoldColor;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
|
||||||
|
{$ELSE}
|
||||||
|
SetBkMode(Canvas.Handle, LclType.TRANSPARENT);
|
||||||
|
{$ENDIF}
|
||||||
|
OffsetRect(R, -2, -1);
|
||||||
|
DrawText(Canvas.Handle, @Buf, -1, R, Flags);
|
||||||
|
end else begin
|
||||||
|
DrawText(Canvas.Handle, @Buf, -1, R, Flags)
|
||||||
|
end;
|
||||||
|
end else begin
|
||||||
|
if FShadowedText then begin
|
||||||
|
HoldColor := Canvas.Font.Color;
|
||||||
|
Canvas.Font.Color := FShadowColor;
|
||||||
|
if not Transparent then begin
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
SetBkMode(Canvas.Handle, Windows.OPAQUE);
|
||||||
|
{$ELSE}
|
||||||
|
SetBkMode(Canvas.Handle, LclType.OPAQUE);
|
||||||
|
{$ENDIF}
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
end;
|
||||||
|
{calculate the shadow offset based on the quadrant the text is in}
|
||||||
|
{ | } { 1 -- X+2, Y+1}
|
||||||
|
{ 2 | 1 } { 2 -- X-1, Y-2}
|
||||||
|
{ -------+--------- } { 3 -- X+2, Y+1}
|
||||||
|
{ 3 | 4 } { 4 -- X-1, Y-2}
|
||||||
|
{ | }
|
||||||
|
A := FFontAngle;
|
||||||
|
if A < 0 then A := 360 + A;
|
||||||
|
if A >= 270 then begin
|
||||||
|
XO := 2; YO := 1; {Quad=4}
|
||||||
|
end else if A >= 180 then begin
|
||||||
|
XO := 2; YO := 1; {Quad=3}
|
||||||
|
end else if A >= 90 then begin
|
||||||
|
XO := 2; YO := 1; {Quad=2}
|
||||||
|
end else begin
|
||||||
|
XO := 2; YO := 1; {Quad=1}
|
||||||
|
end;
|
||||||
|
{$IFDEF LCL}
|
||||||
|
SelectObject(Canvas.Handle, FontHand);
|
||||||
|
{$ENDIF}
|
||||||
|
ExtTextOut(Canvas.Handle, OriginX+XO, OriginY+YO, ETO_CLIPPED,
|
||||||
|
@R, Buf, StrLen(Buf), nil);
|
||||||
|
Canvas.Font.Color := HoldColor;
|
||||||
|
{$IFNDEF LCL}
|
||||||
|
SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
|
||||||
|
{$ELSE}
|
||||||
|
SetBkMode(Canvas.Handle, LclType.TRANSPARENT);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LCL}
|
||||||
|
SelectObject(Canvas.Handle, FontHand);
|
||||||
|
{$ENDIF}
|
||||||
|
ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED,
|
||||||
|
@R, Buf, StrLen(Buf), nil);
|
||||||
|
end else begin
|
||||||
|
{$IFDEF LCL}
|
||||||
|
SelectObject(Canvas.Handle, FontHand);
|
||||||
|
{$ENDIF}
|
||||||
|
ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED,
|
||||||
|
@R, Buf, StrLen(Buf), nil);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.Loaded;
|
||||||
|
begin
|
||||||
|
inherited Loaded;
|
||||||
|
|
||||||
|
lblAdjustSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.Paint;
|
||||||
|
const
|
||||||
|
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
||||||
|
var
|
||||||
|
R : TRect;
|
||||||
|
begin
|
||||||
|
R := ClientRect;
|
||||||
|
with Canvas do begin
|
||||||
|
if not Transparent then begin
|
||||||
|
Brush.Color := Self.Color;
|
||||||
|
Brush.Style := bsSolid;
|
||||||
|
FillRect(R);
|
||||||
|
end;
|
||||||
|
Brush.Style := bsClear;
|
||||||
|
lblDrawText(R, Alignments[FAlignment])
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetAlignment(Value : TAlignment);
|
||||||
|
begin
|
||||||
|
if FAlignment <> Value then begin
|
||||||
|
FAlignment := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetAutoSize(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FAutoSize then begin
|
||||||
|
FAutoSize := Value;
|
||||||
|
lblAdjustSize;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetCaption(const Value : string);
|
||||||
|
begin
|
||||||
|
if Value <> FCaption then begin
|
||||||
|
FCaption := Value;
|
||||||
|
lblAdjustSize;
|
||||||
|
Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetOriginX(Value : Integer);
|
||||||
|
begin
|
||||||
|
if Value <> FOriginX then begin
|
||||||
|
FOriginX := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetOriginY(Value : Integer);
|
||||||
|
begin
|
||||||
|
if Value <> FOriginY then begin
|
||||||
|
FOriginY := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetShadowColor(const Value : TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowColor then begin
|
||||||
|
FShadowColor := Value;
|
||||||
|
invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetShadowedText(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Value <> FShadowedText then begin
|
||||||
|
FShadowedText := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetTransparent(Value : Boolean);
|
||||||
|
begin
|
||||||
|
if Transparent <> Value then begin
|
||||||
|
if Value then
|
||||||
|
ControlStyle := ControlStyle - [csOpaque]
|
||||||
|
else
|
||||||
|
ControlStyle := ControlStyle + [csOpaque];
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetFontAngle(Value : Integer);
|
||||||
|
var
|
||||||
|
Neg : Integer;
|
||||||
|
TM : TTextMetric;
|
||||||
|
begin
|
||||||
|
if Value <> FFontAngle then begin
|
||||||
|
{check if the current font can be rotated}
|
||||||
|
if not (csLoading in ComponentState) then begin
|
||||||
|
if Value <> 0 then begin
|
||||||
|
Canvas.Font := Font;
|
||||||
|
GetTextMetrics(Canvas.Handle, TM);
|
||||||
|
if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
|
||||||
|
{force true-type font}
|
||||||
|
Font.Name := 'Arial';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Value < 0 then Neg := -1 else Neg := 1;
|
||||||
|
FFontAngle := (Abs(Value) mod 360) * Neg;
|
||||||
|
|
||||||
|
lblAdjustSize;
|
||||||
|
|
||||||
|
{repaint with new font}
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOvcCustomRotatedLabel.SetName(const NewName : TComponentName);
|
||||||
|
begin
|
||||||
|
inherited SetName(NewName);
|
||||||
|
if (csDesigning in ComponentState) and (FCaption = '') then
|
||||||
|
FCaption := Self.Name;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
1717
components/orpheus/ovcsc.pas
Normal file
1717
components/orpheus/ovcsc.pas
Normal file
File diff suppressed because it is too large
Load Diff
2046
components/orpheus/ovcsf.pas
Normal file
2046
components/orpheus/ovcsf.pas
Normal file
File diff suppressed because it is too large
Load Diff
698
components/orpheus/ovcspary.pas
Normal file
698
components/orpheus/ovcspary.pas
Normal file
@ -0,0 +1,698 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* OVCSPARY.PAS 4.06 *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||||
|
{* Version: MPL 1.1 *}
|
||||||
|
{* *}
|
||||||
|
{* The contents of this file are subject to the Mozilla Public License *}
|
||||||
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||||
|
{* compliance with the License. You may obtain a copy of the License at *}
|
||||||
|
{* http://www.mozilla.org/MPL/ *}
|
||||||
|
{* *}
|
||||||
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||||
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||||
|
{* for the specific language governing rights and limitations under the *}
|
||||||
|
{* License. *}
|
||||||
|
{* *}
|
||||||
|
{* The Original Code is TurboPower Orpheus *}
|
||||||
|
{* *}
|
||||||
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||||
|
{* *}
|
||||||
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||||
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||||
|
{* *}
|
||||||
|
{* Contributor(s): *}
|
||||||
|
{* *}
|
||||||
|
{* ***** END LICENSE BLOCK ***** *}
|
||||||
|
|
||||||
|
{$I OVC.INC}
|
||||||
|
|
||||||
|
{$B-} {Complete Boolean Evaluation}
|
||||||
|
{$I+} {Input/Output-Checking}
|
||||||
|
{$P+} {Open Parameters}
|
||||||
|
{$T-} {Typed @ Operator}
|
||||||
|
{.W-} {Windows Stack Frame}
|
||||||
|
{$X+} {Extended Syntax}
|
||||||
|
|
||||||
|
unit ovcspary;
|
||||||
|
{-Orpheus - sparse array implementation}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
|
||||||
|
SysUtils, OvcExcpt, OvcConst, OvcData;
|
||||||
|
|
||||||
|
const
|
||||||
|
MaxSparseArrayItems = 320000; {maximum items in a sparse array}
|
||||||
|
|
||||||
|
type
|
||||||
|
TSparseArrayFunc = function (Index : longint; Item : pointer;
|
||||||
|
ExtraData : pointer) : boolean;
|
||||||
|
{-Sparse array's iterator type. Should return true to continue iterating,
|
||||||
|
false otherwise.}
|
||||||
|
|
||||||
|
{The sparse array class}
|
||||||
|
TOvcSparseArray = class
|
||||||
|
protected {private}
|
||||||
|
FCount : longint; {Fake count of the items}
|
||||||
|
FArray : pointer; {Sparse array}
|
||||||
|
|
||||||
|
ChunkCount : word; {Number of chunks}
|
||||||
|
ChunkArraySize : word; {Size of FArray}
|
||||||
|
|
||||||
|
procedure RecalcCount;
|
||||||
|
|
||||||
|
protected
|
||||||
|
function GetActiveCount : longint;
|
||||||
|
function GetItem(Index : longint) : pointer;
|
||||||
|
procedure PutItem(Index : longint; Item : pointer);
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function Add(Item : pointer) : longint;
|
||||||
|
{-Add Item to end of array}
|
||||||
|
procedure Clear;
|
||||||
|
{-Clear array}
|
||||||
|
procedure Delete(Index : longint);
|
||||||
|
{-Delete item at Index, all items below move up one}
|
||||||
|
procedure Exchange(Index1, Index2 : longint);
|
||||||
|
{-Swap the items at Index1 and Index2}
|
||||||
|
function First : pointer;
|
||||||
|
{-Return First item}
|
||||||
|
function ForAll(Action : TSparseArrayFunc;
|
||||||
|
Backwards : boolean;
|
||||||
|
ExtraData : pointer) : longint;
|
||||||
|
{-Iterate through all active items, maybe backwards}
|
||||||
|
function IndexOf(Item : pointer) : longint;
|
||||||
|
{-Get the index of Item}
|
||||||
|
procedure Insert(Index : longint; Item : pointer);
|
||||||
|
{-Insert Item at Index, it and all items below move down one}
|
||||||
|
function Last : pointer;
|
||||||
|
{-Return Last item}
|
||||||
|
procedure Squeeze;
|
||||||
|
{-Pack the sparse array}
|
||||||
|
|
||||||
|
property Count : longint
|
||||||
|
{-Logical count of the number of items (=IndexOf(Last)+1)}
|
||||||
|
read FCount;
|
||||||
|
property ActiveCount : longint
|
||||||
|
{-Count of non-nil items}
|
||||||
|
read GetActiveCount;
|
||||||
|
property Items[Index : longint] : pointer
|
||||||
|
{-Items array}
|
||||||
|
read GetItem write PutItem;
|
||||||
|
default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{Notes: the sparse array is implemented as an array of chunks, each
|
||||||
|
chunk contains 32 items (2^5). The array of chunks consists
|
||||||
|
of a set of elements, each with chunk index and a pointer to
|
||||||
|
the chunk. To find the item for a given index you do two
|
||||||
|
things: calculate the chunk index (divide by 32) and the
|
||||||
|
index into the chunk (the remainder once divided by 32).
|
||||||
|
For example: where is item 100? 100 = 3*32 + 4, so you try
|
||||||
|
and find chunk index 3 in the chunk array (the array is sorted
|
||||||
|
by chunk index, hence you do a binary search), and if found
|
||||||
|
return the 5th element (zero based arrays). If not found then
|
||||||
|
the item does not exist.
|
||||||
|
Thus setting item 10000 in a sparse array will allocate only
|
||||||
|
one chunk, the 9999 previous items are all assumed nil.
|
||||||
|
The sparse array can only accomodate pointers. An unused item
|
||||||
|
will be nil. A nil pointer will indicate an unused item. Hence
|
||||||
|
you cannot really use a sparse array for longints say, unless
|
||||||
|
you can guarantee that all your values will be non-nil.
|
||||||
|
|
||||||
|
Sizing stuff: maximum number of pointers that can be stored is
|
||||||
|
just less than 350,000. For various reasons the maximum index
|
||||||
|
that is allowed for the sparse array is 319,999 meaning that a
|
||||||
|
sparse array could hold up to 320,000 pointers. To increase this
|
||||||
|
you could hold 64 or 128 pointers per chunk instead.
|
||||||
|
The minimum heap the sparse array will take is 896 bytes.
|
||||||
|
|
||||||
|
Sparse arrays cannot really be used for keeping sorted items:
|
||||||
|
obviously all the items will appear at the start of the array,
|
||||||
|
there can be no holes.
|
||||||
|
}
|
||||||
|
|
||||||
|
const
|
||||||
|
ShiftValue = 5;
|
||||||
|
ChunkElements = 1 shl ShiftValue; {Number of elements in a chunk: 32}
|
||||||
|
ChunkMask = pred(ChunkElements); {Mask used for the item in a chunk: $1F}
|
||||||
|
|
||||||
|
type
|
||||||
|
PChunk = ^TChunk; {Definition of a chunk}
|
||||||
|
TChunk = array [0..pred(ChunkElements)] of pointer;
|
||||||
|
|
||||||
|
TChunkArrayElement = packed record {Definition of a chunk array element}
|
||||||
|
ChunkIndex : word; {..index of the chunk}
|
||||||
|
Chunk : PChunk; {..the chunk itself}
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
DefChunkArrayElements = 4; {Initial size of the chunk array}
|
||||||
|
MaxChunkArrayElements = ($10000 div sizeof(TChunkArrayElement)) - 1;
|
||||||
|
{Absolute maximum of chunk array elements}
|
||||||
|
|
||||||
|
type
|
||||||
|
PChunkArray = ^TChunkArray; {Definition of a chunk array}
|
||||||
|
TChunkArray = array [0..pred(MaxChunkArrayElements)] of TChunkArrayElement;
|
||||||
|
|
||||||
|
{===Helper routines==================================================}
|
||||||
|
procedure RaiseException(ClassType : integer);
|
||||||
|
begin
|
||||||
|
case ClassType of
|
||||||
|
1 : raise ESAEAtMaxSize.Create(GetOrphStr(SCSAEAtMaxSize));
|
||||||
|
2 : raise ESAEOutOfBounds.Create(GetOrphStr(SCSAEOutOfBounds));
|
||||||
|
else
|
||||||
|
raise ESparseArrayError.Create(GetOrphStr(SCSAEGeneral));
|
||||||
|
end;{case}
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function GrowChunkArray(A : PChunkArray; var CurSize : word) : PChunkArray;
|
||||||
|
{-Grow the chunk array, return the new size and the new pointer}
|
||||||
|
var
|
||||||
|
NewSize : longint;
|
||||||
|
NewSizeAdj : word;
|
||||||
|
begin
|
||||||
|
NewSize := longint(CurSize) +
|
||||||
|
(DefChunkArrayElements * sizeof(TChunkArrayElement));
|
||||||
|
NewSizeAdj := MaxChunkArrayElements * sizeof(TChunkArrayElement);
|
||||||
|
if (NewSize < NewSizeAdj) then
|
||||||
|
NewSizeAdj := NewSize;
|
||||||
|
GetMem(Result, NewSizeAdj);
|
||||||
|
{$IFOPT D+}
|
||||||
|
FillChar(Result^, NewSizeAdj, $CC);
|
||||||
|
{$ENDIF}
|
||||||
|
if (CurSize <> 0) then
|
||||||
|
begin
|
||||||
|
Move(A^, Result^, CurSize);
|
||||||
|
FreeMem(A, CurSize);
|
||||||
|
end;
|
||||||
|
CurSize := NewSizeAdj;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function GetChunk(A : PChunkArray;
|
||||||
|
CI : word; NumChunks : word) : integer;
|
||||||
|
{-Find a chunk array element given the chunk index CI and the number of
|
||||||
|
chunks. Return the index into the chunk array, or -1 if not found.}
|
||||||
|
var
|
||||||
|
L, R : integer;
|
||||||
|
MsInx : word;
|
||||||
|
begin
|
||||||
|
L := 0;
|
||||||
|
R := pred(NumChunks);
|
||||||
|
repeat
|
||||||
|
Result := (L + R) div 2;
|
||||||
|
MsInx := A^[Result].ChunkIndex;
|
||||||
|
if (CI = MsInx) then
|
||||||
|
Exit
|
||||||
|
else if (CI < MsInx) then
|
||||||
|
R := pred(Result)
|
||||||
|
else
|
||||||
|
L := succ(Result);
|
||||||
|
until (L > R);
|
||||||
|
Result := -1;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function EnsureChunk(var A : PChunkArray; CI : word;
|
||||||
|
var NumChunks, Size : word;
|
||||||
|
DontCreate : boolean) : integer;
|
||||||
|
{-Makes sure that chunk CI is available for use. If it does not yet
|
||||||
|
exist and DontCreate is false, creates a new chunk, inserts it into
|
||||||
|
the chunk array (possibly growing the array). Return the index of
|
||||||
|
the chunk in the array.}
|
||||||
|
var
|
||||||
|
NumElements : word;
|
||||||
|
L, R, M : integer;
|
||||||
|
MsInx : word;
|
||||||
|
begin
|
||||||
|
L := 0;
|
||||||
|
if (NumChunks > 0) then
|
||||||
|
begin
|
||||||
|
R := pred(NumChunks);
|
||||||
|
repeat
|
||||||
|
M := (L + R) div 2;
|
||||||
|
MsInx := A^[M].ChunkIndex;
|
||||||
|
if (CI = MsInx) then
|
||||||
|
begin
|
||||||
|
Result := M;
|
||||||
|
Exit;
|
||||||
|
end
|
||||||
|
else if (CI < MsInx) then
|
||||||
|
R := pred(M)
|
||||||
|
else
|
||||||
|
L := succ(M);
|
||||||
|
until (L > R);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if DontCreate then
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := L;
|
||||||
|
|
||||||
|
NumElements := Size div sizeof(TChunkArrayElement);
|
||||||
|
if (NumChunks = NumElements) then
|
||||||
|
A := GrowChunkArray(A, Size);
|
||||||
|
|
||||||
|
if (Result < NumChunks) then
|
||||||
|
Move(A^[Result], A^[succ(Result)],
|
||||||
|
(NumChunks - Result) * sizeof(TChunkArrayElement));
|
||||||
|
|
||||||
|
with A^[Result] do
|
||||||
|
begin
|
||||||
|
ChunkIndex := CI;
|
||||||
|
Chunk := New(PChunk);
|
||||||
|
FillChar(Chunk^, sizeof(TChunk), 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
inc(NumChunks);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function ChunkIsBlank(A : PChunkArray; ArrayInx : word) : boolean;
|
||||||
|
{-Return true if the chunk has no items (all pointers are nil).}
|
||||||
|
const
|
||||||
|
ChunkSizeInWords = sizeof(TChunk) div 2;
|
||||||
|
ChunkSizeInDWords = sizeof(TChunk) div 4;
|
||||||
|
var
|
||||||
|
Chunk : PChunk;
|
||||||
|
{$IFDEF NoAsm}
|
||||||
|
ItemNum : Integer;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Chunk := A^[ArrayInx].Chunk;
|
||||||
|
{$IFDEF NoAsm}
|
||||||
|
for ItemNum := 0 to Pred(ChunkElements) do
|
||||||
|
begin
|
||||||
|
if Chunk^[ItemNum] <> nil then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
{$ELSE}
|
||||||
|
asm
|
||||||
|
push edi
|
||||||
|
{$IFDEF VERSION6} { Delphi 6 codegen bug }
|
||||||
|
push ecx
|
||||||
|
{$ENDIF}
|
||||||
|
lea eax, Chunk
|
||||||
|
mov edi, [eax]
|
||||||
|
xor eax, eax
|
||||||
|
mov edx, eax
|
||||||
|
mov ecx, ChunkSizeInDWords
|
||||||
|
repe scasd
|
||||||
|
jne @@Exit
|
||||||
|
inc edx
|
||||||
|
@@Exit:
|
||||||
|
{$IFDEF VERSION6} { Delphi 6 codegen bug }
|
||||||
|
pop ecx
|
||||||
|
{$ENDIF}
|
||||||
|
mov @Result, dl
|
||||||
|
pop edi
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure DeleteChunk(A : PChunkArray; ArrayInx : word; var NumChunks : word);
|
||||||
|
{-Delete a chunk, moving chunks below up one.}
|
||||||
|
begin
|
||||||
|
Dispose(A^[ArrayInx].Chunk);
|
||||||
|
if ArrayInx < pred(NumChunks) then
|
||||||
|
Move(A^[succ(ArrayInx)], A^[ArrayInx],
|
||||||
|
(NumChunks - ArrayInx) * sizeof(TChunkArrayElement));
|
||||||
|
dec(NumChunks);
|
||||||
|
{$IFOPT D+}
|
||||||
|
FillChar(A^[NumChunks], sizeof(TChunkArrayElement), $CC);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{===TOvcSparseArray ForAll routines=====================================}
|
||||||
|
function CountActiveElements(Index : longint;
|
||||||
|
Item : pointer;
|
||||||
|
ExtraData : pointer) : boolean; far;
|
||||||
|
var
|
||||||
|
ED : ^longint absolute ExtraData;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
inc(ED^);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function Find1stOrLastElement(Index : longint;
|
||||||
|
Item : pointer;
|
||||||
|
ExtraData : pointer) : boolean; far;
|
||||||
|
var
|
||||||
|
ED : ^pointer absolute ExtraData;
|
||||||
|
begin
|
||||||
|
Find1stOrLastElement := false;
|
||||||
|
ED^ := Item;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
function FindSpecificElement(Index : longint;
|
||||||
|
Item : pointer;
|
||||||
|
ExtraData : pointer) : boolean; far;
|
||||||
|
begin
|
||||||
|
{continue looking if this Item is NOT the one we want}
|
||||||
|
FindSpecificElement := Item <> ExtraData;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
constructor TOvcSparseArray.Create;
|
||||||
|
begin
|
||||||
|
FArray := GrowChunkArray(FArray, ChunkArraySize);
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
destructor TOvcSparseArray.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(FArray) then
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
FreeMem(FArray, ChunkArraySize);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{=====}
|
||||||
|
|
||||||
|
procedure TOvcSparseArray.RecalcCount;
|
||||||
|
var
|
||||||
|
Dummy : pointer;
|
||||||
|
begin
|
||||||
|
FCount := succ(ForAll(Find1stOrLastElement, true, @Dummy));
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.Squeeze;
|
||||||
|
var
|
||||||
|
ArrayInx : word;
|
||||||
|
begin
|
||||||
|
ArrayInx := 0;
|
||||||
|
while ArrayInx <> ChunkCount do
|
||||||
|
if ChunkIsBlank(FArray, ArrayInx) then
|
||||||
|
DeleteChunk(FArray, ArrayInx, ChunkCount)
|
||||||
|
else
|
||||||
|
inc(ArrayInx);
|
||||||
|
end;
|
||||||
|
{=======================================================================}
|
||||||
|
|
||||||
|
|
||||||
|
{===TOvcSparseArray property access=====================================}
|
||||||
|
function TOvcSparseArray.GetActiveCount : longint;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
ForAll(CountActiveElements, true, @Result);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcSparseArray.GetItem(Index : longint) : pointer;
|
||||||
|
var
|
||||||
|
ChunkIndex : word;
|
||||||
|
ChunkNum : integer;
|
||||||
|
begin
|
||||||
|
if (Index < 0) or (Index >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := nil;
|
||||||
|
if (ChunkCount > 0) then
|
||||||
|
begin
|
||||||
|
ChunkIndex := Index shr ShiftValue;
|
||||||
|
ChunkNum := GetChunk(FArray, ChunkIndex, ChunkCount);
|
||||||
|
if (ChunkNum <> -1) then
|
||||||
|
Result := PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.PutItem(Index : longint; Item : pointer);
|
||||||
|
var
|
||||||
|
ChunkIndex : word;
|
||||||
|
ChunkNum : integer;
|
||||||
|
begin
|
||||||
|
if (Index < 0) or (Index >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
ChunkIndex := Index shr ShiftValue;
|
||||||
|
ChunkNum := EnsureChunk(PChunkArray(FArray),
|
||||||
|
ChunkIndex, ChunkCount, ChunkArraySize,
|
||||||
|
(Item = nil));
|
||||||
|
|
||||||
|
if (ChunkNum <> -1) then
|
||||||
|
begin
|
||||||
|
PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask] := Item;
|
||||||
|
if (Item = nil) then
|
||||||
|
Squeeze;
|
||||||
|
RecalcCount;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
|
||||||
|
{===TOvcSparseArray item maintenance====================================}
|
||||||
|
function TOvcSparseArray.Add(Item : pointer) : longint;
|
||||||
|
begin
|
||||||
|
if (FCount = MaxSparseArrayItems) then
|
||||||
|
RaiseException(1);
|
||||||
|
|
||||||
|
Result := FCount;
|
||||||
|
PutItem(Result, Item);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.Clear;
|
||||||
|
var
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
if (ChunkCount > 0) then
|
||||||
|
begin
|
||||||
|
for i := 0 to pred(ChunkCount) do
|
||||||
|
Dispose(PChunkArray(FArray)^[i].Chunk);
|
||||||
|
{$IFOPT D+}
|
||||||
|
FillChar(FArray^, ChunkArraySize, $CC);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
ChunkCount := 0;
|
||||||
|
FCount := 0;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.Delete(Index : longint);
|
||||||
|
const
|
||||||
|
LastPos = pred(ChunkElements);
|
||||||
|
var
|
||||||
|
MajorInx : word;
|
||||||
|
ChunkNum, Dummy : integer;
|
||||||
|
StartPos : word;
|
||||||
|
OurChunk : PChunk;
|
||||||
|
Transferred : boolean;
|
||||||
|
begin
|
||||||
|
if (Index < 0) or (Index >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (Index >= FCount) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
MajorInx := Index shr ShiftValue;
|
||||||
|
ChunkNum := EnsureChunk(PChunkArray(FArray),
|
||||||
|
MajorInx, ChunkCount, ChunkArraySize,
|
||||||
|
false);
|
||||||
|
|
||||||
|
StartPos := Index and ChunkMask;
|
||||||
|
OurChunk := PChunkArray(FArray)^[ChunkNum].Chunk;
|
||||||
|
if (StartPos <> LastPos) then
|
||||||
|
Move(OurChunk^[succ(StartPos)], OurChunk^[StartPos],
|
||||||
|
(LastPos-StartPos)*sizeof(Pointer));
|
||||||
|
|
||||||
|
inc(ChunkNum);
|
||||||
|
while (ChunkNum <> ChunkCount) do
|
||||||
|
begin
|
||||||
|
with PChunkArray(FArray)^[ChunkNum] do
|
||||||
|
begin
|
||||||
|
if (ChunkIndex = MajorInx+1) then
|
||||||
|
begin
|
||||||
|
Transferred := true;
|
||||||
|
OurChunk^[LastPos] := Chunk^[0];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Transferred := false;
|
||||||
|
OurChunk^[LastPos] := nil;
|
||||||
|
end;
|
||||||
|
MajorInx := ChunkIndex;
|
||||||
|
OurChunk := Chunk;
|
||||||
|
end;
|
||||||
|
if (OurChunk^[0] <> nil) and (not Transferred) then
|
||||||
|
begin
|
||||||
|
Dummy := EnsureChunk(PChunkArray(FArray),
|
||||||
|
MajorInx-1, ChunkCount, ChunkArraySize,
|
||||||
|
true);
|
||||||
|
PChunkArray(FArray)^[Dummy].Chunk^[LastPos] :=
|
||||||
|
OurChunk^[0];
|
||||||
|
end;
|
||||||
|
Move(OurChunk^[1], OurChunk^[0], LastPos*sizeof(Pointer));
|
||||||
|
inc(ChunkNum);
|
||||||
|
end;
|
||||||
|
|
||||||
|
OurChunk^[LastPos] := nil;
|
||||||
|
Squeeze;
|
||||||
|
RecalcCount;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.Exchange(Index1, Index2 : longint);
|
||||||
|
var
|
||||||
|
Item1, Item2 : pointer;
|
||||||
|
begin
|
||||||
|
if (Index1 = Index2) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if (Index1 < 0) or (Index1 >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
if (Index2 < 0) or (Index2 >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Item1 := GetItem(Index1);
|
||||||
|
Item2 := GetItem(Index2);
|
||||||
|
PutItem(Index2, Item1);
|
||||||
|
PutItem(Index1, Item2);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcSparseArray.First : pointer;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
ForAll(Find1stOrLastElement, false, @Result);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcSparseArray.ForAll(Action : TSparseArrayFunc;
|
||||||
|
Backwards : boolean;
|
||||||
|
ExtraData : pointer) : longint;
|
||||||
|
var
|
||||||
|
MajorInx : word;
|
||||||
|
MinorInx : word;
|
||||||
|
MajorStub : longint;
|
||||||
|
label
|
||||||
|
ExitLoopsReverse, ExitLoopsForwards;
|
||||||
|
begin
|
||||||
|
if (ChunkCount = 0) then
|
||||||
|
Result := -1
|
||||||
|
else if Backwards then
|
||||||
|
begin
|
||||||
|
for MajorInx := pred(ChunkCount) downto 0 do
|
||||||
|
with PChunkArray(FArray)^[MajorInx] do
|
||||||
|
begin
|
||||||
|
MajorStub := longint(ChunkIndex) shl ShiftValue;
|
||||||
|
for MinorInx := pred(ChunkElements) downto 0 do
|
||||||
|
if (Chunk^[MinorInx] <> nil) then
|
||||||
|
begin
|
||||||
|
Result := MajorStub + MinorInx;
|
||||||
|
if not Action(Result,
|
||||||
|
Chunk^[MinorInx],
|
||||||
|
ExtraData) then
|
||||||
|
Goto ExitLoopsReverse;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := -1;
|
||||||
|
ExitLoopsReverse:
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
for MajorInx := 0 to pred(ChunkCount) do
|
||||||
|
with PChunkArray(FArray)^[MajorInx] do
|
||||||
|
begin
|
||||||
|
MajorStub := longint(ChunkIndex) shl ShiftValue;
|
||||||
|
for MinorInx := 0 to pred(ChunkElements) do
|
||||||
|
if (Chunk^[MinorInx] <> nil) then
|
||||||
|
begin
|
||||||
|
Result := MajorStub + MinorInx;
|
||||||
|
if not Action(Result,
|
||||||
|
Chunk^[MinorInx],
|
||||||
|
ExtraData) then
|
||||||
|
Goto ExitLoopsForwards;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := -1;
|
||||||
|
ExitLoopsForwards:
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcSparseArray.IndexOf(Item : pointer) : longint;
|
||||||
|
begin
|
||||||
|
Result := ForAll(FindSpecificElement, true, Item);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
procedure TOvcSparseArray.Insert(Index : longint; Item : pointer);
|
||||||
|
const
|
||||||
|
LastPos = pred(ChunkElements);
|
||||||
|
var
|
||||||
|
MajorInx : word;
|
||||||
|
ChunkNum : integer;
|
||||||
|
CarryItem, NewCarryItem : pointer;
|
||||||
|
StartPos : word;
|
||||||
|
begin
|
||||||
|
if (Index < 0) or (Index >= MaxSparseArrayItems) then
|
||||||
|
begin
|
||||||
|
RaiseException(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FCount = MaxSparseArrayItems) then
|
||||||
|
RaiseException(1);
|
||||||
|
|
||||||
|
if (Index >= FCount) then
|
||||||
|
begin
|
||||||
|
PutItem(Index, Item);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
MajorInx := Index shr ShiftValue;
|
||||||
|
ChunkNum := EnsureChunk(PChunkArray(FArray),
|
||||||
|
MajorInx, ChunkCount, ChunkArraySize,
|
||||||
|
false);
|
||||||
|
|
||||||
|
CarryItem := Item;
|
||||||
|
StartPos := Index and ChunkMask;
|
||||||
|
repeat
|
||||||
|
with PChunkArray(FArray)^[ChunkNum] do
|
||||||
|
begin
|
||||||
|
MajorInx := ChunkIndex;
|
||||||
|
NewCarryItem := Chunk^[LastPos];
|
||||||
|
if (StartPos <> LastPos) then
|
||||||
|
Move(Chunk^[StartPos], Chunk^[succ(StartPos)],
|
||||||
|
(LastPos-StartPos)*sizeof(Pointer));
|
||||||
|
Chunk^[StartPos] := CarryItem;
|
||||||
|
CarryItem := NewCarryItem;
|
||||||
|
StartPos := 0;
|
||||||
|
end;
|
||||||
|
inc(ChunkNum);
|
||||||
|
if (CarryItem <> nil) then
|
||||||
|
if (ChunkNum = ChunkCount) or
|
||||||
|
(PChunkArray(FArray)^[ChunkNum].ChunkIndex <> MajorInx+1) then
|
||||||
|
ChunkNum := EnsureChunk(PChunkArray(FArray),
|
||||||
|
MajorInx+1, ChunkCount, ChunkArraySize,
|
||||||
|
false);
|
||||||
|
until (ChunkNum = ChunkCount);
|
||||||
|
inc(FCount);
|
||||||
|
end;
|
||||||
|
{--------}
|
||||||
|
function TOvcSparseArray.Last : pointer;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
ForAll(Find1stOrLastElement, true, @Result);
|
||||||
|
end;
|
||||||
|
{====================================================================}
|
||||||
|
|
||||||
|
end.
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user