pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Release 0.2.0 (20080720): Important update with many bugs fixed and workarounds found.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@509 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
MacPgmr
2008-07-20 20:24:35 +00:00
parent 216c8bf089
commit 9f181dc51d
24 changed files with 432 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
components/orpheus/OrphStatus.html
View File

@ -1,5 +1,5 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<!--Copyright 2007 Phil Hess--> <!--Copyright 2008 Phil Hess-->
<HTML> <HTML>
<HEAD> <HEAD>
@ -33,6 +33,14 @@
<A name="Whats_New"></A><H3>What's New</H3> <A name="Whats_New"></A><H3>What's New</H3>
<UL> <UL>
<LI>20080720 release (0.2.0):
<UL>
<LI>Recent change in the Lazarus LCL broke Orpheus TOvcTable on Windows. This release
works around that change.
<LI>Numerous bugs fixed and workarounds found. See To Do list.
<LI>Batch/script files are now included for compiling all test apps at once.<P>
</UL>
<LI>20080316 release (0.1.9): <LI>20080316 release (0.1.9):
<UL> <UL>
<LI>Recent changes in the Lazarus LCL broke Orpheus compilation. This release <LI>Recent changes in the Lazarus LCL broke Orpheus compilation. This release
@ -205,7 +213,7 @@ access to the Lazarus install folder. After rebuilding, be sure to start
<TD>XP SP2</TD> <TD>XP SP2</TD>
<TD>&nbsp;</TD> <TD>&nbsp;</TD>
<TD>win32</TD> <TD>win32</TD>
<TD>20080229 snapshot of 0.9.25 with FPC 2.2.1</TD> <TD>20080714 snapshot of 0.9.25 with FPC 2.2.2rc2</TD>
</TR> </TR>
<TR VALIGN=TOP> <TR VALIGN=TOP>
@ -213,7 +221,7 @@ access to the Lazarus install folder. After rebuilding, be sure to start
<TD>10.4.11 (Tiger) on PowerPC</TD> <TD>10.4.11 (Tiger) on PowerPC</TD>
<TD>gtk: 1.2.0.9.1<BR>gtk2: 2.6.10<BR>qt: 4.3.0</TD> <TD>gtk: 1.2.0.9.1<BR>gtk2: 2.6.10<BR>qt: 4.3.0</TD>
<TD>gtk, gtk2, carbon, qt</TD> <TD>gtk, gtk2, carbon, qt</TD>
<TD>20080229 snapshot of 0.9.25 with FPC 2.2.0</TD> <TD>20080714 snapshot of 0.9.25 with FPC 2.2.2rc2</TD>
</TR> </TR>
<TR VALIGN=TOP> <TR VALIGN=TOP>
@ -408,12 +416,12 @@ widgetset.
<TR VALIGN=TOP> <TR VALIGN=TOP>
<TD>TOvcVirtualListBox<BR><IMG SRC="TOVCVIRTUALLISTBOX.bmp"></TD> <TD>TOvcVirtualListBox<BR><IMG SRC="TOVCVIRTUALLISTBOX.bmp"></TD>
<TD>TCustomControl</TD> <TD>TCustomControl</TD>
<TD>Tabs, header, huge number of rows</TD> <TD>Header row, variable width tabs, huge number of rows</TD>
<TD>Scrolling problems</TD> <TD>&nbsp;</TD>
<TD>Partial</TD> <TD>Working</TD>
<TD>Partial</TD> <TD>Working</TD>
<TD>Partial</TD>
<TD>Partial</TD> <TD>Partial</TD>
<TD>Working</TD>
<TD>Partial</TD> <TD>Partial</TD>
</TR> </TR>
@ -433,7 +441,7 @@ widgetset.
<TD>TO32FlexEdit<BR><IMG SRC="TO32FLEXEDIT.bmp"></TD> <TD>TO32FlexEdit<BR><IMG SRC="TO32FLEXEDIT.bmp"></TD>
<TD>TCustomEdit</TD> <TD>TCustomEdit</TD>
<TD>Edit control with validation</TD> <TD>Edit control with validation</TD>
<TD>See "To Do" list</TD> <TD>&nbsp;</TD>
<TD>Working</TD> <TD>Working</TD>
<TD>Working</TD> <TD>Working</TD>
<TD>Working</TD> <TD>Working</TD>
@ -542,7 +550,7 @@ widgetset.
<TD>TComponent</TD> <TD>TComponent</TD>
<TD>Table cell for displaying bitmap</TD> <TD>Table cell for displaying bitmap</TD>
<TD>&nbsp;</TD> <TD>&nbsp;</TD>
<TD>Crashes</TD> <TD>Working</TD>
<TD>Working</TD> <TD>Working</TD>
<TD>Working</TD> <TD>Working</TD>
<TD>Not working</TD> <TD>Not working</TD>
@ -615,38 +623,44 @@ However, TO32FlexEdit doesn't need TOvcController.<P>
<LI>TOvcLabel <LI>TOvcLabel
<UL> <UL>
<LI>Figure out why TOvcColorComboBox controls in Style Manager property editor <LI>Figure out why TOvcColorComboBox controls in Style Manager property editor
don't work. don't work on Windows.
<LI>Figure out why Color's default value (clNone) displays black <LI>Figure out why Color's default value (clNone) displays black
background with GTK. Workaround for now is to set TOvcLabel's background with GTK. Workaround for now is to set TOvcLabel's
ParentColor to True in Object Inspector or select a different Color. ParentColor to True in Object Inspector or select a different Color.
</UL> </UL>
<LI>TOvcVirtualListBox <LI>TOvcVirtualListBox
<UL> <UL>
<LI>Fix scrolling problems on Windows (not repainted right) and other platforms <LI><strike>Fix scrolling problems on Windows (not repainted right) and other platforms
(scrolls too many with each click of arrow). (scrolls too many with each click of arrow).</strike> &lt;==<I>Fixed in 0.2.0 release.</I>
<LI><strike>Figure out why double-click doesn't work on GTK.</strike> &lt;==Fixed. <LI><strike>Figure out why double-click doesn't work on GTK.</strike> &lt;==<I>Fixed.</I>
</UL> </UL>
<LI>TO32FlexEdit <LI>TO32FlexEdit
<UL> <UL>
<LI><strike>Figure out why, on Windows, presence of XP manifest prevents setting Text.</strike> <LI><strike>Figure out why, on Windows, presence of XP manifest prevents setting Text.</strike>
&lt;==Appears to be fixed with 20070401 Lazarus. &lt;==<I>Appears to be fixed with 20070401 Lazarus.</I>
<LI>Come up with workaround for LCL's lack of MakeObjectInstance for making <LI><strike>Come up with workaround for LCL's lack of MakeObjectInstance for making
callback function from method. Without this, control's validation is not callback function from method. Without this, control's validation is not
performed. &lt;==Workaround in 0.1.3 release fixes this on win32 widgetset. performed.</strike> &lt;==<I>Workaround in 0.1.3 release fixes this on win32 widgetset.</I>
&lt;==<I>Partial workaround in 0.2.0 release for other widgetsets is to call
SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0); in OnExit handler.
See TestFlexEdit example.</I>
<LI><strike>Can't tab out of control on Windows with win32 widgetset (tabbing works <LI><strike>Can't tab out of control on Windows with win32 widgetset (tabbing works
with qt widgetset on Windows though).</strike> &lt;==Fixed in 0.1.3 release. with qt widgetset on Windows though).</strike> &lt;==<I>Fixed in 0.1.3 release.</I>
</UL> </UL>
<LI>TOvcTable <LI>TOvcTable
<UL> <UL>
<LI><strike>Custom cursors not visible when sizing and moving columns and rows. <LI><strike>Custom cursors not visible when sizing and moving columns and rows.
Determine whether this is an LCL limitation.</strike> &lt;==Recently fixed in Determine whether this is an LCL limitation.</strike> &lt;==<I>Recently fixed in
Lazarus for Windows. Lazarus for Windows.</I>
<LI>Sizing and moving columns and rows doesn't work at all with GTK. <LI>Sizing and moving columns and rows doesn't work at all with GTK or Carbon.
Determine whether this is a GTK limitation. Determine whether this is a GTK/Carbon limitation.
<LI>Table scroll bar "thumb" extends entire length of scrollbar with GTK <LI><strike>Table scroll bar "thumb" extends entire length of scrollbar with GTK.</strike>
(same problem with TScrollBar on GTK). Determine if this is a GTK limitation. &lt;==<I>Fixed in 0.2.0 release.</I>
<LI>Figure out how to move edit cell to stay with its row when scrolling <LI>Figure out how to move edit cell to stay with its row when scrolling
table (GTK only). table (non-Windows only).
<LI>Figure out why scrolling table with keyboard doesn't repaint table with Carbon.
Possibly related to TestTable issue with Carbon where selecting a .bmp in the
combo box cell doesn't display the bitmap in the next column until form is resized.
</UL> </UL>
<LI>TOvcTCComboBox <LI>TOvcTCComboBox
<UL> <UL>
@ -655,20 +669,21 @@ However, TO32FlexEdit doesn't need TOvcController.<P>
</UL> </UL>
<LI>TO32TCFlexEdit <LI>TO32TCFlexEdit
<UL> <UL>
<LI>Need a way of setting OnValidationError handler (an apparent omission <LI><strike>Need a way of setting OnValidationError handler (an apparent omission
since TO32FlexEdit has it). For now, you can display error message in since TO32FlexEdit has it).</strike> &lt;==<I>Workaround in 0.2.0 release is to
OnUserValidation handler. set TO32TCFlexEditEditor(Sender).OnValidationError in UserValidation handler.</I>
</UL> </UL>
<LI>TOvcSimpleField and TOvcTCSimpleField <LI>TOvcSimpleField and TOvcTCSimpleField
<UL> <UL>
<LI>Recent improvements in GTK and Carbon widgetsets mean these controls no <LI>Recent improvements in GTK and Carbon widgetsets mean these controls no
longer crash programs when they're used. However, they don't yet work as edit longer crash programs when they're used. However, they don't yet work as edit
controls. Determine whether this means more improvement in widgetsets is needed. controls. Determine whether this means more improvement in widgetsets is needed.
(Use TO32FlexEdit and TO32TCFlexExit in the meantime.)
</UL> </UL>
<LI>TOvcTCBitMap <LI>TOvcTCBitMap
<UL> <UL>
<LI>This previously worked, but changes to Lazarus LCL now cause it to crash <LI><strike>This previously worked, but changes to Lazarus LCL now cause it to crash
when cell gets focus (win32 only). when cell gets focus (win32 only).</strike> &lt;==<I>Fixed in 0.2.0 release.</I>
</UL> </UL>
<LI>TOvcController <LI>TOvcController
<UL> <UL>
@ -691,7 +706,7 @@ OS X tips for Lazarus:<P>
<P> <P>
<HR> <HR>
Last updated: March 16, 2008 Last updated: July 20, 2008
<P> <P>
</BODY> </BODY>

15
components/orpheus/alltests-carbon.sh Normal file
View File

@ -0,0 +1,15 @@
#!/bin/sh
lazdir=~/lazarus
if ! [ -e $lazdir ]
then
lazdir=/usr/local/share/lazarus
fi
$lazdir/lazbuild -d --ws=carbon tests/TestFlexEdit/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestLabel/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestRLbl/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestSimpField/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestSpinner/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestTable/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestTblEdits/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestURL/project1.lpi
$lazdir/lazbuild -d --ws=carbon tests/TestVLB/project1.lpi

15
components/orpheus/alltests-gtk.sh Normal file
View File

@ -0,0 +1,15 @@
#!/bin/sh
lazdir=~/lazarus
if ! [ -e $lazdir ]
then
lazdir=/usr/local/share/lazarus
fi
$lazdir/lazbuild -d --ws=gtk tests/TestFlexEdit/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestLabel/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestRLbl/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestSimpField/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestSpinner/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestTable/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestTblEdits/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestURL/project1.lpi
$lazdir/lazbuild -d --ws=gtk tests/TestVLB/project1.lpi

11
components/orpheus/alltests-win.bat Normal file
View File

@ -0,0 +1,11 @@
set lazpath="c:\tools\lazarus"
if not exist %lazpath% (set lazpath="c:\lazarus")
"%lazpath%\lazbuild" -d tests/TestFlexEdit/project1.lpi
"%lazpath%\lazbuild" -d tests/TestLabel/project1.lpi
"%lazpath%\lazbuild" -d tests/TestRLbl/project1.lpi
"%lazpath%\lazbuild" -d tests/TestSimpField/project1.lpi
"%lazpath%\lazbuild" -d tests/TestSpinner/project1.lpi
"%lazpath%\lazbuild" -d tests/TestTable/project1.lpi
"%lazpath%\lazbuild" -d tests/TestTblEdits/project1.lpi
"%lazpath%\lazbuild" -d tests/TestURL/project1.lpi
"%lazpath%\lazbuild" -d tests/TestVLB/project1.lpi

60
components/orpheus/mymisc.pas
View File

@ -266,6 +266,7 @@ function GetSystemMetrics(nIndex: Integer): Integer;
function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL; function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
X, Y, cx, cy: Integer; uFlags: UINT): BOOL; X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
function UpdateWindow(hWnd: HWND): BOOL;
function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL; function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL; function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
@ -291,7 +292,7 @@ function SetTextAlign(DC: HDC; Flags: UINT): UINT;
function GetMapMode(DC: HDC): Integer; function GetMapMode(DC: HDC): Integer;
function SetMapMode(DC: HDC; p2: Integer): Integer; function SetMapMode(DC: HDC; p2: Integer): Integer;
//function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP; //function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR; //function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL; function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
procedure OutputDebugString(lpOutputString: PChar); procedure OutputDebugString(lpOutputString: PChar);
function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL; function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
@ -312,7 +313,7 @@ procedure RecreateWnd(const AWinControl:TWinControl);
//procedure DeallocateHWnd(Wnd: HWND); //procedure DeallocateHWnd(Wnd: HWND);
{This belongs in System unit} {This belongs in System unit}
function FindClassHInstance(ClassType: TClass): LongWord; //function FindClassHInstance(ClassType: TClass): LongWord;
{This belongs in ExtCtrls unit} {This belongs in ExtCtrls unit}
procedure Frame3D(Canvas: TCanvas; var Rect: TRect; procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
@ -502,6 +503,15 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function UpdateWindow(hWnd: HWND): BOOL;
{For some reason, implementing this function in win32 widgetset
on 27-May-2008 broke TOvcTable when a manifest is used.
Since TOvcTable worked when this function was not implemented,
just intercept and ignore call for now.}
begin
Result := True;
end;
function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL; function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
// Since LCL InvalidateRect redraws window, shouldn't need this function, // Since LCL InvalidateRect redraws window, shouldn't need this function,
// so leave it as stub for now. // so leave it as stub for now.
@ -696,17 +706,61 @@ begin
Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions, Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions,
lpnTabStopPositions); lpnTabStopPositions);
{$ELSE} {$ELSE}
Result := 0; //Not implemented yet (see comment below).
{$ENDIF} {$ENDIF}
end; end;
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
nCount, nTabPositions: Integer; nCount, nTabPositions: Integer;
var lpnTabStopPositions; nTabOrigin: Integer): Longint; var lpnTabStopPositions; nTabOrigin: Integer): Longint;
begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
begin
Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions, Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions,
lpnTabStopPositions, nTabOrigin); lpnTabStopPositions, nTabOrigin);
{$ELSE} {$ELSE}
// TODO: Not yet implemented since not needed by Orpheus:
// -Special case where nTabPositions is 0 and lpnTabStopPositions is nil.
// -Special case where nTabPositions is 1 and >1 tab in string.
// -Return value (height and width of string).
// -Use of nTabOrigin. This is used in OvcVLB as a negative offset
// with horizontal scrolling, but value passed is determined by
// GetTabbedTextExtent, which is not yet implemented (above). Shouldn't
// be needed if virtual list box doesn't have horizontal scrollbar.
type
TTabArray = array[1..1000] of Integer; {Assume no more than this many tabs}
var
OutX : Integer;
TabCnt : Integer;
StartPos : Integer;
CharPos : Integer;
OutCnt : Integer;
TextSize : TSize;
begin
OutX := X;
TabCnt := 0;
StartPos := 0;
for CharPos := 0 to Pred(nCount) do
begin
if (lpString[CharPos] = #9) or (CharPos = Pred(nCount)) then {Output text?}
begin
OutCnt := CharPos - StartPos;
if CharPos = Pred(nCount) then {Include last char?}
Inc(OutCnt);
if (TabCnt > 0) and (TTabArray(lpnTabStopPositions)[TabCnt] < 0) then
begin {Negative tab position means following text is right-aligned to it}
GetTextExtentPoint(hDC, lpString+StartPos, OutCnt, TextSize);
OutX := X + Abs(TTabArray(lpnTabStopPositions)[TabCnt]) - TextSize.cx;
end;
LclIntf.TextOut(hDC, OutX, Y, lpString+StartPos, OutCnt);
StartPos := Succ(CharPos);
if (lpString[CharPos] = #9) and (TabCnt < nTabPositions) then
begin
Inc(TabCnt);
OutX := X + TTabArray(lpnTabStopPositions)[TabCnt];
end;
end;
end;
Result := 0; //Just return this for now.
{$ENDIF} {$ENDIF}
end; end;

7
components/orpheus/o32flxed.pas
View File

@ -858,7 +858,8 @@ begin
result := false result := false
else else
result := true; result := true;
end else end; { else } //Commented out; otherwise our validation handler never
// gets called if Text is blank - TurboPower bug?.
if Assigned(FOnUserValidation) then if Assigned(FOnUserValidation) then
FOnUserValidation(Self, result); FOnUserValidation(Self, result);
@ -1237,6 +1238,10 @@ procedure TO32CustomFlexEdit.SetAlignment(Value: TAlignment);
var var
Str: string; Str: string;
begin begin
{$IFDEF LCL}
if Value <> taLeftJustify then
Exit; {taCenter and taRightJustify not supported and crash IDE, so ignore}
{$ENDIF}
if FAlignment <> Value then if FAlignment <> Value then
begin begin
Str := Text; Str := Text;

20
components/orpheus/o32tcflx.pas
View File

@ -555,7 +555,10 @@ begin
Result := ValidateEntry Result := ValidateEntry
else begin else begin
FEdit.Restore; FEdit.Restore;
result := false; // result := false; //TurboPower bug? Inconsistent with
//TOvcTCBaseEntryField.CanSaveEditedData and
//p.928 of Orpheus.pdf. Prevents TOvcTable's
//StopEditingState from completing if SaveValue=False.
end; end;
end; end;
{=====} {=====}
@ -564,8 +567,22 @@ function TO32TCCustomFlexEdit.ValidateEntry: Boolean;
begin begin
if Assigned(FOnUserValidation) then begin if Assigned(FOnUserValidation) then begin
FOnUserValidation(FEdit, FEdit.Text, result); FOnUserValidation(FEdit, FEdit.Text, result);
// if Validation.BeepOnError then MessageBeep(0); <== TurboPower bug? not checking result // if Validation.BeepOnError then MessageBeep(0); <== TurboPower bug? not checking result
if (not result) and Validation.BeepOnError then MessageBeep(0); //Fixed if (not result) and Validation.BeepOnError then MessageBeep(0); //Fixed
// Another TurboPower omission? Since OnError not published the way
// OnUserValidation is, no way to display error if validation fails
// (and displaying error in OnUserValidation handler causes problems).
// Next two lines added to remedy this. In OnUserValidation handler,
// you can set TO32TCFlexEditEditor(Sender).OnValidationError to have
// your error method called here. Note that you can also call
// TO32TCFlexEditEditor(Sender).Validation.SetLastErrorCode in your
// OnUserValidation handler to set the error passed in ErrorCode to
// your OnValidationError method.
if (not result) and Assigned(FEdit.FOnValidationError) then
FEdit.FOnValidationError(FEdit, FEdit.Validation.LastErrorCode, 'Invalid input');
exit; exit;
end; end;
@ -651,6 +668,7 @@ begin
CellOwner := Self; CellOwner := Self;
Hint := Self.Hint; Hint := Self.Hint;
ShowHint := Self.ShowHint; ShowHint := Self.ShowHint;
Tag := Self.Tag; //TurboPower omission? Might be useful to know this too.
{Str := PAnsiChar(Data);} {!!!} {Str := PAnsiChar(Data);} {!!!}
if (Data = nil) then if (Data = nil) then

2
components/orpheus/orpheus.lpk
View File

@ -31,7 +31,7 @@
"/> "/>
<License Value="MPL 1.1 <License Value="MPL 1.1
"/> "/>
<Version Minor="1" Release="9"/> <Version Minor="2" Release="0"/>
<Files Count="1"> <Files Count="1">
<Item1> <Item1>
<Filename Value="myovcreg.pas"/> <Filename Value="myovcreg.pas"/>

4
components/orpheus/ovccalc.pas
View File

@ -2048,7 +2048,11 @@ var
procedure SetNewCursor(C : HCursor); procedure SetNewCursor(C : HCursor);
begin begin
{$IFNDEF LCL}
SetCursor(C); SetCursor(C);
{$ELSE}
LclIntf.SetCursor(C); {Don't call control's SetCursor!}
{$ENDIF}
Msg.Result := Ord(True); Msg.Result := Ord(True);
end; end;

4
components/orpheus/ovcmisc.pas
View File

@ -65,9 +65,9 @@ type
{$IFNDEF LCL} {$IFNDEF LCL}
function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP; function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
{-load and return the handle to bitmap resource} {-load and return the handle to bitmap resource}
{$ENDIF}
function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR; function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
{-load and return the handle to cursor resource} {-load and return the handle to cursor resource}
{$ENDIF}
function CompStruct(const S1, S2; Size : Cardinal) : Integer; function CompStruct(const S1, S2; Size : Cardinal) : Integer;
{-compare two fixed size structures} {-compare two fixed size structures}
function DefaultEpoch : Integer; function DefaultEpoch : Integer;
@ -161,12 +161,12 @@ function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
begin begin
Result := LoadBitmap(FindClassHInstance(TOvcCustomControlEx), lpBitmapName); Result := LoadBitmap(FindClassHInstance(TOvcCustomControlEx), lpBitmapName);
end; end;
{$ENDIF}
function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR; function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
begin begin
Result := LoadCursor(FindClassHInstance(TOvcCustomControlEx), lpCursorName); Result := LoadCursor(FindClassHInstance(TOvcCustomControlEx), lpCursorName);
end; end;
{$ENDIF}
{$IFDEF NoAsm} {$IFDEF NoAsm}
function CompStruct(const S1, S2; Size : Cardinal) : Integer; function CompStruct(const S1, S2; Size : Cardinal) : Integer;

51
components/orpheus/ovctable.pas
View File

@ -807,8 +807,15 @@ constructor TOvcCustomTable.Create(AOwner : TComponent);
FTopRow := tbDefLockedRows; FTopRow := tbDefLockedRows;
FSelAnchorRow := tbDefLockedRows; FSelAnchorRow := tbDefLockedRows;
{$IFNDEF LCL}
tbColMoveCursor := LoadBaseCursor('ORCOLUMNMOVECURSOR'); tbColMoveCursor := LoadBaseCursor('ORCOLUMNMOVECURSOR');
tbRowMoveCursor := LoadBaseCursor('ORROWMOVECURSOR'); tbRowMoveCursor := LoadBaseCursor('ORROWMOVECURSOR');
{$ELSE}
{$IFDEF MSWINDOWS} //Has never worked, plus crashes Carbon, so leave out for now.
tbColMoveCursor := LoadCursorFromLazarusResource('ORCOLUMNMOVECURSOR');
tbRowMoveCursor := LoadCursorFromLazarusResource('ORROWMOVECURSOR');
{$ENDIF}
{$ENDIF}
tbSelList := TOvcSelectionList.Create(tbDefRowCount, tbDefColCount); tbSelList := TOvcSelectionList.Create(tbDefRowCount, tbDefColCount);
@ -1806,12 +1813,16 @@ procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
ColNum : TColNum; ColNum : TColNum;
ColCnt : TColNum; ColCnt : TColNum;
Divisor : LongInt; Divisor : LongInt;
{$IFNDEF MSWINDOWS}
SI : TScrollInfo;
{$ENDIF}
begin begin
if (SB = otsbVertical) then if (SB = otsbVertical) then
begin begin
if tbHasVSBar then if tbHasVSBar then
if HandleAllocated and (tbLockCount = 0) then if HandleAllocated and (tbLockCount = 0) then
begin begin
{$IFDEF MSWINDOWS}
if (tbLastTopRow < 16*1024) then if (tbLastTopRow < 16*1024) then
SetScrollPos(Handle, SB_VERT, TopRow, true) SetScrollPos(Handle, SB_VERT, TopRow, true)
else else
@ -1824,6 +1835,12 @@ procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
TopRow div Divisor, TopRow div Divisor,
True); True);
end end
{$ELSE}
SI.fMask := SIF_POS;
SI.nPos := TopRow;
SI.nTrackPos := SI.nPos;
SetScrollInfo(Handle, SB_Vert, SI, True);
{$ENDIF}
end end
else else
tbUpdateSBs := true; tbUpdateSBs := true;
@ -1837,7 +1854,14 @@ procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
for ColNum := LockedCols to pred(LeftCol) do for ColNum := LockedCols to pred(LeftCol) do
if not tbIsColHidden(ColNum) then if not tbIsColHidden(ColNum) then
inc(ColCnt); inc(ColCnt);
{$IFDEF MSWINDOWS}
SetScrollPos(Handle, SB_HORZ, ColCnt, true) SetScrollPos(Handle, SB_HORZ, ColCnt, true)
{$ELSE}
SI.fMask := SIF_POS;
SI.nPos := ColCnt;
SI.nTrackPos := SI.nPos;
SetScrollInfo(Handle, SB_Horz, SI, True);
{$ENDIF}
end end
else else
tbUpdateSBs := true; tbUpdateSBs := true;
@ -1848,6 +1872,9 @@ procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar); procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
var var
Divisor : LongInt; Divisor : LongInt;
{$IFNDEF MSWINDOWS}
SI : TScrollInfo;
{$ENDIF}
begin begin
if (SB = otsbVertical) then if (SB = otsbVertical) then
begin begin
@ -1855,6 +1882,7 @@ procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
tbCalcRowsOnLastPage; tbCalcRowsOnLastPage;
if tbHasVSBar and HandleAllocated then if tbHasVSBar and HandleAllocated then
begin begin
{$IFDEF MSWINDOWS}
// tbCalcRowsOnLastPage; // tbCalcRowsOnLastPage;
if (tbLastTopRow < 16*1024) then if (tbLastTopRow < 16*1024) then
if tbCalcRequiresVSBar then if tbCalcRequiresVSBar then
@ -1871,6 +1899,15 @@ procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
tbLastTopRow div Divisor, tbLastTopRow div Divisor,
False) False)
end; end;
{$ELSE}
SI.fMask := SIF_RANGE or SIF_PAGE;
SI.nMin := LockedRows;
SI.nMax := Pred(RowLimit);
SI.nPage := (ClientHeight div Rows[LockedRows].Height) - LockedRows;
if SI.nPage < 1 then
SI.nPage := 1;
SetScrollInfo(Handle, SB_Vert, SI, True);
{$ENDIF}
end end
end end
else {SB = otsbHorizontal} else {SB = otsbHorizontal}
@ -1878,8 +1915,18 @@ procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
tbCalcColsOnLastPage; tbCalcColsOnLastPage;
if tbHasHSBar and HandleAllocated then if tbHasHSBar and HandleAllocated then
begin begin
{$IFDEF MSWINDOWS}
tbCalcHSBarPosCount; tbCalcHSBarPosCount;
SetScrollRange(Handle, SB_HORZ, 0, pred(tbHSBarPosCount), false); SetScrollRange(Handle, SB_HORZ, 0, pred(tbHSBarPosCount), false);
{$ELSE}
SI.fMask := SIF_RANGE or SIF_PAGE;
SI.nMin := 0;
SI.nMax := Pred(ColCount) - LockedCols;
SI.nPage := ColCount div 3;
if SI.nPage < 1 then
SI.nPage := 1;
SetScrollInfo(Handle, SB_Horz, SI, True);
{$ENDIF}
end; end;
end; end;
end; end;
@ -6205,7 +6252,11 @@ procedure TOvcCustomTable.WMSetCursor(var Msg : TWMSetCursor);
tbState := tbState - [otsShowMove, otsShowSize, otsDoingRow, otsDoingCol] tbState := tbState - [otsShowMove, otsShowSize, otsDoingRow, otsDoingCol]
+ [otsNormal]; + [otsNormal];
end; end;
{$IFNDEF LCL}
SetCursor(NewCursor); SetCursor(NewCursor);
{$ELSE}
LclIntf.SetCursor(NewCursor); {Don't call control's SetCursor!}
{$ENDIF}
Msg.Result := 1; Msg.Result := 1;
end; end;

27
components/orpheus/ovcvlb.pas
View File

@ -63,7 +63,11 @@ const
vlDefIntegralHeight = True; vlDefIntegralHeight = True;
vlDefItemIndex = -1; vlDefItemIndex = -1;
vlDefMultiSelect = False; vlDefMultiSelect = False;
vlDefNumItems = MaxLongInt; {$IFDEF MSWINDOWS}
vlDefNumItems = MaxLongInt; //2,147,483,647
{$ELSE}
vlDefNumItems = 126322582; //Apparent max. scrollbar positions with Carbon.
{$ENDIF} // GTK apparently allows 2,115,747,484.
vlDefOwnerDraw = False; vlDefOwnerDraw = False;
vlDefParentColor = False; vlDefParentColor = False;
vlDefParentCtl3D = True; vlDefParentCtl3D = True;
@ -1471,7 +1475,11 @@ var
begin begin
if Value <> FNumItems then begin if Value <> FNumItems then begin
if (Value < 0) then if (Value < 0) then
{$IFDEF MSWINDOWS}
Value := MaxLongInt; Value := MaxLongInt;
{$ELSE}
Value := vlDefNumItems;
{$ENDIF}
OldNumItems := FNumItems; OldNumItems := FNumItems;
{set new item index} {set new item index}
@ -1589,8 +1597,10 @@ begin
{$IFNDEF LCL} {$IFNDEF LCL}
if GetClipBox(Canvas.Handle, ClipBox) <> SIMPLEREGION then if GetClipBox(Canvas.Handle, ClipBox) <> SIMPLEREGION then
{$ELSE} {$ELSE} //Something about code below doesn't work so just always InvalidateRect
if GetClipBox(Canvas.Handle, @ClipBox) <> SIMPLEREGION then // for now as workaround. If bug is in ScrollCanvas, then InsertItemsAt
// and DeleteItemsAt will probably also need a similar workaround.
if GetClipBox(Canvas.Handle, @ClipBox) <> Region_Error then
{$ENDIF} {$ENDIF}
InvalidateRect(Handle, @ClipArea, True) InvalidateRect(Handle, @ClipArea, True)
else begin else begin
@ -2027,12 +2037,17 @@ begin
lDivisor := 1; lDivisor := 1;
if ItemRange < lRows then if ItemRange < lRows then
lVSHigh := 1 lVSHigh := 1
{$IFDEF MSWINDOWS}
else if ItemRange <= High(SmallInt) then else if ItemRange <= High(SmallInt) then
lVSHigh := ItemRange lVSHigh := ItemRange
else begin else begin
lDivisor := 2*(ItemRange div 32768); lDivisor := 2*(ItemRange div 32768);
lVSHigh := ItemRange div lDivisor; lVSHigh := ItemRange div lDivisor;
end; end;
{$ELSE} //lDivisor not needed apparently (and causes clicks to scroll >1 item).
else
lVSHigh := ItemRange;
{$ENDIF}
if lHaveVS then if lHaveVS then
if not ((FNumItems > lRows) or (csDesigning in ComponentState)) then if not ((FNumItems > lRows) or (csDesigning in ComponentState)) then
@ -2450,6 +2465,12 @@ begin
{integral font height adjustment} {integral font height adjustment}
vlbCalcFontFields; vlbCalcFontFields;
vlbAdjustIntegralHeight; vlbAdjustIntegralHeight;
{$IFDEF LCL} //Make sure calling code knows about any change in height.
if (csDesigning in ComponentState) and
not (csLoading in ComponentState) then
if FIntegralHeight then
Msg.Height := ClientHeight;
{$ENDIF}
vlbCalcFontFields; vlbCalcFontFields;
vlbInitScrollInfo; vlbInitScrollInfo;

18
components/orpheus/tests/TestFlexEdit/unit1.dfm
View File

@ -15,24 +15,26 @@ object Form1: TForm1
TextHeight = 13 TextHeight = 13
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Top = 24 Top = 16
Width = 385 Width = 385
Height = 33 Height = 41
Alignment = taCenter Alignment = taCenter
AutoSize = False AutoSize = False
Caption = 'Enter a positive integer, then move to next control to validate.' Caption =
'Enter a positive integer, then move to next control to validate ' +
'the number.'
WordWrap = True WordWrap = True
end end
object Label2: TLabel object Label2: TLabel
Left = 16 Left = 16
Top = 104 Top = 120
Width = 385 Width = 385
Height = 33 Height = 41
Alignment = taCenter Alignment = taCenter
AutoSize = False AutoSize = False
Caption = Caption =
'Enter a positive real number, then move to next control to valid' + 'Enter a positive real number, then move to next control to valid' +
'ate.' 'ate the number.'
WordWrap = True WordWrap = True
end end
object O32FlexEdit1: TO32FlexEdit object O32FlexEdit1: TO32FlexEdit
@ -53,12 +55,13 @@ object Form1: TForm1
Validation.ValidatorType = 'None' Validation.ValidatorType = 'None'
Validation.ValidationType = vtUser Validation.ValidationType = vtUser
Validation.InputRequired = False Validation.InputRequired = False
OnExit = O32FlexEditExit
OnUserValidation = O32FlexEdit1UserValidation OnUserValidation = O32FlexEdit1UserValidation
OnValidationError = O32FlexEditValidationError OnValidationError = O32FlexEditValidationError
end end
object O32FlexEdit2: TO32FlexEdit object O32FlexEdit2: TO32FlexEdit
Left = 168 Left = 168
Top = 136 Top = 160
Width = 81 Width = 81
Height = 21 Height = 21
EfColors.Disabled.BackColor = clWindow EfColors.Disabled.BackColor = clWindow
@ -74,6 +77,7 @@ object Form1: TForm1
Validation.ValidatorType = 'None' Validation.ValidatorType = 'None'
Validation.ValidationType = vtUser Validation.ValidationType = vtUser
Validation.InputRequired = False Validation.InputRequired = False
OnExit = O32FlexEditExit
OnUserValidation = O32FlexEdit2UserValidation OnUserValidation = O32FlexEdit2UserValidation
OnValidationError = O32FlexEditValidationError OnValidationError = O32FlexEditValidationError
end end

18
components/orpheus/tests/TestFlexEdit/unit1.lfm
View File

@ -12,24 +12,26 @@ object Form1: TForm1
PixelsPerInch = 96 PixelsPerInch = 96
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Top = 24 Top = 16
Width = 385 Width = 385
Height = 33 Height = 41
Alignment = taCenter Alignment = taCenter
AutoSize = False AutoSize = False
Caption = 'Enter a positive integer, then move to next control to validate.' Caption =
'Enter a positive integer, then move to next control to validate ' +
'the number.'
WordWrap = True WordWrap = True
end end
object Label2: TLabel object Label2: TLabel
Left = 16 Left = 16
Top = 104 Top = 120
Width = 385 Width = 385
Height = 33 Height = 41
Alignment = taCenter Alignment = taCenter
AutoSize = False AutoSize = False
Caption = Caption =
'Enter a positive real number, then move to next control to valid' + 'Enter a positive real number, then move to next control to valid' +
'ate.' 'ate the number.'
WordWrap = True WordWrap = True
end end
object O32FlexEdit1: TO32FlexEdit object O32FlexEdit1: TO32FlexEdit
@ -50,12 +52,13 @@ object Form1: TForm1
Validation.ValidatorType = 'None' Validation.ValidatorType = 'None'
Validation.ValidationType = vtUser Validation.ValidationType = vtUser
Validation.InputRequired = False Validation.InputRequired = False
OnExit = O32FlexEditExit
OnUserValidation = O32FlexEdit1UserValidation OnUserValidation = O32FlexEdit1UserValidation
OnValidationError = O32FlexEditValidationError OnValidationError = O32FlexEditValidationError
end end
object O32FlexEdit2: TO32FlexEdit object O32FlexEdit2: TO32FlexEdit
Left = 168 Left = 168
Top = 136 Top = 160
Width = 81 Width = 81
Height = 21 Height = 21
EfColors.Disabled.BackColor = clWindow EfColors.Disabled.BackColor = clWindow
@ -71,6 +74,7 @@ object Form1: TForm1
Validation.ValidatorType = 'None' Validation.ValidatorType = 'None'
Validation.ValidationType = vtUser Validation.ValidationType = vtUser
Validation.InputRequired = False Validation.InputRequired = False
OnExit = O32FlexEditExit
OnUserValidation = O32FlexEdit2UserValidation OnUserValidation = O32FlexEdit2UserValidation
OnValidationError = O32FlexEditValidationError OnValidationError = O32FlexEditValidationError
end end

51
components/orpheus/tests/TestFlexEdit/unit1.lrs
View File

@ -3,29 +3,30 @@ LazarusResources.Add('TForm1','FORMDATA',[
+'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7 +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
+#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245 +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
+#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2 +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2
+#16#3'Top'#2#24#5'Width'#3#129#1#6'Height'#2'!'#9'Alignment'#7#8'taCenter'#8 +#16#3'Top'#2#16#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
+'AutoSize'#8#7'Caption'#6'@Enter a positive integer, then move to next contr' +'AutoSize'#8#7'Caption'#6'KEnter a positive integer, then move to next contr'
+'ol to validate.'#8'WordWrap'#9#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#3'Top'#2 +'ol to validate the number.'#8'WordWrap'#9#0#0#6'TLabel'#6'Label2'#4'Left'#2
+'h'#5'Width'#3#129#1#6'Height'#2'!'#9'Alignment'#7#8'taCenter'#8'AutoSize'#8 +#16#3'Top'#2'x'#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
+#7'Caption'#6'DEnter a positive real number, then move to next control to va' +'AutoSize'#8#7'Caption'#6'OEnter a positive real number, then move to next c'
+'lidate.'#8'WordWrap'#9#0#0#12'TO32FlexEdit'#12'O32FlexEdit1'#4'Left'#3#168#0 +'ontrol to validate the number.'#8'WordWrap'#9#0#0#12'TO32FlexEdit'#12'O32Fl'
+#3'Top'#2'8'#5'Width'#2'Q'#6'Height'#2#21#27'EfColors.Disabled.BackColor'#7#8 +'exEdit1'#4'Left'#3#168#0#3'Top'#2'8'#5'Width'#2'Q'#6'Height'#2#21#27'EfColo'
+'clWindow'#27'EfColors.Disabled.TextColor'#7#10'clGrayText'#24'EfColors.Erro' +'rs.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7#10'c'
+'r.BackColor'#7#5'clRed'#24'EfColors.Error.TextColor'#7#7'clBlack'#28'EfColo' +'lGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.TextCo'
+'rs.Highlight.BackColor'#7#11'clHighlight'#28'EfColors.Highlight.TextColor'#7 +'lor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28'EfC'
+#15'clHighlightText'#8'TabOrder'#2#0#22'Validation.BeepOnError'#9#25'Validat' +'olors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#0#22'Validat'
+'ion.SoftValidation'#8#26'Validation.ValidationEvent'#7#8'veOnExit'#24'Valid' +'ion.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validation'
+'ation.ValidatorType'#6#4'None'#25'Validation.ValidationType'#7#6'vtUser'#24 +'Event'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validation.V'
+'Validation.InputRequired'#8#16'OnUserValidation'#7#26'O32FlexEdit1UserValid' +'alidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15'O3'
+'ation'#17'OnValidationError'#7#26'O32FlexEditValidationError'#0#0#12'TO32Fl' +'2FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit1UserValidation'#17'OnV'
+'exEdit'#12'O32FlexEdit2'#4'Left'#3#168#0#3'Top'#3#136#0#5'Width'#2'Q'#6'Hei' +'alidationError'#7#26'O32FlexEditValidationError'#0#0#12'TO32FlexEdit'#12'O3'
+'ght'#2#21#27'EfColors.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disable' +'2FlexEdit2'#4'Left'#3#168#0#3'Top'#3#160#0#5'Width'#2'Q'#6'Height'#2#21#27
+'d.TextColor'#7#10'clGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'Ef' +'EfColors.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7
+'Colors.Error.TextColor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11 +#10'clGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.Te'
+'clHighlight'#28'EfColors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOr' +'xtColor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28
+'der'#2#1#22'Validation.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Va' +'EfColors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#1#22'Vali'
+'lidation.ValidationEvent'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'No' +'dation.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validat'
+'ne'#25'Validation.ValidationType'#7#6'vtUser'#24'Validation.InputRequired'#8 +'ionEvent'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validatio'
+#16'OnUserValidation'#7#26'O32FlexEdit2UserValidation'#17'OnValidationError' +'n.ValidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15
+#7#26'O32FlexEditValidationError'#0#0#0 +'O32FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit2UserValidation'#17'O'
+'nValidationError'#7#26'O32FlexEditValidationError'#0#0#0
]); ]);

30
components/orpheus/tests/TestFlexEdit/unit1.pas
View File

@ -5,7 +5,7 @@ interface
uses uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF} {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
SysUtils, Variants, Classes, Graphics, Controls, Forms, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, o32editf, o32flxed; Dialogs, StdCtrls, ovcdata, o32editf, o32flxed;
type type
TForm1 = class(TForm) TForm1 = class(TForm)
@ -15,10 +15,11 @@ type
O32FlexEdit2: TO32FlexEdit; O32FlexEdit2: TO32FlexEdit;
procedure O32FlexEdit1UserValidation(Sender: TObject; procedure O32FlexEdit1UserValidation(Sender: TObject;
var ValidEntry: Boolean); var ValidEntry: Boolean);
procedure O32FlexEditValidationError(Sender: TObject; ErrorCode: Word;
ErrorMsg: String);
procedure O32FlexEdit2UserValidation(Sender: TObject; procedure O32FlexEdit2UserValidation(Sender: TObject;
var ValidEntry: Boolean); var ValidEntry: Boolean);
procedure O32FlexEditValidationError(Sender: TObject; ErrorCode: Word;
ErrorMsg: String);
procedure O32FlexEditExit(Sender: TObject);
private private
{ Private declarations } { Private declarations }
public public
@ -37,7 +38,19 @@ implementation
procedure TForm1.O32FlexEdit1UserValidation(Sender: TObject; procedure TForm1.O32FlexEdit1UserValidation(Sender: TObject;
var ValidEntry: Boolean); var ValidEntry: Boolean);
begin begin
ValidEntry := StrToIntDef(TO32FlexEdit(Sender).Text, 0) > 0; if TO32FlexEdit(Sender).Text = '' then
ValidEntry := True
else
ValidEntry := StrToIntDef(TO32FlexEdit(Sender).Text, 0) > 0;
end;
procedure TForm1.O32FlexEdit2UserValidation(Sender: TObject;
var ValidEntry: Boolean);
begin
if TO32FlexEdit(Sender).Text = '' then
ValidEntry := True
else
ValidEntry := StrToFloatDef(TO32FlexEdit(Sender).Text, 0) > 0;
end; end;
procedure TForm1.O32FlexEditValidationError(Sender: TObject; procedure TForm1.O32FlexEditValidationError(Sender: TObject;
@ -46,10 +59,13 @@ begin
MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0); MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
end; end;
procedure TForm1.O32FlexEdit2UserValidation(Sender: TObject; procedure TForm1.O32FlexEditExit(Sender: TObject);
var ValidEntry: Boolean);
begin begin
ValidEntry := StrToFloatDef(TO32FlexEdit(Sender).Text, 0) > 0; {$IFNDEF MSWINDOWS}
{TO32FlexEdit OnUserValidation doesn't work, so validate here
so user is notified if error, even though focus will change.}
SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0);
{$ENDIF}
end; end;
initialization initialization

15
components/orpheus/tests/TestTable/unit1.dfm
View File

@ -1,7 +1,7 @@
object Form1: TForm1 object Form1: TForm1
Left = 192 Left = 192
Top = 114 Top = 114
Width = 776 Width = 816
Height = 480 Height = 480
Caption = 'Form1' Caption = 'Form1'
Color = clBtnFace Color = clBtnFace
@ -11,17 +11,18 @@ object Form1: TForm1
Font.Name = 'Arial' Font.Name = 'Arial'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
DesignSize = ( DesignSize = (
768 808
446) 446)
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 14 TextHeight = 14
object OvcTable1: TOvcTable object OvcTable1: TOvcTable
Left = 16 Left = 16
Top = 16 Top = 16
Width = 737 Width = 777
Height = 409 Height = 409
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Color = clWindow Color = clWindow
@ -53,11 +54,11 @@ object Form1: TForm1
RowData = ( RowData = (
35) 35)
ColData = ( ColData = (
110 120
False False
True True
'Form1.OvcTCRowHead1' 'Form1.OvcTCRowHead1'
90 100
False False
True True
'Form1.OvcTCString1' 'Form1.OvcTCString1'
@ -65,7 +66,7 @@ object Form1: TForm1
False False
True True
'Form1.OvcTCMemo1' 'Form1.OvcTCMemo1'
110 120
False False
True True
'Form1.OvcTCCheckBox1' 'Form1.OvcTCCheckBox1'
@ -73,7 +74,7 @@ object Form1: TForm1
False False
True True
'Form1.OvcTCComboBox1' 'Form1.OvcTCComboBox1'
90 100
False False
True True
'Form1.OvcTCBitMap1') 'Form1.OvcTCBitMap1')

13
components/orpheus/tests/TestTable/unit1.lfm
View File

@ -1,7 +1,7 @@
object Form1: TForm1 object Form1: TForm1
Left = 192 Left = 192
Top = 114 Top = 114
Width = 768 Width = 808
Height = 446 Height = 446
Caption = 'Form1' Caption = 'Form1'
Color = clBtnFace Color = clBtnFace
@ -9,13 +9,14 @@ object Form1: TForm1
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Style = [] Font.Style = []
Position = poScreenCenter
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
PixelsPerInch = 96 PixelsPerInch = 96
object OvcTable1: TOvcTable object OvcTable1: TOvcTable
Left = 16 Left = 16
Top = 16 Top = 16
Width = 737 Width = 777
Height = 409 Height = 409
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Color = clWindow Color = clWindow
@ -47,11 +48,11 @@ object Form1: TForm1
RowData = ( RowData = (
35) 35)
ColData = ( ColData = (
110 120
False False
True True
'Form1.OvcTCRowHead1' 'Form1.OvcTCRowHead1'
90 100
False False
True True
'Form1.OvcTCString1' 'Form1.OvcTCString1'
@ -59,7 +60,7 @@ object Form1: TForm1
False False
True True
'Form1.OvcTCMemo1' 'Form1.OvcTCMemo1'
110 120
False False
True True
'Form1.OvcTCCheckBox1' 'Form1.OvcTCCheckBox1'
@ -67,7 +68,7 @@ object Form1: TForm1
False False
True True
'Form1.OvcTCComboBox1' 'Form1.OvcTCComboBox1'
90 100
False False
True True
'Form1.OvcTCBitMap1') 'Form1.OvcTCBitMap1')

80
components/orpheus/tests/TestTable/unit1.lrs
View File

@ -1,42 +1,42 @@
LazarusResources.Add('TForm1','FORMDATA',[ LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#0#3#6'Height' 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'('#3#6'Heigh'
+#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15 +'t'#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
+'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10 +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
+'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy' +#10'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#8'OnCreate'#7#10'FormC'
+#13'PixelsPerInch'#2'`'#0#9'TOvcTable'#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16 +'reate'#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'`'#0#9'TOvcTable'
+#5'Width'#3#225#2#6'Height'#3#153#1#7'Anchors'#11#6'akLeft'#5'akTop'#7'akRig' +#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16#5'Width'#3#9#3#6'Height'#3#153#1#7'An'
+'ht'#8'akBottom'#0#5'Color'#7#8'clWindow'#10'Controller'#7#14'OvcController1' +'chors'#11#6'akLeft'#5'akTop'#7'akRight'#8'akBottom'#0#5'Color'#7#8'clWindow'
+'!GridPenSet.NormalGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.NormalG' +#10'Controller'#7#14'OvcController1!GridPenSet.NormalGrid.NormalColor'#7#11
+'rid.Style'#7#5'psDot'#28'GridPenSet.NormalGrid.Effect'#7#6'geBoth!GridPenSe' +'clBtnShadow'#27'GridPenSet.NormalGrid.Style'#7#5'psDot'#28'GridPenSet.Norma'
+'t.LockedGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.LockedGrid.Style' +'lGrid.Effect'#7#6'geBoth!GridPenSet.LockedGrid.NormalColor'#7#11'clBtnShado'
+#7#7'psSolid'#28'GridPenSet.LockedGrid.Effect'#7#4'ge3D&GridPenSet.CellWhenF' +'w'#27'GridPenSet.LockedGrid.Style'#7#7'psSolid'#28'GridPenSet.LockedGrid.Ef'
+'ocused.NormalColor'#7#7'clBlack GridPenSet.CellWhenFocused.Style'#7#7'psSol' +'fect'#7#4'ge3D&GridPenSet.CellWhenFocused.NormalColor'#7#7'clBlack GridPenS'
+'id!GridPenSet.CellWhenFocused.Effect'#7#6'geBoth(GridPenSet.CellWhenUnfocus' +'et.CellWhenFocused.Style'#7#7'psSolid!GridPenSet.CellWhenFocused.Effect'#7#6
+'ed.NormalColor'#7#7'clBlack"GridPenSet.CellWhenUnfocused.Style'#7#6'psDash#' +'geBoth(GridPenSet.CellWhenUnfocused.NormalColor'#7#7'clBlack"GridPenSet.Cel'
+'GridPenSet.CellWhenUnfocused.Effect'#7#6'geBoth'#14'LockedRowsCell'#7#13'Ov' +'lWhenUnfocused.Style'#7#6'psDash#GridPenSet.CellWhenUnfocused.Effect'#7#6'g'
+'cTCColHead1'#7'Options'#11#16'otoNoRowResizing'#16'otoNoColResizing'#13'oto' +'eBoth'#14'LockedRowsCell'#7#13'OvcTCColHead1'#7'Options'#11#16'otoNoRowResi'
+'TabToArrow'#15'otoEnterToArrow'#16'otoAlwaysEditing'#14'otoNoSelection'#13 +'zing'#16'otoNoColResizing'#13'otoTabToArrow'#15'otoEnterToArrow'#16'otoAlwa'
+'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetCellData'#7#20'OvcTable1GetCellDat' +'ysEditing'#14'otoNoSelection'#13'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetC'
+'a'#8'CellData'#1#6#19'Form1.OvcTCColHead1'#6#19'Form1.OvcTCRowHead1'#6#18'F' +'ellData'#7#20'OvcTable1GetCellData'#8'CellData'#1#6#19'Form1.OvcTCColHead1'
+'orm1.OvcTCString1'#6#16'Form1.OvcTCMemo1'#6#20'Form1.OvcTCCheckBox1'#6#20'F' +#6#19'Form1.OvcTCRowHead1'#6#18'Form1.OvcTCString1'#6#16'Form1.OvcTCMemo1'#6
+'orm1.OvcTCComboBox1'#6#18'Form1.OvcTCBitMap1'#0#7'RowData'#1#2'#'#0#7'ColDa' +#20'Form1.OvcTCCheckBox1'#6#20'Form1.OvcTCComboBox1'#6#18'Form1.OvcTCBitMap1'
+'ta'#1#2'n'#8#9#6#19'Form1.OvcTCRowHead1'#2'Z'#8#9#6#18'Form1.OvcTCString1'#3 +#0#7'RowData'#1#2'#'#0#7'ColData'#1#2'x'#8#9#6#19'Form1.OvcTCRowHead1'#2'd'#8
+#150#0#8#9#6#16'Form1.OvcTCMemo1'#2'n'#8#9#6#20'Form1.OvcTCCheckBox1'#3#160#0 +#9#6#18'Form1.OvcTCString1'#3#150#0#8#9#6#16'Form1.OvcTCMemo1'#2'x'#8#9#6#20
+#8#9#6#20'Form1.OvcTCComboBox1'#2'Z'#8#9#6#18'Form1.OvcTCBitMap1'#0#0#0#13'T' +'Form1.OvcTCCheckBox1'#3#160#0#8#9#6#20'Form1.OvcTCComboBox1'#2'd'#8#9#6#18
+'OvcTCColHead'#13'OvcTCColHead1'#16'Headings.Strings'#1#6#13'TOvcTCRowHead'#6 +'Form1.OvcTCBitMap1'#0#0#0#13'TOvcTCColHead'#13'OvcTCColHead1'#16'Headings.S'
+#12'TOvcTCString'#6#10'TOvcTCMemo'#6#14'TOvcTCCheckBox'#6#14'TOvcTCComboBox' +'trings'#1#6#13'TOvcTCRowHead'#6#12'TOvcTCString'#6#10'TOvcTCMemo'#6#14'TOvc'
+#6#12'TOvcTCBitmap'#0#11'ShowLetters'#8#6'Adjust'#7#9'otaCenter'#5'Table'#7#9 +'TCCheckBox'#6#14'TOvcTCComboBox'#6#12'TOvcTCBitmap'#0#11'ShowLetters'#8#6'A'
+'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRowHead'#13'OvcTCRowHead1'#6'Adjust'#7 +'djust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRow'
+#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'P'#0#0#12'TOvcTCString'#12'O' +'Head'#13'OvcTCRowHead1'#6'Adjust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4
+'vcTCString1'#20'AutoAdvanceLeftRight'#9#5'Table'#7#9'OvcTable1'#4'Left'#3 +'Left'#2'P'#0#0#12'TOvcTCString'#12'OvcTCString1'#20'AutoAdvanceLeftRight'#9
+#144#0#0#0#10'TOvcTCMemo'#10'OvcTCMemo1'#5'Table'#7#9'OvcTable1'#4'Left'#3#8 +#5'Table'#7#9'OvcTable1'#4'Left'#3#144#0#0#0#10'TOvcTCMemo'#10'OvcTCMemo1'#5
+#1#0#0#14'TOvcTCCheckBox'#14'OvcTCCheckBox1'#6'Adjust'#7#9'otaCenter'#20'Cel' +'Table'#7#9'OvcTable1'#4'Left'#3#8#1#0#0#14'TOvcTCCheckBox'#14'OvcTCCheckBox'
+'lGlyphs.IsDefault'#9#21'CellGlyphs.GlyphCount'#2#3#27'CellGlyphs.ActiveGlyp' +'1'#6'Adjust'#7#9'otaCenter'#20'CellGlyphs.IsDefault'#9#21'CellGlyphs.GlyphC'
+'hCount'#2#2#5'Table'#7#9'OvcTable1'#4'Left'#3#128#1#0#0#14'TOvcTCComboBox' +'ount'#2#3#27'CellGlyphs.ActiveGlyphCount'#2#2#5'Table'#7#9'OvcTable1'#4'Lef'
+#14'OvcTCComboBox1'#5'Style'#7#14'csDropDownList'#5'Table'#7#9'OvcTable1'#8 +'t'#3#128#1#0#0#14'TOvcTCComboBox'#14'OvcTCComboBox1'#5'Style'#7#14'csDropDo'
+'OnChange'#7#20'OvcTCComboBox1Change'#4'Left'#3#0#2#0#0#12'TOvcTCBitMap'#12 +'wnList'#5'Table'#7#9'OvcTable1'#8'OnChange'#7#20'OvcTCComboBox1Change'#4'Le'
+'OvcTCBitMap1'#6'Adjust'#7#12'otaTopCenter'#5'Table'#7#9'OvcTable1'#4'Left'#3 +'ft'#3#0#2#0#0#12'TOvcTCBitMap'#12'OvcTCBitMap1'#6'Adjust'#7#12'otaTopCenter'
+'p'#2#0#0#14'TOvcController'#14'OvcController1'#23'EntryCommands.TableList'#1 +#5'Table'#7#9'OvcTable1'#4'Left'#3'p'#2#0#0#14'TOvcController'#14'OvcControl'
+#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1#0#0#5'Epoch'#3#208#7#4 +'ler1'#23'EntryCommands.TableList'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6
+'Left'#2#16#0#0#0 +#4'Grid'#8#1#0#0#5'Epoch'#3#208#7#4'Left'#2#16#0#0#0
]); ]);

12
components/orpheus/tests/TestTable/unit1.pas
View File

@ -74,8 +74,16 @@ begin
OvcTCMemo1.MaxLength := MaxMemoLen; OvcTCMemo1.MaxLength := MaxMemoLen;
{Populate cell combo box with names of Orpheus control bitmap files. {Populate cell combo box with names of Orpheus control bitmap files.
Assumes bitmap files are two levels up from program.} Assumes bitmap files are two levels up from program with Windows and GTK
BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' + PathDelim; or five levels up with OS X app bundle folder.}
BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' + PathDelim;
if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
begin
BmpPath := '..' + PathDelim + '..' + PathDelim;
if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' +
PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim;
end;
OvcTCComboBox1.Items.Add(' (None)'); {So we can "unselect"} OvcTCComboBox1.Items.Add(' (None)'); {So we can "unselect"}
try try
SearchResult := FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec); SearchResult := FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec);

10
components/orpheus/tests/TestVLB/unit1.dfm
View File

@ -11,12 +11,13 @@ object Form1: TForm1
Font.Name = 'MS Sans Serif' Font.Name = 'MS Sans Serif'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object Label1: TLabel object Label1: TLabel
Left = 64 Left = 40
Top = 304 Top = 304
Width = 425 Width = 473
Height = 33 Height = 33
AutoSize = False AutoSize = False
Caption = 'Double-click an item in list' Caption = 'Double-click an item in list'
@ -24,9 +25,9 @@ object Form1: TForm1
ParentColor = False ParentColor = False
end end
object OvcVirtualListBox1: TOvcVirtualListBox object OvcVirtualListBox1: TOvcVirtualListBox
Left = 64 Left = 40
Top = 40 Top = 40
Width = 425 Width = 473
Height = 238 Height = 238
Header = 'Header goes here' Header = 'Header goes here'
HeaderColor.BackColor = clBtnFace HeaderColor.BackColor = clBtnFace
@ -37,6 +38,7 @@ object Form1: TForm1
SelectColor.BackColor = clHighlight SelectColor.BackColor = clHighlight
SelectColor.TextColor = clHighlightText SelectColor.TextColor = clHighlightText
ShowHeader = True ShowHeader = True
UseTabStops = True
OnGetItem = OvcVirtualListBox1GetItem OnGetItem = OvcVirtualListBox1GetItem
TabOrder = 0 TabOrder = 0
OnDblClick = OvcVirtualListBox1DblClick OnDblClick = OvcVirtualListBox1DblClick

10
components/orpheus/tests/TestVLB/unit1.lfm
View File

@ -9,11 +9,12 @@ object Form1: TForm1
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 Font.Height = -11
Font.Style = [] Font.Style = []
OnCreate = FormCreate
PixelsPerInch = 96 PixelsPerInch = 96
object Label1: TLabel object Label1: TLabel
Left = 64 Left = 40
Top = 304 Top = 304
Width = 425 Width = 473
Height = 33 Height = 33
AutoSize = False AutoSize = False
Caption = 'Double-click an item in list' Caption = 'Double-click an item in list'
@ -21,9 +22,9 @@ object Form1: TForm1
ParentColor = False ParentColor = False
end end
object OvcVirtualListBox1: TOvcVirtualListBox object OvcVirtualListBox1: TOvcVirtualListBox
Left = 64 Left = 40
Top = 40 Top = 40
Width = 425 Width = 473
Height = 238 Height = 238
Header = 'Header goes here' Header = 'Header goes here'
HeaderColor.BackColor = clBtnFace HeaderColor.BackColor = clBtnFace
@ -34,6 +35,7 @@ object Form1: TForm1
SelectColor.BackColor = clHighlight SelectColor.BackColor = clHighlight
SelectColor.TextColor = clHighlightText SelectColor.TextColor = clHighlightText
ShowHeader = True ShowHeader = True
UseTabStops = True
OnGetItem = OvcVirtualListBox1GetItem OnGetItem = OvcVirtualListBox1GetItem
TabOrder = 0 TabOrder = 0
OnDblClick = OvcVirtualListBox1DblClick OnDblClick = OvcVirtualListBox1DblClick

22
components/orpheus/tests/TestVLB/unit1.lrs
View File

@ -2,15 +2,15 @@ LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'"'#2#6'Heigh' 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'"'#2#6'Heigh'
+'t'#3#147#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7 +'t'#3#147#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
+#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245 +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
+#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2 +#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#0#6
+'@'#3'Top'#3'0'#1#5'Width'#3#169#1#6'Height'#2'!'#8'AutoSize'#8#7'Caption'#6 +'TLabel'#6'Label1'#4'Left'#2'('#3'Top'#3'0'#1#5'Width'#3#217#1#6'Height'#2'!'
+#28'Double-click an item in list'#5'Color'#7#14'clBtnHighlight'#11'ParentCol' +#8'AutoSize'#8#7'Caption'#6#28'Double-click an item in list'#5'Color'#7#14'c'
+'or'#8#0#0#18'TOvcVirtualListBox'#18'OvcVirtualListBox1'#4'Left'#2'@'#3'Top' +'lBtnHighlight'#11'ParentColor'#8#0#0#18'TOvcVirtualListBox'#18'OvcVirtualLi'
+#2'('#5'Width'#3#169#1#6'Height'#3#238#0#6'Header'#6#16'Header goes here'#21 +'stBox1'#4'Left'#2'('#3'Top'#2'('#5'Width'#3#217#1#6'Height'#3#238#0#6'Heade'
+'HeaderColor.BackColor'#7#9'clBtnFace'#21'HeaderColor.TextColor'#7#9'clBtnTe' +'r'#6#16'Header goes here'#21'HeaderColor.BackColor'#7#9'clBtnFace'#21'Heade'
+'xt'#22'ProtectColor.BackColor'#7#5'clRed'#22'ProtectColor.TextColor'#7#7'cl' +'rColor.TextColor'#7#9'clBtnText'#22'ProtectColor.BackColor'#7#5'clRed'#22'P'
+'White'#9'RowHeight'#2#13#21'SelectColor.BackColor'#7#11'clHighlight'#21'Sel' +'rotectColor.TextColor'#7#7'clWhite'#9'RowHeight'#2#13#21'SelectColor.BackCo'
+'ectColor.TextColor'#7#15'clHighlightText'#10'ShowHeader'#9#9'OnGetItem'#7#25 +'lor'#7#11'clHighlight'#21'SelectColor.TextColor'#7#15'clHighlightText'#10'S'
+'OvcVirtualListBox1GetItem'#8'TabOrder'#2#0#10'OnDblClick'#7#26'OvcVirtualLi' +'howHeader'#9#11'UseTabStops'#9#9'OnGetItem'#7#25'OvcVirtualListBox1GetItem'
+'stBox1DblClick'#0#0#0 +#8'TabOrder'#2#0#10'OnDblClick'#7#26'OvcVirtualListBox1DblClick'#0#0#0
]); ]);

23
components/orpheus/tests/TestVLB/unit1.pas
View File

@ -11,6 +11,7 @@ type
TForm1 = class(TForm) TForm1 = class(TForm)
OvcVirtualListBox1: TOvcVirtualListBox; OvcVirtualListBox1: TOvcVirtualListBox;
Label1: TLabel; Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer; procedure OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
var ItemString: String); var ItemString: String);
procedure OvcVirtualListBox1DblClick(Sender: TObject); procedure OvcVirtualListBox1DblClick(Sender: TObject);
@ -29,10 +30,30 @@ implementation
{$R *.dfm} {$R *.dfm}
{$ENDIF} {$ENDIF}
procedure TForm1.FormCreate(Sender: TObject);
var
TabStops : array[0..1] of Integer;
begin
TabStops[0] := 150;
TabStops[1] := 300;
OvcVirtualListBox1.SetTabStops(TabStops);
OvcVirtualListBox1.Header := 'Name column'#9'Address column'#9'City column';
if OvcVirtualListBox1.IntegralHeight then
OvcVirtualListBox1.ClientHeight :=
(OvcVirtualListBox1.ClientHeight div OvcVirtualListBox1.RowHeight) *
OvcVirtualListBox1.RowHeight;
{Since RowHeight might have changed based on font used by current
platform, make sure height still integral.}
end;
procedure TForm1.OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer; procedure TForm1.OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
var ItemString: String); var ItemString: String);
begin begin
ItemString := 'Item ' + IntToStr(Index); ItemString := 'Item ' + IntToStr(Index) + ' name'#9 +
'Item ' + IntToStr(Index) + ' address'#9 +
'Item ' + IntToStr(Index) + ' city';
end; end;
procedure TForm1.OvcVirtualListBox1DblClick(Sender: TObject); procedure TForm1.OvcVirtualListBox1DblClick(Sender: TObject);