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