Index: cprs/branches/GUI-config/CPRS-Lib/Borland.dof =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/Borland.dof (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/Borland.dof (revision 492) @@ -1,4 +1,4 @@ [FileVersion] -Version=6.0 +Version=7.0 [Compiler] A=8 @@ -31,4 +31,53 @@ ShowWarnings=1 UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=1 +UnsafeCode=1 +UnsafeCast=1 [Linker] MapFile=3 Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.cfg =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.cfg (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.cfg (revision 492) @@ -33,6 +33,6 @@ -$M16384,1048576 -K$00400000 --E"c:\program files\borland\delphi7\dev\exesave" --N"..\cprs-lib\dcu" +-E"c:\program files\borland\delphi6\dev\exesave" +-N"..\Packages" -LE"..\Packages" -LN"..\Packages" Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dof =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dof (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dof (revision 492) @@ -1,4 +1,4 @@ [FileVersion] -Version=7.0 +Version=6.0 [Compiler] A=8 @@ -31,53 +31,4 @@ ShowWarnings=1 UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=1 -UnsafeCode=1 -UnsafeCast=1 [Linker] MapFile=3 @@ -92,5 +43,5 @@ [Directories] OutputDir=$(DELPHI)\dev\exesave -UnitOutputDir=..\cprs-lib\dcu +UnitOutputDir=..\Packages PackageDLLOutputDir=..\Packages PackageDCPOutputDir=..\Packages @@ -98,5 +49,5 @@ Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;TeeUI40;teedb40;tee40;ibevnt40;nmfast40;VistABroker Conditionals= -DebugSourceDirs= +DebugSourceDirs=..\Packages UsePackages=0 [Parameters] @@ -135,4 +86,9 @@ ProductVersion=1.0.0.0 Comments= +[Excluded Packages] +C:\Program Files\Borland\Delphi6\Projects\Bpl\SharedRPCBroker_D60.bpl=VistA SharedBroker Components +[HistoryLists\hlDebugSourcePath] +Count=1 +Item0=..\Packages [HistoryLists\hlUnitAliases] Count=1 @@ -151,14 +107,15 @@ Item9=$(DELPHI)\Projects\Current\CPRS-Lib [HistoryLists\hlUnitOutputDirectory] -Count=9 -Item0=..\cprs-lib\dcu -Item1=..\cprs-lib -Item2=d:\vista\main\cprs-lib\DCU -Item3=d:\vista\main\cprs-lib\DCUSave -Item4=d:\vista\main\cprs-chart\dcu -Item5=\Dev\DCUSave -Item6=C:\Dev\DCUSave -Item7=\Projects\DCUSave -Item8=$(DELPHI)\Projects\DCUSave +Count=10 +Item0=..\Packages +Item1=..\cprs-lib\dcu +Item2=..\cprs-lib +Item3=d:\vista\main\cprs-lib\DCU +Item4=d:\vista\main\cprs-lib\DCUSave +Item5=d:\vista\main\cprs-chart\dcu +Item6=\Dev\DCUSave +Item7=C:\Dev\DCUSave +Item8=\Projects\DCUSave +Item9=$(DELPHI)\Projects\DCUSave [HistoryLists\hlOutputDirectorry] Count=2 Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dpk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dpk (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dpk (revision 492) @@ -2,6 +2,6 @@ {$R *.res} +{$R '..\CPRS-Chart\Accessibility_TLB.dcr'} {$R 'ORCtrlsDsgn.dcr'} -{$R '..\CPRS-Chart\Accessibility_TLB.dcr'} {$ALIGN 8} {$ASSERTIONS ON} @@ -32,12 +32,11 @@ vcl, vclx, - designide, - rtl; + designide; contains + uAccessAPI in 'uAccessAPI.pas', + Accessibility_TLB in '..\CPRS-Chart\Accessibility_TLB.pas', ORCtrls in 'ORCtrls.pas', - ORCtrlsDsgn in 'ORCtrlsDsgn.pas', - uAccessAPI in 'uAccessAPI.pas', - Accessibility_TLB in '..\CPRS-Chart\Accessibility_TLB.pas'; + ORCtrlsDsgn in 'ORCtrlsDsgn.pas'; end. Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dsk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dsk (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.dsk (revision 492) @@ -1,524 +1,32 @@ [Closed Files] -File_0=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\rReminders.pas',0,1,305,1,305,0,0 -File_1=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\Options\fOptionsPatientSelection.pas',0,1,169,28,172,1,0 -File_2=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\rCore.pas',0,1,333,1,335,0,0 -File_3=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\fNoteProps.pas',0,1,1,1,1,1,1 -File_4=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\fDCSummProps.pas',0,1,1,1,1,1,1 -File_5=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Chart\fAddlSigners.pas',0,1,1,1,1,1,1 -File_6=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Lib\ORClasses.pas',0,1,1,1,1,0,0 -File_7=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Lib\ORCtrlsDsgn.pas',0,1,1,1,1,0,0 -File_8=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Lib\ORSystem.pas',0,1,1,1,1,0,0 -File_9=SourceModule,'C:\Vista\CPRS\OR_3_187V23\CPRS-Lib\ORFn.pas',0,1,1,1,1,0,0 +File_0=SourceModule,'D:\vista\cprs\OR_3_195V25\CPRS-Lib\uStaticText.pas',0,1,1,1,1,0,0 +File_1=SourceModule,'D:\vista\cprs\OR_3_195V25\CPRS-Chart\unit2.pas',0,1,1,1,11,0,0 +File_2=SourceModule,'D:\vista\cprs\main\CPRS-Chart\uSignItems.pas',0,1,1044,54,1060,0,0 +File_3=SourceModule,'D:\vista\cprs\OR_3_215V26\CPRS-Chart\uSignItems.pas',0,1,1044,54,1060,0,0 +File_4=SourceModule,'D:\vista\cprs\OR_3_215V26\CPRS-Chart\fReview.pas',0,1,1833,42,1841,1,0 +File_5=SourceModule,'D:\vista\cprs\main\CPRS-Chart\fReview.pas',0,1,1830,44,1857,1,0 +File_6=SourceModule,'D:\vista\cprs\OR_3_195V25\CPRS-Lib\ORCtrls.pas',0,1,1,63,30,0,0 +File_7=SourceModule,'C:\PROGRA~1\Vista\BDK32_~1\Source\wsockc.pas',0,1,1455,1,1477,0,0 +File_8=SourceModule,'D:\vista\cprs\OR_3_195V25\CPRS-Chart\VERGENCECONTEXTORLib_TLB.pas',0,1,564,1,586,0,0 [Modules] -Module0=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\Accessibility_TLB.pas -Module1=c:\bcb\projects\personal projects\vista\cprs-1.0.23.15\cprs-lib\ORCtrlLib60.dpk -Module2=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORCtrls.pas -Module3=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\wsockc.pas -Module4=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcberr.pas -Module5=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\fFrame.pas -Module6=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\CPRSChart.dpr -Module7=C:\BCB\Projects\Personal Projects\Vista\CPRS-Chart_Try #1\CPRSChart.dpr -Module8=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uComServ.pas -Module9=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uAccessibleListBox.pas -Module10=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fSgnonDlg.pas -Module11=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SgnonCnf.pas -Module12=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fESSOConf.pas -Module13=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Loginfrm.pas -Module14=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\AddServer.pas -Module15=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcconf1.pas -Module16=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcnet.pas -Module17=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fConfirmMapping.pas -Module18=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBErrMsg.pas -Module19=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\VCEdit.pas -Module20=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SelDiv.pas -Module21=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\RpcSLogin.pas -Module22=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fDebugInfo.pas -Module23=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBTimer.pas -Module24=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\xuesap_TLB.pas -Module25=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\APi.pas -Module26=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\XWBRich20.pas -Module27=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\frmSignonMessage.pas -Module28=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\TRpcb.pas -Module29=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Hash.pas -Module30=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Mfunstr.pas -Module31=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Xwbut1.pas -Module32=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORNet.pas -Count=33 -EditWindowCount=1 -PackageWindowCount=2 -TypeLibWindowCount=1 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\Accessibility_TLB.pas] -ModuleType=SourceModule +Count=0 +EditWindowCount=0 +PackageWindowCount=1 + +[P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrlLib60.dpk] +FormState=0 +FormOnTop=1 + +[C:\Program Files\Borland\Delphi7\Projects\ProjectGroup1.bpg] FormState=0 FormOnTop=0 -[c:\bcb\projects\personal projects\vista\cprs-1.0.23.15\cprs-lib\ORCtrlLib60.dpk] -ModuleType=PackageEditModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORCtrls.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\wsockc.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcberr.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\fFrame.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\CPRSChart.dpr] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-Chart_Try #1\CPRSChart.dpr] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uComServ.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uAccessibleListBox.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fSgnonDlg.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SgnonCnf.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fESSOConf.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Loginfrm.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\AddServer.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcconf1.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcnet.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fConfirmMapping.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBErrMsg.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\VCEdit.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SelDiv.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\RpcSLogin.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fDebugInfo.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBTimer.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\xuesap_TLB.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\APi.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\XWBRich20.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\frmSignonMessage.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\TRpcb.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Hash.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Mfunstr.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Xwbut1.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORNet.pas] -ModuleType=SourceModule -FormState=0 -FormOnTop=0 - -[c:\bcb\delphi\Lib\dclusr.dpk] -FormState=0 -FormOnTop=1 - -[C:\BCB\Delphi\Projects\ProjectGroup1.bpg] -FormState=0 -FormOnTop=0 - -[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\CPRSChart.tlb] -FormState=0 -FormOnTop=0 - -[EditWindow0] -ViewCount=33 -CurrentView=3 -View0=0 -View1=1 -View2=2 -View3=3 -View4=4 -View5=5 -View6=6 -View7=7 -View8=8 -View9=9 -View10=10 -View11=11 -View12=12 -View13=13 -View14=14 -View15=15 -View16=16 -View17=17 -View18=18 -View19=19 -View20=20 -View21=21 -View22=22 -View23=23 -View24=24 -View25=25 -View26=26 -View27=27 -View28=28 -View29=29 -View30=30 -View31=31 -View32=32 -CodeExplorer=CodeExplorer@EditWindow0 -MessageView=MessageView@EditWindow0 -Create=1 -Visible=1 -State=0 -Left=133 -Top=123 -Width=890 -Height=603 -MaxLeft=-4 -MaxTop=-4 -ClientWidth=882 -ClientHeight=569 -LeftPanelSize=0 -LeftPanelClients=CodeExplorer@EditWindow0 -LeftPanelData=00000400010000000C000000436F64654578706C6F726572000000000000000000000000000000000001000000000000000000000000FFFFFFFF -RightPanelSize=0 -BottomPanelSize=190 -BottomPanelClients=MessageView@EditWindow0 -BottomPanelData=0000040000000000720300000000000002BE00000000000000010000000000000000000000000100000000180200000000000001000000001802000000000000010000000018020000000000000100000000180200000000000001000000002402000000000000010000000024020000000000000100000000240200000000000001000000002402000000000000010000000024020000000000000100000000240200000000000001000000002402000000000000010000000024020000000000000100000000240200000000000001000000002402000000000000010000000024020000000000000100000000720300000B0000004D65737361676556696577FFFFFFFF - -[View0] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\CPRSChart.dpr -CursorX=3 -CursorY=337 -TopLine=322 -LeftCol=1 - -[View1] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\fFrame.pas -CursorX=1 -CursorY=551 -TopLine=539 -LeftCol=1 - -[View2] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-Chart_Try #1\CPRSChart.dpr -CursorX=9 -CursorY=300 -TopLine=291 -LeftCol=1 - -[View3] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\Accessibility_TLB.pas -CursorX=1 -CursorY=287 -TopLine=278 -LeftCol=1 - -[View4] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORNet.pas -CursorX=57 -CursorY=5 -TopLine=1 -LeftCol=1 - -[View5] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\TRpcb.pas -CursorX=3 -CursorY=333 -TopLine=320 -LeftCol=1 - -[View6] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Loginfrm.pas -CursorX=3 -CursorY=112 -TopLine=98 -LeftCol=1 - -[View7] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fESSOConf.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View8] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcconf1.pas -CursorX=6 -CursorY=64 -TopLine=51 -LeftCol=1 - -[View9] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\AddServer.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View10] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcnet.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View11] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fConfirmMapping.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View12] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBErrMsg.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View13] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\VCEdit.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View14] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\RpcSLogin.pas -CursorX=33 -CursorY=42 -TopLine=29 -LeftCol=1 - -[View15] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SelDiv.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View16] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fRPCBTimer.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View17] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\APi.pas -CursorX=3 -CursorY=18 -TopLine=1 -LeftCol=1 - -[View18] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\xuesap_TLB.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View19] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\frmSignonMessage.pas -CursorX=32 -CursorY=16 -TopLine=1 -LeftCol=1 - -[View20] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\XWBRich20.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View21] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\SgnonCnf.pas -CursorX=16 -CursorY=162 -TopLine=149 -LeftCol=1 - -[View22] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fSgnonDlg.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View23] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uAccessibleListBox.pas -CursorX=6 -CursorY=57 -TopLine=44 -LeftCol=1 - -[View24] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\uComServ.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View25] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Hash.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View26] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Mfunstr.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View27] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Xwbut1.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View28] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\wsockc.pas -CursorX=1 -CursorY=701 -TopLine=692 -LeftCol=1 - -[View29] -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\ORCtrls.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View30] -Module=c:\bcb\projects\personal projects\vista\cprs-1.0.23.15\cprs-lib\ORCtrlLib60.dpk -CursorX=61 -CursorY=40 -TopLine=31 -LeftCol=1 - -[View31] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\fDebugInfo.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 - -[View32] -Module=C:\BCB\Projects\Personal Projects\Vista\Broker\Source\Rpcberr.pas -CursorX=1 -CursorY=183 -TopLine=174 -LeftCol=1 - [PackageWindow0] Create=1 Visible=0 State=0 -Left=260 -Top=267 +Left=410 +Top=256 Width=368 Height=244 @@ -535,41 +43,5 @@ SectionWidth0=150 SectionWidth1=210 -Module=c:\bcb\projects\personal projects\vista\cprs-1.0.23.15\cprs-lib\ORCtrlLib60.dpk - -[PackageWindow1] -Create=1 -Visible=1 -State=0 -Left=252 -Top=241 -Width=368 -Height=244 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=360 -ClientHeight=218 -TBDockHeight=244 -LRDockWidth=368 -Dockable=1 -StatusBar=0 -TextLabels=1 -Toolbar=1 -SectionWidth0=150 -SectionWidth1=210 -Module=c:\bcb\delphi\Lib\dclusr.dpk - -[TypeLibEditWindow0] -Create=1 -Visible=0 -State=0 -Left=200 -Top=114 -Width=639 -Height=453 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=631 -ClientHeight=419 -Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Chart\CPRSChart.tlb +Module=P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrlLib60.dpk [Watches] @@ -582,18 +54,24 @@ Visible=0 State=0 -Left=103 -Top=393 -Width=392 -Height=112 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=384 -ClientHeight=86 -TBDockHeight=83 +Left=5 +Top=1 +Width=803 +Height=104 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=795 +ClientHeight=78 +TBDockHeight=149 LRDockWidth=421 Dockable=1 [Breakpoints] -Count=0 +Count=6 +Breakpoint0='D:\vista\cprs\OR_3_195V25\CPRS-Chart\uSignItems.pas',130,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint1='D:\vista\cprs\OR_3_195V25\CPRS-Chart\BA\fBAOptionsDiagnoses.pas',410,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint2='D:\vista\cprs\OR_3_195V25\CPRS-Chart\BA\fBAOptionsDiagnoses.pas',414,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint3='D:\vista\cprs\OR_3_195V25\CPRS-Chart\uSignItems.pas',275,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint4='D:\vista\cprs\OR_3_195V25\CPRS-Chart\Orders\fOrdersSign.pas',1099,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint5='D:\vista\cprs\OR_3_195V25\CPRS-Chart\uSignItems.pas',644,'',0,1,'',1,0,0,'',1,'','','' [AddressBreakpoints] @@ -617,19 +95,19 @@ Visible=1 State=0 -Left=215 -Top=123 -Width=631 -Height=614 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=623 -ClientHeight=588 -TBDockHeight=408 -LRDockWidth=137 +Left=0 +Top=0 +Width=287 +Height=577 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=287 +ClientHeight=577 +TBDockHeight=571 +LRDockWidth=255 Dockable=1 [Components] -Left=308 -Top=167 +Left=420 +Top=251 Width=183 Height=266 @@ -649,16 +127,16 @@ Visible=0 State=0 -Left=133 -Top=123 -Width=533 -Height=353 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=525 -ClientHeight=319 -DumpPane=79 -DisassemblyPane=187 +Left=159 +Top=109 +Width=819 +Height=551 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=811 +ClientHeight=517 +DumpPane=212 +DisassemblyPane=377 RegisterPane=231 -FlagPane=64 +FlagPane=120 [AlignmentPalette] @@ -667,5 +145,5 @@ State=0 Left=200 -Top=125 +Top=107 Width=156 Height=84 @@ -680,36 +158,36 @@ State=0 Left=0 -Top=123 -Width=214 -Height=449 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=206 -ClientHeight=423 -TBDockHeight=492 -LRDockWidth=190 -Dockable=1 -SplitPos=89 +Top=0 +Width=287 +Height=577 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=287 +ClientHeight=577 +TBDockHeight=571 +LRDockWidth=255 +Dockable=1 +SplitPos=131 ArrangeBy=Name SelectedItem= -ExpandedItems=Menu -HiddenCategories=Legacy +ExpandedItems=Brush,Font.Style +HiddenCategories= [BreakpointWindow] Create=1 -Visible=0 -State=0 -Left=31 -Top=201 -Width=737 -Height=197 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=729 -ClientHeight=171 +Visible=1 +State=0 +Left=0 +Top=0 +Width=287 +Height=577 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=287 +ClientHeight=577 TBDockHeight=197 LRDockWidth=737 Dockable=1 -Column0Width=100 +Column0Width=151 Column1Width=75 Column2Width=200 @@ -722,6 +200,6 @@ Visible=0 State=0 -Left=253 -Top=219 +Left=365 +Top=303 Width=294 Height=161 @@ -734,53 +212,169 @@ Dockable=1 +[ThreadStatusWindow] +Create=1 +Visible=0 +State=0 +Left=0 +Top=0 +Width=1024 +Height=768 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1016 +ClientHeight=742 +TBDockHeight=152 +LRDockWidth=624 +Dockable=1 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=250 + [ObjectTree] Create=1 Visible=0 State=0 -Left=192 -Top=124 -Width=183 -Height=435 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=175 -ClientHeight=409 -TBDockHeight=393 +Left=0 +Top=105 +Width=190 +Height=264 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=182 +ClientHeight=238 +TBDockHeight=264 LRDockWidth=190 Dockable=1 -[CodeExplorer@EditWindow0] -Create=1 -Visible=0 -State=0 -Left=0 -Top=12 -Width=140 -Height=535 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=140 -ClientHeight=535 -TBDockHeight=305 -LRDockWidth=140 -Dockable=1 - -[MessageView@EditWindow0] -Create=1 -Visible=1 -State=0 -Left=12 -Top=0 -Width=870 -Height=190 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=870 -ClientHeight=190 -TBDockHeight=190 -LRDockWidth=443 +[DebugLogView] +Create=1 +Visible=0 +State=0 +Left=0 +Top=0 +Width=798 +Height=712 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=790 +ClientHeight=686 +TBDockHeight=291 +LRDockWidth=417 +Dockable=1 + +[LocalVarsWindow] +Create=1 +Visible=0 +State=0 +Left=441 +Top=447 +Width=421 +Height=192 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=413 +ClientHeight=166 +TBDockHeight=192 +LRDockWidth=421 +Dockable=1 + +[ToDo List] +Create=1 +Visible=0 +State=0 +Left=107 +Top=48 +Width=866 +Height=649 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=858 +ClientHeight=623 +TBDockHeight=250 +LRDockWidth=713 +Dockable=1 +Column0Width=507 +Column1Width=30 +Column2Width=100 +Column3Width=70 +Column4Width=70 +SortOrder=6 +ShowHints=1 +ShowChecked=1 + +[FPUWindow] +Create=1 +Visible=0 +State=0 +Left=306 +Top=280 +Width=457 +Height=250 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=449 +ClientHeight=216 +RegisterPane=121 +FlagPane=59 + +[ModuleWindow] +Create=1 +Visible=0 +State=0 +Left=18 +Top=9 +Width=913 +Height=719 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=905 +ClientHeight=693 +TBDockHeight=355 +LRDockWidth=638 +Dockable=1 +Column0Width=125 +Column1Width=100 +Column2Width=356 +EntryPointPane=447 +CompUnitPane=530 + +[MessageHintFrm] +Create=1 +Visible=0 +State=0 +Left=481 +Top=423 +Width=383 +Height=195 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=375 +ClientHeight=169 +TBDockHeight=195 +LRDockWidth=383 Dockable=1 [DockHosts] -DockHostCount=0 - +DockHostCount=1 + +[DockSite0] +DockSiteType=1 +Create=1 +Visible=1 +State=0 +Left=1 +Top=104 +Width=303 +Height=632 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=295 +ClientHeight=606 +TBDockHeight=659 +LRDockWidth=263 +Dockable=1 +TabPosition=0 +ActiveTab=Object Inspector +TabDockClients=PropertyInspector,ProjectManager,BreakpointWindow + Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.~dpk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlLib60.~dpk (revision 476) +++ (revision ) @@ -1,42 +1,0 @@ -package ORCtrlLib60; - -{$R *.res} -{$R 'ORCtrlsDsgn.dcr'} -{$R '..\CPRS-Chart\Accessibility_TLB.dcr'} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS ON} -{$RANGECHECKS ON} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST ON} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'CPRS Custom Controls'} -{$DESIGNONLY} -{$IMPLICITBUILD ON} - -requires - vcl, - vclx, - designide; - -contains - ORCtrls in 'ORCtrls.pas', - ORCtrlsDsgn in 'ORCtrlsDsgn.pas', - uAccessAPI in 'uAccessAPI.pas', - Accessibility_TLB in '..\CPRS-Chart\Accessibility_TLB.pas'; - -end. Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrls.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrls.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrls.pas (revision 492) @@ -21,4 +21,16 @@ type + + TORStaticText = class(TStaticText) + private + FOnEnter: TNotifyEvent; + FOnExit: TNotifyEvent; + published + property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; + property OnExit: TNotifyEvent read FOnExit write FOnExit; + procedure DoEnter; override; + procedure DoExit; override; + end; + TORComboBox = class; // forward declaration for FParentCombo @@ -230,4 +242,5 @@ property MItems: TStrings read GetMItems write SetMItems; procedure MakeAccessible(Accessible: IAccessible); + function VerifyUnique(SelectIndex: Integer; iText: String): integer; published property AllowGrayed: boolean read FAllowGrayed write FAllowGrayed default FALSE; @@ -325,4 +338,6 @@ FCheckBoxEditColor: TColor; // Edit Box color for Check Box Combo List, when not in Focus FTemplateField: boolean; + FCharsNeedMatch: integer; // how many text need to be matched for auto selection + FUniqueAutoComplete: Boolean; // If true only perform autocomplete for unique list items. function EditControl: TWinControl; procedure AdjustSizeOfSelf; @@ -342,4 +357,5 @@ procedure FwdNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); + procedure SetNumForMatch(const NumberForMatch: integer); function GetAutoSelect: Boolean; function GetColor: TColor; @@ -423,4 +439,5 @@ function GetLookupPiece: integer; procedure SetLookupPiece(const Value: integer); + procedure SetUniqueAutoComplete(const Value: Boolean); protected procedure DropPanelBtnPressed(OKBtn, AutoClose: boolean); @@ -441,4 +458,5 @@ procedure InitLongList(S: string); procedure InsertSeparator; + procedure SetTextAutoComplete(TextToMatch : String); function GetIEN(AnIndex: Integer): Int64; function SelectByIEN(AnIEN: Int64): Integer; @@ -522,4 +540,11 @@ property OnResize; property OnSynonymCheck: TORSynonymCheckEvent read GetOnSynonymCheck write SetOnSynonymCheck; + property CharsNeedMatch: integer read FCharsNeedMatch write SetNumForMatch; +{UniqueAutoComplete Was added as a result of the following defects: + 7293 - PTM 85: Backspace and Dosage: Desired dosage does not populate if dosage is not in local dosage field + 7337 - PTM 160 Meds: #8 IMO - Simple - Change Order in which Error generated if "Enter" is hit instead of "OK" + 7278 - PTM 36 Meds: Select 40000 UNT/2ML and backspace to 4000 the dose selected remains 40000 + 7284 - Inconsistencies of pulling in a dose from the Possible Dose File } + property UniqueAutoComplete: Boolean read FUniqueAutoComplete write SetUniqueAutoComplete default False; end; @@ -776,4 +801,6 @@ procedure WMSize (var Message: TWMSize); message WM_SIZE; procedure BMSetCheck (var Message: TMessage); message BM_SETCHECK; + procedure BMGetCheck (var Message: TMessage); message BM_GETCHECK; + procedure BMGetState (var Message: TMessage); message BM_GETSTATE; function GetImageList: TCustomImageList; function GetImageIndexes: string; @@ -874,12 +901,16 @@ TCaptionListBox = class(TListBox) private + FHoverItemPos: integer; FAccessible: IAccessible; FRightClickSelect: boolean; // When true, a right click selects teh item + FHintOnItem: boolean; procedure SetCaption(const Value: string); function GetCaption: string; procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; + procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; protected FCaptionComponent: TStaticText; + procedure DoEnter; override; public procedure MakeAccessible( Accessible: IAccessible); @@ -887,4 +918,6 @@ property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE; property Caption: string read GetCaption write SetCaption; + //Make the ListBox's hint contain the contents of the listbox Item the mouse is currently over. + property HintOnItem: boolean read FHintOnItem write FHintOnItem default FALSE; end; @@ -918,4 +951,17 @@ property Align; property Caption: string read GetCaption write SetCaption; + end; + + TCaptionRichEdit = class(TRichEdit) + private + FAccessible: IAccessible; + procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; + protected + FCaption: string; + public + procedure MakeAccessible(Accessible: IAccessible); + published + property Align; + property Caption: string read FCaption write FCaption; end; @@ -961,4 +1007,7 @@ function CalcShortName( LongName: string; PrevLongName: string): string; +{Returns True if any one of 3 mouse buttons are down left, right, or middle} +function IsAMouseButtonDown : boolean; + implementation // --------------------------------------------------------------------------- @@ -1006,4 +1055,6 @@ FPoint: TPoint; FSelected: boolean; + FTabs: array[0..MAX_TABS] of Integer; // Holds the pixel offsets for tabs + procedure GetTabSettings; protected constructor Create(AOwner: TComponent); override; @@ -1054,9 +1105,15 @@ begin DC := GetDC(0); - SaveFont := SelectObject(DC, FontHandle); - GetTextExtentPoint32(DC, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz', 52, Extent); - Result := Trunc((Extent.cx / 26 + 1) / 2); // Round() doesn't line up with dialog units - SelectObject(DC, SaveFont); - ReleaseDC(0, DC); + try + SaveFont := SelectObject(DC, FontHandle); + try + GetTextExtentPoint32(DC, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz', 52, Extent); + Result := Trunc((Extent.cx / 26 + 1) / 2); // Round() doesn't line up with dialog units + finally + SelectObject(DC, SaveFont); + end; + finally + ReleaseDC(0, DC); + end; end; @@ -1234,6 +1291,7 @@ y := ((ClientRect.Bottom - ClientRect.Top) - FontHeightPixel(Canvas.Font.Handle)) div 2; //TextOut(ClientRect.Left + 1, ClientRect.Top - 1, AString); - TabbedTextOut(Handle, 1, y, PChar(AString), Length(AString), FListBox.FTabPix[0], - FListBox.FTabPix[1], -1); +// WARNING - Do NOT change the X pos or the tab starting pos - this will cause a missmatch +// between the hint window and what the control displayes + TabbedTextOut(Handle, 0, y, PChar(AString), Length(AString), MAX_TABS+1, FTabs[0], 0); end; end; @@ -1253,4 +1311,35 @@ end; +procedure TItemTip.GetTabSettings; +var + DX, X, i, count: integer; + +begin + Count := FListBox.FTabPix[0]; + FTabs[0] := 1; // Set first tab stop to location 1 for display purposes + if(Count = 1) then + begin + DX := FListBox.FTabPix[1]; + X := (DX * 2) - 1; + end + else + begin + DX := FontWidthPixel(FListBox.Font.Handle) * 8; // windows tab default is 8 chars + X := FListBox.FTabPix[Count]; + X := Trunc(X / DX) + 1; + X := (X * DX) - 1; // get the next tab position after that which is specified + end; + for i := 1 to MAX_TABS do + begin + if(i <= Count) then + FTabs[i] := FListBox.FTabPix[i] - 1 + else + begin + FTabs[i] := X; + inc(X, DX); + end; + end; +end; + procedure TItemTip.UpdateText(CatchMouse: Boolean); var @@ -1270,8 +1359,11 @@ Canvas.Font.Color := clWindowText; end; - Caption := FListBox.DisplayText[FListItem]; + Caption := #9 + FListBox.DisplayText[FListItem]; if Copy(Caption, 1, 2) = '__' then Caption := ' '; // so separators don't extend past window + + GetTabSettings; + AWidth := LOWORD(GetTabbedTextExtent(Canvas.Handle, PChar(Caption), Length(Caption), - FListBox.FTabPix[0], FListBox.FTabPix[1])); + MAX_TABS+1, FTabs[0])); // inherent scrollbar may not always be visible in a long list if FListBox.LongList @@ -1355,4 +1447,20 @@ ORCBImages[i].Free; end; +end; + +{ TORStaticText } + +procedure TORStaticText.DoEnter; +begin + inherited DoEnter; + if Assigned(FOnEnter) then + FOnEnter(Self); +end; + +procedure TORStaticText.DoExit; +begin + inherited DoExit; + if Assigned(FOnExit) then + FOnExit(Self); end; @@ -1921,5 +2029,10 @@ // 32 bits long, in the high word of WPARAM (16 bits). Since that won't work - we'll // try sending the item index instead. - SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); + //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't + //Allow the Checkbox state on the control to be updated + if CheckBoxes then + PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)) + else + SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); end; VK_PRIOR: SetFocusIndex(FocusIndex - FLargeChange); @@ -2131,4 +2244,8 @@ begin //if Items.Count > 0 then SetFocusIndex(TopIndex); // this seems to cause problems + //Fix For ClearQuest: HDS00001576 + //This fix has been commented out, becuase it causes problems +{ if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then + SetFocusIndex(TopIndex);//ItemIndex := TopIndex; } inherited DoEnter; end; @@ -3640,4 +3757,5 @@ FEditBox.OnKeyUp := FwdKeyUp; FEditBox.Visible := True; + fCharsNeedMatch := 1; end; @@ -3749,7 +3867,19 @@ procedure TORComboBox.DoEnter; +{var + key : word;} { select all the text in the editbox when recieve focus - done first so OnEnter can deselect } begin //FEditBox.SelectAll; + //Fix For ClearQuest: HDS00001576 + //This fix has been commented out, becuase it causes problems +{ with FListBox do + if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then + begin + key := VK_UP; + FwdKeyDown(Self,key,[]); + //Calling keyUp after key down creates a better mimic of a Keystroke. + FwdKeyUp(Self,key,[]); //fixes clearquest: HDS00001418 + end; } inherited DoEnter; PostMessage(Handle, UM_GOTFOCUS, 0, 0) @@ -3800,5 +3930,11 @@ with FEditBox do x := Copy(Text, 1, SelStart); FLastInput := x; - SelectIndex := FListBox.SelectString(x); + SelectIndex := -1; + if Length(x) >= CharsNeedMatch then + SelectIndex := FListBox.SelectString(x); + if (Length(x) < CharsNeedMatch) and (FListBox.ItemIndex > -1) then + SelectIndex := FListBox.SelectString(x); + if UniqueAutoComplete then + SelectIndex := FListBox.VerifyUnique(SelectIndex,x); if FListItemsOnly and (SelectIndex < 0) and (x <> '') then begin @@ -3891,6 +4027,6 @@ { passed selected navigation keys to listbox, applies special handling to backspace and F4 } var - i: Integer; - x: string; + i,iPos: Integer; + x,AString: string; begin // special case: when default action taken (RETURN) make sure FwdChangeDelayed is called first @@ -3902,5 +4038,20 @@ if (FStyle = orcsDropDown) and not DroppedDown then DroppedDown := True; // handle special case of FocusIndex, WM_KEYDOWN will increment from -1 to 0 - if FListBox.ItemIndex = -1 then FListBox.FFocusIndex := -1; + if FListBox.ItemIndex = -1 then + begin + FListBox.FFocusIndex := -1; + //Move to correct position when Unique AutoComplete is on. + if UniqueAutoComplete then + begin + AString := Copy(FEditBox.Text, 1, SelStart); + iPos := SendMessage(FListBox.Handle, LB_FINDSTRING, -1, Longint(PChar(AString))); + if iPos = LB_ERR then iPos := -1; + if iPos > -1 then + begin + FListBox.FFocusIndex := iPos-1; + FListBox.ItemIndex := FListBox.FFocusIndex; + end; + end; + end; FListBox.Perform(WM_KEYDOWN, Key, 1); end; @@ -4703,5 +4854,5 @@ FListBox.CaseChanged := Value; end; - + function TORComboBox.GetLookupPiece: integer; begin @@ -4747,4 +4898,5 @@ H := ClientHeight; W := ClientWidth; + if (H = 0) or (W = 0) then exit; for i := 0 to Control.ControlCount - 1 do begin @@ -6157,4 +6309,27 @@ end; +procedure TORCheckBox.BMGetCheck(var Message: TMessage); +begin + {This Allows JAWS to report the state when tabbed into or using the read object + keys (Ins+Tab)} + {if Self.GrayedStyle = gsBlueQuestionMark then + Message.Result := BST_INDETERMINATE + else} + if Self.Checked then + Message.Result := BST_CHECKED + else + Message.Result := BST_UNCHECKED; +end; + +procedure TORCheckBox.BMGetState(var Message: TMessage); +begin + //This gives JAWS ability to read state when spacebar is pressed. + //Commented out because JAWS reads states, but inversly. Working with freedom... +{ if Self.Checked then + Message.Result := BST_CHECKED + else + Message.Result := BST_UNCHECKED;} +end; + { TORListView } @@ -6310,4 +6485,11 @@ { TCaptionListBox } +procedure TCaptionListBox.DoEnter; +begin + inherited; + if HintOnItem then + FHoverItemPos := -1; //CQ: 7178 & 9911 - used as last item index for ListBox +end; + function TCaptionListBox.GetCaption: string; begin @@ -6346,4 +6528,24 @@ else inherited; +end; + +procedure TCaptionListBox.WMMouseMove(var Message: TWMMouseMove); +var + i : integer; +begin + inherited; + //CQ: 7178 & 9911 - FHoverItemPos should be set to -1 in OnEnter + //Make the TListBox's hint contain the contents of the listbox Item the mouse is currently over + if HintOnItem then + begin + i := ItemAtPos(Point(Message.XPos, Message.YPos), true); + if i <> FHoverItemPos then + Application.CancelHint; + if i = -1 then + Hint := '' + else + Hint := Items[i]; + FHoverItemPos := i; + end; end; @@ -6451,4 +6653,21 @@ end; +{ TCaptionRichEdit } + +procedure TCaptionRichEdit.MakeAccessible(Accessible: IAccessible); +begin + if Assigned(FAccessible) and Assigned(Accessible) then + raise Exception.Create(Caption + ' Rich Edit is already Accessible!') + else + FAccessible := Accessible; +end; + +procedure TCaptionRichEdit.WMGetObject(var Message: TMessage); +begin + if (Message.LParam = integer(OBJID_CLIENT)) and Assigned(FAccessible) then + Message.Result := GetLResult(Message.wParam, FAccessible) + else + inherited; +end; { TCaptionTreeView} @@ -6558,4 +6777,63 @@ end; +function IsAMouseButtonDown : boolean; +begin + if Boolean(Hi(GetKeyState(VK_MBUTTON))) or + Boolean(Hi(GetKeyState(VK_LBUTTON))) or + Boolean(Hi(GetKeyState(VK_RBUTTON))) then + Result := true + else + Result := false; +end; + +procedure TORComboBox.SetNumForMatch(const NumberForMatch: integer); +begin + if NumberForMatch < 1 then + FCharsNeedMatch := 1 + else if NumberForMatch > 15 then + FCharsNeedMatch := 15 + else + FCharsNeedMatch := NumberForMatch; +end; + +procedure TORComboBox.SetUniqueAutoComplete(const Value: Boolean); +begin + FUniqueAutoComplete := Value; +end; + +function TORListBox.VerifyUnique(SelectIndex: Integer; iText: String): integer; +var + i : integer; + counter : integer; +begin + Result := SelectIndex; + if LongList then + begin + //Currently Do nothing for LongLists + { if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then + Result := -1;} + end + else //Not a LongList + begin + counter := 0; + for i := 0 to Items.Count-1 do + if CompareText(iText, Copy(DisplayText[i], 1, Length(iText))) = 0 then + Inc(counter); + if counter > 1 then + Result := -1; + end; + FFocusIndex := Result; + ItemIndex := Result; +end; + +//This procedure sets the Text property equal to the TextToMatch parameter, then calls +//FwdChangeDelayed which will perform an auto-completion on the text. +procedure TORComboBox.SetTextAutoComplete(TextToMatch: String); +begin + Text := TextToMatch; + SelStart := Length(Text); + FwdChangeDelayed; +end; + initialization //uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window Index: cprs/branches/GUI-config/CPRS-Lib/ORCtrlsDsgn.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORCtrlsDsgn.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORCtrlsDsgn.pas (revision 492) @@ -153,9 +153,9 @@ begin RegisterComponents('CPRS', - [TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit, + [TORStaticText, TORListBox, TORComboBox, TORAutoPanel, TOROffsetLabel, TORAlignEdit, TORAlignButton, TORAlignSpeedButton, TORTreeView, TORCheckBox, TORListView, TKeyClickPanel, TKeyClickRadioGroup, TCaptionListBox, TCaptionCheckListBox, TCaptionMemo, TCaptionEdit, TCaptionTreeView, TCaptionComboBox, - TCaptionListView, TCaptionStringGrid{, TORAlignBitBtn, TORCalendar}]); + TCaptionListView, TCaptionStringGrid, TCaptionRichEdit{, TORAlignBitBtn, TORCalendar}]); RegisterPropertyEditor( TypeInfo(string), TORCheckBox, 'ImageIndexes', TORImageIndexesPropertyEditor); Index: cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.cfg =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.cfg (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.cfg (revision 492) @@ -33,10 +33,10 @@ -$M16384,1048576 -K$00400000 --E"c:\program files\borland\delphi6\dev\exesave" +-E"c:\program files\borland\delphi7\dev\exesave" -N"..\cprs-lib\DCU" -LE"..\Packages" -LN"..\Packages" --U"..\cprs-lib;..\Packages" --O"..\cprs-lib;..\Packages" --I"..\cprs-lib;..\Packages" --R"..\cprs-lib;..\Packages" +-U"..\cprs-lib;..\Packages;..\CPRS-Lib\DCU" +-O"..\cprs-lib;..\Packages;..\CPRS-Lib\DCU" +-I"..\cprs-lib;..\Packages;..\CPRS-Lib\DCU" +-R"..\cprs-lib;..\Packages;..\CPRS-Lib\DCU" Index: cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dof =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dof (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dof (revision 492) @@ -1,4 +1,4 @@ [FileVersion] -Version=6.0 +Version=7.0 [Compiler] A=8 @@ -31,4 +31,53 @@ ShowWarnings=1 UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=1 +UnsafeCode=1 +UnsafeCast=1 [Linker] MapFile=3 @@ -46,5 +95,5 @@ PackageDLLOutputDir=..\Packages PackageDCPOutputDir=..\Packages -SearchPath=..\cprs-lib;..\Packages +SearchPath=..\cprs-lib;..\Packages;..\CPRS-Lib\DCU Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;TeeUI40;teedb40;tee40;ibevnt40;nmfast40;VistABroker Conditionals= @@ -90,16 +139,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; [HistoryLists\hlSearchPath] -Count=11 -Item0=..\cprs-lib;..\Packages -Item1=..\cprs-lib;..\Packages;c:\program files\vista\bdk32\d6 -Item2=..\cprs-lib;..\Packages;..\cprs-chart;..\cprs-chart\dcu -Item3=d:\vista\main\cprs-lib;d:\vista\main\Packages -Item4=d:\vista\main\cprs-lib;d:\program files\vista\broker\bdk32\d5 -Item5=d:\vista\main\cprs-chart;d:\vista\main\cprs-lib;d:\vista\main\cprs-chart\encounter;d:\vista\main\cprs-chart\consults -Item6=d:\vista\main\cprs-lib -Item7=\Dev\CPRS\main\CPRS-Lib -Item8=C:\Dev\CPRS\main\CPRS-Lib -Item9=\Projects\Perforce\main\CPRS-Lib -Item10=$(DELPHI)\Projects\Current\CPRS-Lib +Count=12 +Item0=..\cprs-lib;..\Packages;..\CPRS-Lib\DCU +Item1=..\cprs-lib;..\Packages +Item2=..\cprs-lib;..\Packages;c:\program files\vista\bdk32\d6 +Item3=..\cprs-lib;..\Packages;..\cprs-chart;..\cprs-chart\dcu +Item4=d:\vista\main\cprs-lib;d:\vista\main\Packages +Item5=d:\vista\main\cprs-lib;d:\program files\vista\broker\bdk32\d5 +Item6=d:\vista\main\cprs-chart;d:\vista\main\cprs-lib;d:\vista\main\cprs-chart\encounter;d:\vista\main\cprs-chart\consults +Item7=d:\vista\main\cprs-lib +Item8=\Dev\CPRS\main\CPRS-Lib +Item9=C:\Dev\CPRS\main\CPRS-Lib +Item10=\Projects\Perforce\main\CPRS-Lib +Item11=$(DELPHI)\Projects\Current\CPRS-Lib [HistoryLists\hlUnitOutputDirectory] Count=8 Index: cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dpk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dpk (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dpk (revision 492) @@ -32,7 +32,7 @@ vclsmp, vcl, - XWB_R60, ORCtrlLib60, - tee; + tee, + XWB_R70; contains Index: cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dsk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dsk (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/ORDateLib60.dsk (revision 492) @@ -0,0 +1,423 @@ +[Closed Files] +File_0=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\XMLUtils.pas',0,1,1,1,1,0,0 +File_1=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORSystem.pas',0,1,1,1,1,0,0 +File_2=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORNet.pas',0,1,1,1,1,0,0 +File_3=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORFn.pas',0,1,1,1,1,0,0 +File_4=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTmRng.pas',0,1,1,1,1,0,0 +File_5=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTmCal.pas',0,1,1,1,1,0,0 +File_6=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTm.pas',0,1,1,1,1,0,0 +File_7=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrlsDsgn.pas',0,1,1,1,1,0,0 +File_8=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrls.pas',0,1,1,1,1,0,0 +File_9=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORClasses.pas',0,1,1,1,1,0,0 + +[Modules] +Module0=P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDateLib60.dpk +Count=1 +EditWindowCount=1 +PackageWindowCount=1 + +[P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDateLib60.dpk] +ModuleType=PackageEditModule +FormState=0 +FormOnTop=0 + +[C:\Program Files\Borland\Delphi7\Projects\ProjectGroup1.bpg] +FormState=0 +FormOnTop=0 + +[EditWindow0] +ViewCount=1 +CurrentView=0 +View0=0 +CodeExplorer=CodeExplorer@EditWindow0 +MessageView=MessageView@EditWindow0 +Create=1 +Visible=1 +State=0 +Left=220 +Top=148 +Width=694 +Height=485 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=686 +ClientHeight=451 +LeftPanelSize=0 +LeftPanelClients=CodeExplorer@EditWindow0 +LeftPanelData=00000400010000000C000000436F64654578706C6F726572000000000000000000000000000000000001000000000000000000000000FFFFFFFF +RightPanelSize=0 +BottomPanelSize=0 +BottomPanelClients=MessageView@EditWindow0 +BottomPanelData=00000400010000000B0000004D657373616765566965770000000000000000000000000000000000FFFFFFFF + +[View0] +Module=P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDateLib60.dpk +CursorX=1 +CursorY=1 +TopLine=1 +LeftCol=1 + +[PackageWindow0] +Create=1 +Visible=0 +State=0 +Left=252 +Top=241 +Width=368 +Height=244 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=360 +ClientHeight=218 +TBDockHeight=244 +LRDockWidth=368 +Dockable=1 +StatusBar=0 +TextLabels=1 +Toolbar=1 +SectionWidth0=150 +SectionWidth1=210 +Module=P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDateLib60.dpk + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=100 +WatchShowColumnHeaders=1 +Create=1 +Visible=0 +State=0 +Left=185 +Top=498 +Width=809 +Height=202 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=801 +ClientHeight=176 +TBDockHeight=176 +LRDockWidth=426 +Dockable=1 + +[Breakpoints] +Count=0 + +[AddressBreakpoints] +Count=0 + +[Main Window] +Create=1 +Visible=1 +State=2 +Left=0 +Top=0 +Width=1024 +Height=112 +MaxLeft=-1 +MaxTop=-1 +MaxWidth=1032 +MaxHeight=112 +ClientWidth=1024 +ClientHeight=78 + +[ProjectManager] +Create=1 +Visible=0 +State=0 +Left=213 +Top=185 +Width=587 +Height=462 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=579 +ClientHeight=436 +TBDockHeight=489 +LRDockWidth=719 +Dockable=1 + +[Components] +Left=240 +Top=237 +Width=183 +Height=235 +Create=1 +Visible=0 +State=0 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=175 +ClientHeight=209 +TBDockHeight=235 +LRDockWidth=183 +Dockable=1 + +[CPUWindow] +Create=1 +Visible=0 +State=0 +Left=0 +Top=1 +Width=800 +Height=565 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=792 +ClientHeight=531 +DumpPane=79 +DisassemblyPane=264 +RegisterPane=231 +FlagPane=104 + +[AlignmentPalette] +Create=1 +Visible=0 +State=0 +Left=200 +Top=114 +Width=156 +Height=84 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=150 +ClientHeight=60 + +[PropertyInspector] +Create=1 +Visible=1 +State=0 +Left=10 +Top=107 +Width=188 +Height=493 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=180 +ClientHeight=467 +TBDockHeight=367 +LRDockWidth=190 +Dockable=1 +SplitPos=84 +ArrangeBy=Name +SelectedItem= +ExpandedItems= +HiddenCategories= + +[BreakpointWindow] +Create=1 +Visible=0 +State=0 +Left=143 +Top=285 +Width=737 +Height=197 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=729 +ClientHeight=171 +TBDockHeight=197 +LRDockWidth=737 +Dockable=1 +Column0Width=100 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=75 +Column5Width=75 + +[CallStackWindow] +Create=1 +Visible=0 +State=0 +Left=46 +Top=403 +Width=469 +Height=294 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=461 +ClientHeight=268 +TBDockHeight=294 +LRDockWidth=469 +Dockable=1 + +[ThreadStatusWindow] +Create=1 +Visible=0 +State=0 +Left=0 +Top=0 +Width=800 +Height=600 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=792 +ClientHeight=574 +TBDockHeight=152 +LRDockWidth=624 +Dockable=1 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=250 + +[ObjectTree] +Create=1 +Visible=0 +State=0 +Left=0 +Top=114 +Width=250 +Height=274 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=242 +ClientHeight=248 +TBDockHeight=248 +LRDockWidth=190 +Dockable=1 + +[DebugLogView] +Create=1 +Visible=0 +State=0 +Left=431 +Top=254 +Width=417 +Height=291 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=409 +ClientHeight=265 +TBDockHeight=291 +LRDockWidth=417 +Dockable=1 + +[LocalVarsWindow] +Create=1 +Visible=0 +State=0 +Left=441 +Top=447 +Width=421 +Height=192 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=413 +ClientHeight=166 +TBDockHeight=192 +LRDockWidth=421 +Dockable=1 + +[ToDo List] +Create=1 +Visible=0 +State=0 +Left=268 +Top=585 +Width=787 +Height=145 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=779 +ClientHeight=119 +TBDockHeight=250 +LRDockWidth=470 +Dockable=1 +Column0Width=355 +Column1Width=30 +Column2Width=100 +Column3Width=70 +Column4Width=70 +SortOrder=0 +ShowHints=1 +ShowChecked=0 + +[FPUWindow] +Create=1 +Visible=0 +State=0 +Left=306 +Top=280 +Width=457 +Height=250 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=449 +ClientHeight=216 +RegisterPane=121 +FlagPane=59 + +[ModuleWindow] +Create=1 +Visible=0 +State=0 +Left=63 +Top=224 +Width=638 +Height=355 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=630 +ClientHeight=329 +TBDockHeight=355 +LRDockWidth=638 +Dockable=1 +Column0Width=125 +Column1Width=100 +Column2Width=155 +EntryPointPane=225 +CompUnitPane=104 + +[MessageHintFrm] +Create=1 +Visible=0 +State=0 +Left=481 +Top=423 +Width=383 +Height=195 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=375 +ClientHeight=169 +TBDockHeight=195 +LRDockWidth=383 +Dockable=1 + +[CodeExplorer@EditWindow0] +Create=1 +Visible=0 +State=0 +Left=0 +Top=12 +Width=140 +Height=439 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=140 +ClientHeight=439 +TBDockHeight=305 +LRDockWidth=140 +Dockable=1 + +[MessageView@EditWindow0] +Create=1 +Visible=0 +State=0 +Left=-14 +Top=-510 +Width=443 +Height=85 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=443 +ClientHeight=85 +TBDockHeight=85 +LRDockWidth=443 +Dockable=1 + +[DockHosts] +DockHostCount=0 + Index: cprs/branches/GUI-config/CPRS-Lib/ORDtTm.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORDtTm.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORDtTm.pas (revision 492) @@ -174,4 +174,5 @@ function DateText: string; property TemplateField: boolean read FTemplateField write SetTemplateField; + property FMDate: TFMDateTime read GetFMDate write SetFMDate; published function Text: string; @@ -180,5 +181,4 @@ property IncludeMonth: boolean read FIncludeMonth write SetIncludeMonth; property LongMonths: boolean read FLongMonths write SetLongMonths default FALSE; - property FMDate: TFMDateTime read GetFMDate write SetFMDate; property Month: integer read FMonth write SetMonth; property Day: integer read FDay write SetDay; @@ -285,4 +285,5 @@ begin ResizeAnchoredFormToFont(self); + //FormStyle := fsStayOnTop; lstHour.TopIndex := 6; FFromSelf := False; Index: cprs/branches/GUI-config/CPRS-Lib/ORFn.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORFn.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORFn.pas (revision 492) @@ -114,4 +114,6 @@ procedure CallWhenIdleNotifyWhenDone(CallProc, DoneProc: TORIdleCallProc; Msg: String); procedure menuHideAllBut(aMenuItem: tMenuItem; butItems: array of tMenuItem); +function TabIsPressed : Boolean; +function ShiftTabIsPressed : Boolean; implementation // --------------------------------------------------------------------------- @@ -129,6 +131,6 @@ // ConvertSpecialStrings arrays - SearchChars: array[0..6] of String = (' Ii ',' Iii ',' Iv ',' Vi ',' Vii ',' Viii ',' Ix '); - ReplaceChars: array[0..6] of String = (' II ',' III ',' IV ',' VI ',' VII ',' VIII ',' IX '); + SearchChars: array[0..7] of String = (' Ii ',' Iii ',' Iv ',' Vi ',' Vii ',' Viii ',' Ix ','-Va'); + ReplaceChars: array[0..7] of String = (' II ',' III ',' IV ',' VI ',' VII ',' VIII ',' IX ','-VA'); { table for calculating CRC values (DWORD is Integer in Delphi 3, Cardinal in Delphi 4} @@ -832,5 +834,4 @@ procedure LimitStringLength(var AList: TStringList; MaxLength: Integer); -{ change a TStringList so that all strings in the list are shorter than MaxLength } var i, SpacePos: Integer; @@ -852,5 +853,5 @@ while (x[SpacePos] <> ' ') and (SpacePos > 1) do Dec(SpacePos); {**REV**} {changed 0 to 1} if SpacePos = 1 then SpacePos := MaxLength; {**REV**} {changed 0 to 1} - NewList.Add(Copy(x, 1, SpacePos - 1)); + NewList.Add(Copy(x, 1, SpacePos )); // CQ PSI-05-040 change SpacePos-1 to SpacePos Delete(x, 1, SpacePos); end; {while Length(x)} @@ -1710,4 +1711,15 @@ end; +function TabIsPressed : Boolean; +begin + Result := Boolean(Hi(GetKeyState(VK_TAB))) and not Boolean(Hi(GetKeyState(VK_SHIFT))); +end; + +function ShiftTabIsPressed : Boolean; +begin + Result := Boolean(Hi(GetKeyState(VK_TAB))) and Boolean(Hi(GetKeyState(VK_SHIFT))); +end; + + initialization FBaseFont := TFont.Create; Index: cprs/branches/GUI-config/CPRS-Lib/ORFn.~pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORFn.~pas (revision 476) +++ (revision ) @@ -1,1727 +1,0 @@ -unit ORFn; - -{$OPTIMIZATION OFF} - -interface // -------------------------------------------------------------------------------- - -uses SysUtils, Windows, Messages, Classes, Controls, StdCtrls, ExtCtrls, ComCtrls, Forms, - Graphics, Menus, RichEdit; - -const - U = '^'; - CRLF = #13#10; - BOOLCHAR: array[Boolean] of Char = ('0', '1'); - UM_STATUSTEXT = (WM_USER + 302); // used to send update status msg to main form - COLOR_CREAM = $F0FBFF; - -type - TFMDateTime = Double; - TORIdleCallProc = procedure(Msg: string); - -{ Date/Time functions } -function DateTimeToFMDateTime(ADateTime: TDateTime): TFMDateTime; -function FMDateTimeToDateTime(ADateTime: TFMDateTime): TDateTime; -function FMDateTimeOffsetBy(ADateTime: TFMDateTime; DaysDiff: Integer): TFMDateTime; -function FormatFMDateTime(AFormat: string; ADateTime: TFMDateTime): string; -function FormatFMDateTimeStr(const AFormat, ADateTime: string): string; -function IsFMDateTime(x: string): Boolean; -function MakeFMDateTime(const AString: string): TFMDateTime; -procedure SetListFMDateTime(AFormat: string; AList: TStringList; ADelim: Char; - PieceNum: Integer; KeepBad: boolean = FALSE); - -{ Numeric functions } -function HigherOf(i, j: Integer): Integer; -function LowerOf(i, j: Integer): Integer; -function StrToFloatDef(const S: string; ADefault: Extended): Extended; - -{ String functions } -function CharAt(const x: string; APos: Integer): Char; -function ContainsAlpha(const x: string): Boolean; -function ContainsVisibleChar(const x: string): Boolean; -function ConvertSpecialStrings(const x: string): String; -function CRCForFile(AFileName: string): DWORD; -function CRCForStrings(AStringList: TStrings): DWORD; -procedure ExpandTabsFilter(AList: TStrings; ATabWidth: Integer); -function ExtractInteger(x: string): Integer; -function ExtractFloat(x: string): Extended; -function ExtractDefault(Src: TStrings; const Section: string): string; -procedure ExtractItems(Dest, Src: TStrings; const Section: string); -procedure ExtractText(Dest, Src: TStrings; const Section: string); -function FilteredString(const x: string; ATabWidth: Integer = 8): string; -procedure InvertStringList(AList: TStringList); -procedure LimitStringLength(var AList: TStringList; MaxLength: Integer); -function MixedCase(const x: string): string; -procedure MixedCaseList(AList: TStrings); -procedure MixedCaseByPiece(AList: TStrings; ADelim: Char; PieceNum: Integer); -function Piece(const S: string; Delim: char; PieceNum: Integer): string; -function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string; -function ComparePieces(P1, P2: string; Pieces: array of integer; Delim: - char = '^'; CaseInsensitive: boolean = FALSE): integer; -procedure PiecesToList(x: string; ADelim: Char; AList: TStrings); -function ReverseStr(const x: string): string; -procedure SetPiece(var x: string; Delim: Char; PieceNum: Integer; const NewPiece: string); -procedure SetPieces(var x: string; Delim: Char; Pieces: Array of Integer; - FromString: string); -procedure SortByPiece(AList: TStringList; ADelim: Char; PieceNum: Integer); -function DelimCount(const Str, Delim: string): integer; -procedure QuickCopy(AFrom, ATo: TObject); -function ValidFileName(const InitialFileName: string): string; - -{ Display functions } -procedure ForceInsideWorkArea( var Rect: TRect); -//procedure ClearControl(AControl: TControl); -function InfoBox(const Text, Caption: string; Flags: Word): Integer; -procedure LimitEditWidth(AControl: TWinControl; NumChars: Integer); -function MainFont: TFont; -function MainFontSize: Integer; -function MainFontWidth: Integer; -function MainFontHeight: Integer; -function BaseFont: TFont; -procedure RedrawSuspend(AHandle: HWnd); -procedure RedrawActivate(AHandle: HWnd); -//procedure ResetControl(AControl: TControl); -procedure ResetSelectedForList(AListBox: TListBox); -procedure ResizeFormToFont(AForm: TForm); -procedure ResizeAnchoredFormToFont( AForm: TForm); -function ResizeWidth( OldFont: TFont; NewFont: TFont; OldWidth: integer): integer; -function ResizeHeight( OldFont: TFont; NewFont: TFont; OldHeight: integer): integer; -procedure ResizeToFont(FontSize: Integer; var W, H: Integer); -procedure SetEqualTabStops(AControl: TControl; TabWidth: Integer = 8); -procedure StatusText(const S: string); -function ShowMsgOn(AnExpression: Boolean; const AMsg, ACaption: string): Boolean; -function TextWidthByFont(AFontHandle: THandle; const x: string): Integer; -function TextHeightByFont(AFontHandle: THandle; const x: string): Integer; -function WrappedTextHeightByFont(Canvas: TCanvas; NewFont: TFont; ItemText: string; var ARect: TRect): integer; -function NumCharsFitInWidth(AFontHandle: THandle; const x: string; const MaxLen: integer): Integer; -function PopupComponent(Sender: TObject; PopupMenu: TPopupMenu): TComponent; -procedure ReformatMemoParagraph(AMemo: TCustomMemo); -function ReadOnlyColor: TColor; - -{ ListBox Grid functions } -procedure ListGridDrawCell(AListBox: TListBox; AHeader: THeaderControl; ARow, AColumn: Integer; - const x: string; WordWrap: Boolean); -procedure ListGridDrawLines(AListBox: TListBox; AHeader: THeaderControl; Index: Integer; - State: TOwnerDrawState); -function ListGridRowHeight(AListBox: TListBox; AHeader: THeaderControl; ARow, AColumn: Integer; - const x: string): Integer; - -{ Misc functions } -{ You MUST pass an address to an object variable to get KillObj to work } -procedure KillObj(ptr: Pointer; KillObjects: boolean = FALSE); -function HasKey(APerson: Int64; const AKey: string): Boolean; - -{ do NOT use CallWhenIdle to call RPCs. Use CallRPCWhenIdle in ORNet } -procedure CallWhenIdle(CallProc: TORIdleCallProc; Msg: String); -procedure CallWhenIdleNotifyWhenDone(CallProc, DoneProc: TORIdleCallProc; Msg: String); -procedure menuHideAllBut(aMenuItem: tMenuItem; butItems: array of tMenuItem); - -implementation // --------------------------------------------------------------------------- - -uses - ORCtrls, Grids, Chart, CheckLst; - -const - { names of months used by FormatFMDateTime } - MONTH_NAMES_SHORT: array[1..12] of string[3] = - ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); - MONTH_NAMES_LONG: array[1..12] of string[9] = - ('January','February','March','April','May','June','July','August','September','October', - 'November', 'December'); - - // ConvertSpecialStrings arrays - SearchChars: array[0..6] of String = (' Ii ',' Iii ',' Iv ',' Vi ',' Vii ',' Viii ',' Ix '); - ReplaceChars: array[0..6] of String = (' II ',' III ',' IV ',' VI ',' VII ',' VIII ',' IX '); - - { table for calculating CRC values (DWORD is Integer in Delphi 3, Cardinal in Delphi 4} - CRC32_TABLE: array[0..255] of DWORD = - ($0, $77073096, $EE0E612C, $990951BA, $76DC419, $706AF48F, $E963A535, $9E6495A3, - $EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $9B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, - $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, - $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, - $3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, - $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, - $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, - $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, - $76DC4190, $1DB7106, $98D220BC, $EFD5102A, $71B18589, $6B6B51F, $9FBFE4A5, $E8B8D433, - $7807C9A2, $F00F934, $9609A88E, $E10E9818, $7F6A0DBB, $86D3D2D, $91646C97, $E6635C01, - $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, - $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, - $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, - $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, - $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F, - $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, - $EDB88320, $9ABFB3B6, $3B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $4DB2615, $73DC1683, - $E3630B12, $94643B84, $D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $A00AE27, $7D079EB1, - $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, - $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, - $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, - $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, - $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F, - $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, - $9B64C2B0, $EC63F226, $756AA39C, $26D930A, $9C0906A9, $EB0E363F, $72076785, $5005713, - $95BF4A82, $E2B87A14, $7BB12BAE, $CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $BDBDF21, - $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, - $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, - $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, $3E6E77DB, - $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, - $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF, - $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); - - {Properties assigned to BaseFont} - BaseFontSize = 8; - BaseFontName = 'MS Sans Serif'; -var - FBaseFont: TFont; -type - EFMDateTimeError = class(Exception); - - {TFontControl is an artifact used for font resizing. Do not add virtual - methods or class variables to it!} - TFontControl = class(TControl) - public - property Font; - property ParentFont; - end; - -{ Date/Time functions } - -function DateTimeToFMDateTime(ADateTime: TDateTime): TFMDateTime; -{ converts a Delphi date/time type to a Fileman date/time (type double) } -var - y, m, d, h, n, s, l: Word; - DatePart,TimePart: Integer; -begin - DecodeDate(ADateTime, y, m, d); - DecodeTime(ADateTime, h, n, s, l); - DatePart := ((y-1700)*10000) + (m*100) + d; - TimePart := (h*10000) + (n*100) + s; - Result := DatePart + (TimePart / 1000000); -end; - -function FMDateTimeToDateTime(ADateTime: TFMDateTime): TDateTime; -{ converts a Fileman date/time (type double) to a Delphi date/time } -var - ADate, ATime: TDateTime; - DatePart, TimePart: string; -begin - DatePart := Piece(FloatToStrF(ADateTime, ffFixed, 14, 6), '.', 1); - TimePart := Piece(FloatToStrF(ADateTime, ffFixed, 14, 6), '.', 2) + '000000'; - if Length(DatePart) <> 7 then raise EFMDateTimeError.Create('Invalid Fileman Date'); - if Copy(TimePart, 1, 2) = '24' then TimePart := '23595959'; - ADate := EncodeDate(StrToInt(Copy(DatePart, 1, 3)) + 1700, - StrToInt(Copy(DatePart, 4, 2)), - StrToInt(Copy(DatePart, 6, 2))); - ATime := EncodeTime(StrToInt(Copy(TimePart, 1, 2)), - StrToInt(Copy(TimePart, 3, 2)), - StrToInt(Copy(TimePart, 5, 2)), 0); - Result := ADate + ATime; -end; - -function FMDateTimeOffsetBy(ADateTime: TFMDateTime; DaysDiff: Integer): TFMDateTime; -{ adds / subtracts days from a Fileman date/time and returns the offset Fileman date/time } -var - Julian: TDateTime; -begin - Julian := FMDateTimeToDateTime(ADateTime); - Result := DateTimeToFMDateTime(Julian + DaysDiff); -end; - -function FormatFMDateTime(AFormat: string; ADateTime: TFMDateTime): string; -{ formats a Fileman Date/Time using (mostly) the same format string as Delphi FormatDateTime } -var - x: string; - y, m, d, h, n, s: Integer; - - function TrimFormatCount: Integer; - { delete repeating characters and count how many were deleted } - var - c: Char; - begin - Result := 0; - c := AFormat[1]; - repeat - Delete(AFormat, 1, 1); - Inc(Result); - until CharAt(AFormat, 1) <> c; - end; - -begin {FormatFMDateTime} - Result := ''; - if not (ADateTime > 0) then Exit; - x := FloatToStrF(ADateTime, ffFixed, 15, 6) + '0000000'; - y := StrToIntDef(Copy(x, 1, 3), 0) + 1700; - m := StrToIntDef(Copy(x, 4, 2), 0); - d := StrToIntDef(Copy(x, 6, 2), 0); - h := StrToIntDef(Copy(x, 9, 2), 0); - n := StrToIntDef(Copy(x, 11, 2), 0); - s := StrToIntDef(Copy(x, 13, 2), 0); - while Length(AFormat) > 0 do - case UpCase(AFormat[1]) of - '"': begin // literal - Delete(AFormat, 1, 1); - while not (CharAt(AFormat, 1) in [#0, '"']) do - begin - Result := Result + AFormat[1]; - Delete(AFormat, 1, 1); - end; - if CharAt(AFormat, 1) = '"' then Delete(AFormat, 1, 1); - end; - 'D': case TrimFormatCount of // day/date - 1: if d > 0 then Result := Result + IntToStr(d); - 2: if d > 0 then Result := Result + FormatFloat('00', d); - end; - 'H': case TrimFormatCount of // hour - 1: Result := Result + IntToStr(h); - 2: Result := Result + FormatFloat('00', h); - end; - 'M': case TrimFormatCount of // month - 1: if m > 0 then Result := Result + IntToStr(m); - 2: if m > 0 then Result := Result + FormatFloat('00', m); - 3: if m in [1..12] then Result := Result + MONTH_NAMES_SHORT[m]; - 4: if m in [1..12] then Result := Result + MONTH_NAMES_LONG[m]; - end; - 'N': case TrimFormatCount of // minute - 1: Result := Result + IntToStr(n); - 2: Result := Result + FormatFloat('00', n); - end; - 'S': case TrimFormatCount of // second - 1: Result := Result + IntToStr(s); - 2: Result := Result + FormatFloat('00', s); - end; - 'Y': case TrimFormatCount of // year - 2: if y > 0 then Result := Result + Copy(IntToStr(y), 3, 2); - 4: if y > 0 then Result := Result + IntToStr(y); - end; - else begin // other - Result := Result + AFormat[1]; - Delete(AFormat, 1, 1); - end; - end; {case} -end; {FormatFMDateTime} - -function FormatFMDateTimeStr(const AFormat, ADateTime: string): string; -var - FMDateTime: TFMDateTime; -begin - Result := ADateTime; - if IsFMDateTime(ADateTime) then - begin - FMDateTime := MakeFMDateTime(ADateTime); - Result := FormatFMDateTime(AFormat, FMDateTime); - end; -end; - -function IsFMDateTime(x: string): Boolean; -var - i: Integer; -begin - Result := False; - if Length(x) < 7 then Exit; - for i := 1 to 7 do if not (x[i] in ['0'..'9']) then Exit; - if (Length(x) > 7) and (x[8] <> '.') then Exit; - if (Length(x) > 8) and not (x[9] in ['0'..'9']) then Exit; - Result := True; -end; - -function MakeFMDateTime(const AString: string): TFMDateTime; -begin - Result := -1; - if (Length(AString) > 0) and IsFMDateTime(AString) then Result := StrToFloat(AString); -end; - -procedure SetListFMDateTime(AFormat: string; AList: TStringList; ADelim: Char; - PieceNum: Integer; KeepBad: boolean = FALSE); -var - i: Integer; - s, x, x1: string; - -begin - for i := 0 to AList.Count - 1 do - begin - s := AList[i]; - x := Piece(s, ADelim, PieceNum); - if Length(x) > 0 then - begin - x1 := FormatFMDateTime(AFormat, MakeFMDateTime(x)); - if(x1 <> '') or (not KeepBad) then - x := x1; - end; - SetPiece(s, ADelim, PieceNum, x); - AList[i] := s; - end; -end; - -{ Numeric functions } - -function HigherOf(i, j: Integer): Integer; -{ returns the greater of two integers } -begin - Result := i; - if j > i then Result := j; -end; - -function LowerOf(i, j: Integer): Integer; -{ returns the lesser of two integers } -begin - Result := i; - if j < i then Result := j; -end; - -function StrToFloatDef(const S: string; ADefault: Extended): Extended; -begin - if not TextToFloat(PChar(S), Result, fvExtended) then - Result := ADefault; -end; - -{ String functions } - -function CharAt(const x: string; APos: Integer): Char; -{ returns a character at a given position in a string or the null character if past the end } -begin - if Length(x) < APos then Result := #0 else Result := x[APos]; -end; - -function ContainsAlpha(const x: string): Boolean; -{ returns true if the string contains any alpha characters } -var - i: Integer; -begin - Result := False; - for i := 1 to Length(x) do if x[i] in ['A'..'Z','a'..'z'] then - begin - Result := True; - break; - end; -end; - -function ContainsVisibleChar(const x: string): Boolean; -{ returns true if the string contains any printable characters } -var - i: Integer; -begin - Result := False; - for i := 1 to Length(x) do if x[i] in ['!'..'~'] then // ordinal values 33..126 - begin - Result := True; - break; - end; -end; - -function ConvertSpecialStrings(const x: string): string; -var i : Integer; -begin - for i := 0 to Length(SearchChars)-1 do - begin - Result := StringReplace(Result,SearchChars[i], ReplaceChars[i],[rfReplaceAll]); - end; -end; - -function UpdateCrc32(Value: DWORD; var Buffer: array of Byte; Count: Integer): DWORD; -var - i: integer; -begin - Result:=Value; - for i := 0 to Pred(Count) do - Result := ((Result shr 8) and $00FFFFFF) xor - CRC32_TABLE[(Result xor Buffer[i]) and $000000FF]; -end; - -function CRCForFile(AFileName: string): DWORD; -const - BUF_SIZE = 16383; -type - TBuffer = array[0..BUF_SIZE] of Byte; -var - Buffer: Pointer; - AHandle, BytesRead: Integer; -begin - Result:=$FFFFFFFF; - GetMem(Buffer, BUF_SIZE); - AHandle := FileOpen(AFileName, fmShareDenyWrite); - repeat - BytesRead := FileRead(AHandle, Buffer^, BUF_SIZE); - Result := UpdateCrc32(Result, TBuffer(Buffer^), BytesRead); - until BytesRead <> BUF_SIZE; - FileClose(AHandle); - FreeMem(Buffer); - Result := not Result; -end; - -function CRCForStrings(AStringList: TStrings): DWORD; -{ returns a cyclic redundancy check for a list of strings } -var - i, j: Integer; -begin - Result:=$FFFFFFFF; - for i := 0 to AStringList.Count - 1 do - for j := 1 to Length(AStringList[i]) do - Result:=((Result shr 8) and $00FFFFFF) xor - CRC32_TABLE[(Result xor Ord(AStringList[i][j])) and $000000FF]; -end; - -function FilteredString(const x: string; ATabWidth: Integer = 8): string; -var - i, j: Integer; -begin - Result := ''; - for i := 1 to Length(x) do - case x[i] of - #9: for j := 1 to (ATabWidth - (Length(Result) mod ATabWidth)) do - Result := Result + ' '; - #32..#127: Result := Result + x[i]; - #128..#159: Result := Result + '?'; - #10,#13,#160: Result := Result + ' '; - #161..#255: Result := Result + x[i]; - end; - if Copy(Result, Length(Result), 1) = ' ' then Result := TrimRight(Result) + ' '; -end; - -procedure ExpandTabsFilter(AList: TStrings; ATabWidth: Integer); -var - i, j, k: Integer; - x, y: string; -begin - with AList do for i := 0 to Count - 1 do - begin - x := Strings[i]; - y := ''; - for j := 1 to Length(x) do - case x[j] of - #9: for k := 1 to (ATabWidth - (Length(y) mod ATabWidth)) do y := y + ' '; - #32..#127: y := y + x[j]; - #128..#159: y := y + '?'; - #160: y := y + ' '; - #161..#255: y := y + x[j]; - end; - if Copy(y, Length(y), 1) = ' ' then y := TrimRight(y) + ' '; - Strings[i] := y; - //Strings[i] := TrimRight(y) + ' '; - end; -end; - -function ExtractInteger(x: string): Integer; -{ strips leading & trailing alphas to return an integer } -var - i: Integer; -begin - while (Length(x) > 0) and not (x[1] in ['0'..'9']) do Delete(x, 1, 1); - for i := 1 to Length(x) do if not (x[i] in ['0'..'9']) then break; - Result := StrToIntDef(Copy(x, 1, i - 1), 0); -end; - -function ExtractFloat(x: string): Extended; -{ strips leading & trailing alphas to return a float } -var - i: Integer; -begin - while (Length(x) > 0) and not (x[1] in ['0'..'9', '.']) do Delete(x, 1, 1); - for i := 1 to Length(x) do if not (x[i] in ['0'..'9','.']) then break; - Result := StrToFloatDef(Copy(x, 1, i - 1), 0); -end; - -function ExtractDefault(Src: TStrings; const Section: string): string; -var - i: Integer; -begin - Result := ''; - i := -1; - repeat Inc(i) until (i = Src.Count) or (Src[i] = '~' + Section); - Inc(i); - if (i < Src.Count) and (Src[i][1] <> '~') then repeat - if Src[i][1] = 'd' then Result := Copy(Src[i], 2, MaxInt); - Inc(i); - until (i = Src.Count) or (Src[i][1] = '~') or (Length(Result) > 0); -end; - -procedure ExtractItems(Dest, Src: TStrings; const Section: string); -var - i: Integer; -begin - i := -1; - repeat Inc(i) until (i = Src.Count) or (Src[i] = '~' + Section); - Inc(i); - if (i < Src.Count) and (Src[i][1] <> '~') then repeat - if Src[i][1] = 'i' then Dest.Add(Copy(Src[i], 2, MaxInt)); - Inc(i); - until (i = Src.Count) or (Src[i][1] = '~'); -end; - -procedure ExtractText(Dest, Src: TStrings; const Section: string); -var - i: Integer; -begin - i := -1; - repeat Inc(i) until (i = Src.Count) or (Src[i] = '~' + Section); - Inc(i); - if (i < Src.Count) and (Src[i][1] <> '~') then repeat - if Src[i][1] = 't' then Dest.Add(Copy(Src[i], 2, MaxInt)); - Inc(i); - until (i = Src.Count) or (Src[i][1] = '~'); -end; - -procedure InvertStringList(AList: TStringList); -var - i: Integer; -begin - with AList do for i := 0 to ((Count div 2) - 1) do Exchange(i, Count - i - 1); -end; - -function MixedCase(const x: string): string; -var - i: integer; -begin - Result := x; - for i := 2 to Length(x) do - if (not (x[i-1] in [' ',',','-','.','/','^'])) and (x[i] in ['A'..'Z']) - // save line if (not (x[i-1] in [' ','''',',','-','.','/','^'])) and (x[i] in ['A'..'Z']) - then Result[i] := Chr(Ord(x[i]) + 32) - else if ((x[i-1] in [' ',',','-','.','/','^'])) and (x[i] in ['a'..'z']) - then Result[i] := Chr(Ord(x[i]) - 32); - //Call added to satisfy the need for special string handling(Roman Numerals II-XI) GRE-06/02 - Result := ConvertSpecialStrings(x); -end; - -procedure MixedCaseList(AList: TStrings); -var - i: integer; -begin - for i := 0 to (AList.Count - 1) do AList[i] := MixedCase(AList[i]); -end; - -procedure MixedCaseByPiece(AList: TStrings; ADelim: Char; PieceNum: Integer); -var - i: Integer; - x, p: string; -begin - for i := 0 to (AList.Count - 1) do - begin - x := AList[i]; - p := MixedCase(Piece(x, ADelim, PieceNum)); - SetPiece(x, ADelim, PieceNum, p); - AList[i] := x; - end; -end; - -function Piece(const S: string; Delim: char; PieceNum: Integer): string; -{ returns the Nth piece (PieceNum) of a string delimited by Delim } -var - i: Integer; - Strt, Next: PChar; -begin - i := 1; - Strt := PChar(S); - Next := StrScan(Strt, Delim); - while (i < PieceNum) and (Next <> nil) do - begin - Inc(i); - Strt := Next + 1; - Next := StrScan(Strt, Delim); - end; - if Next = nil then Next := StrEnd(Strt); - if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt); -end; - -function Pieces(const S: string; Delim: char; FirstNum, LastNum: Integer): string; -{ returns several contiguous pieces } -var - PieceNum: Integer; -begin - Result := ''; - for PieceNum := FirstNum to LastNum do Result := Result + Piece(S, Delim, PieceNum) + Delim; - if Length(Result) > 0 then Delete(Result, Length(Result), 1); -end; - -function ComparePieces(P1, P2: string; Pieces: array of integer; Delim: - char = '^'; CaseInsensitive: boolean = FALSE): integer; -var - i: integer; - -begin - i := 0; - Result := 0; - while i <= high(Pieces) do - begin - if(CaseInsensitive) then - Result := CompareText(Piece(P1, Delim, Pieces[i]), - Piece(P2, Delim, Pieces[i])) - else - Result := CompareStr(Piece(P1, Delim, Pieces[i]), - Piece(P2, Delim, Pieces[i])); - if(Result = 0) then - inc(i) - else - break; - end; -end; - -procedure PiecesToList(x: string; ADelim: Char; AList: TStrings); -{ adds each piece to a TStrings list, the list is cleared first } -var - APiece: string; -begin - AList.Clear; - while Length(x) > 0 do - begin - APiece := Piece(x, ADelim, 1); - AList.Add(APiece); - Delete(x, 1, Length(APiece) + 1); - end; -end; - -function ReverseStr(const x: string): string; -var - i, j: Integer; -begin - SetString(Result, PChar(x), Length(x)); - i := 0; - for j := Length(x) downto 1 do - begin - Inc(i); - Result[i] := x[j]; - end; -end; - -procedure SetPiece(var x: string; Delim: Char; PieceNum: Integer; const NewPiece: string); -{ sets the Nth piece (PieceNum) of a string to NewPiece, adding delimiters as necessary } -var - i: Integer; - Strt, Next: PChar; -begin - i := 1; - Strt := PChar(x); - Next := StrScan(Strt, Delim); - while (i < PieceNum) and (Next <> nil) do - begin - Inc(i); - Strt := Next + 1; - Next := StrScan(Strt, Delim); - end; - if Next = nil then Next := StrEnd(Strt); - if i < PieceNum - then x := x + StringOfChar(Delim, PieceNum - i) + NewPiece - else x := Copy(x, 1, Strt - PChar(x)) + NewPiece + StrPas(Next); -end; - -procedure SetPieces(var x: string; Delim: Char; Pieces: Array of Integer; - FromString: string); -var - i: integer; - -begin - for i := low(Pieces) to high(Pieces) do - SetPiece(x, Delim, Pieces[i], Piece(FromString, Delim, Pieces[i])); -end; - -procedure SortByPiece(AList: TStringList; ADelim: Char; PieceNum: Integer); -var - i: integer; -begin - for i := 0 to AList.Count - 1 do - AList[i] := Piece(AList[i], ADelim, PieceNum) + ADelim + AList[i]; - AList.Sort; - for i := 0 to AList.Count - 1 do - AList[i] := Copy(AList[i], Pos(ADelim, AList[i]) + 1, MaxInt); -end; - -function DelimCount(const Str, Delim: string): integer; -var - i, dlen, slen: integer; - -begin - Result := 0; - i := 1; - dlen := length(Delim); - slen := length(Str) - dlen + 1; - while(i <= slen) do - begin - if(copy(Str,i,dlen) = Delim) then - begin - inc(Result); - inc(i,dlen); - end - else - inc(i); - end; -end; - -type - TREStrings = class(TStrings) - protected - FPlainText: Boolean; - public - property PlainText: Boolean read FPlainText write FPlainText; - end; - -type - QuickCopyError = class(Exception); - -procedure QuickCopy(AFrom, ATo: TObject); -var - ms: TMemoryStream; - idx: integer; - str: array[0..1] of TStrings; - fix: array[0..1] of boolean; - - procedure GetStrings(obj: TObject); - begin - if (CompareText(obj.ClassName, 'TRichEditStrings') = 0) then - raise QuickCopyError.Create('You must pass the TRichEdit object into QuickCopy, NOT it''s Lines property.'); - if obj is TStrings then - str[idx] := TStrings(obj) - else - if obj is TMemo then - str[idx] := TMemo(obj).Lines - else - if obj is TORListBox then - str[idx] := TORListBox(obj).Items - else - if obj is TListBox then - str[idx] := TListBox(obj).Items - else - if obj is TRichEdit then - begin - with TRichEdit(obj) do - begin - str[idx] := Lines; - if not PlainText then - begin - fix[idx] := TRUE; - PlainText := TRUE; - end; - end; - end - else - raise QuickCopyError.Create('Unsupported object type (' + obj.ClassName + - ') passed into QuickCopy.'); - inc(idx); - end; - - -begin - fix[0] := FALSE; - fix[1] := FALSE; - idx := 0; - GetStrings(AFrom); - GetStrings(ATo); - ms := TMemoryStream.Create; - try - str[0].SaveToStream(ms); - ms.Seek(0, soFromBeginning); - str[1].LoadFromStream(ms); - finally - ms.Free; - end; - if fix[0] then TRichEdit(AFrom).PlainText := FALSE; - if fix[1] then TRichEdit(ATo).PlainText := FALSE; -end; - -function ValidFileName(const InitialFileName: string): string; -var - i: integer; - -begin - Result := InitialFileName; - i := 1; - while i <= length(Result) do - begin - if Result[i] in ['a'..'z','A'..'Z','0'..'9',#32] then - inc(i) - else - delete(Result,i,1); - end; -end; - -procedure LimitStringLength(var AList: TStringList; MaxLength: Integer); -{ change a TStringList so that all strings in the list are shorter than MaxLength } -var - i, SpacePos: Integer; - x: string; - NewList: TStringList; -begin - NewList := TStringList.Create; - try - for i := 0 to AList.Count - 1 do - begin - if Length(AList[i]) > MaxLength then - begin - x := AList[i]; - while Length(x) > MaxLength do - begin - SpacePos := MaxLength; -// while SpacePos > 0 do {**REV**} removed after v11b -// if (x[SpacePos] <> ' ') then Dec(SpacePos); {**REV**} removed after v11b - while (x[SpacePos] <> ' ') and (SpacePos > 1) do Dec(SpacePos); {**REV**} {changed 0 to 1} - if SpacePos = 1 then SpacePos := MaxLength; {**REV**} {changed 0 to 1} - NewList.Add(Copy(x, 1, SpacePos - 1)); - Delete(x, 1, SpacePos); - end; {while Length(x)} - if Length(x) > 0 then NewList.Add(x); - end {then} - else NewList.Add(AList[i]); - end; {for i} - AList.Clear; - AList.Assign(NewList); - finally - NewList.Free; - end; -end; - -{ Display functions } - -(* -procedure ClearControl(AControl: TControl); -{ clears a control, removes text and listbox items } -begin - if AControl is TLabel then with TLabel(AControl) do Caption := '' - else if AControl is TButton then with TButton(AControl) do Caption := '' - else if AControl is TEdit then with TEdit(AControl) do Text := '' - else if AControl is TMemo then with TMemo(AControl) do Clear - else if AControl is TListBox then with TListBox(AControl) do Clear - else if AControl is TORComboBox then with TORComboBox(AControl) do - begin - MItems.Clear; - Text := ''; - end - else if AControl is TComboBox then with TComboBox(AControl) do - begin - Clear; - Text := ''; - end; -end; - -procedure ResetControl(AControl: TControl); -{ clears text, deselects items, does not remove listbox or combobox items } -begin - if AControl is TLabel then with TLabel(AControl) do Caption := '' - else if AControl is TButton then with TButton(AControl) do Caption := '' - else if AControl is TEdit then with TEdit(AControl) do Text := '' - else if AControl is TMemo then with TMemo(AControl) do Clear - else if AControl is TListBox then with TListBox(AControl) do ItemIndex := -1 - else if AControl is TORComboBox then with TORComboBox(AControl) do - begin - Text := ''; - ItemIndex := -1; - end - else if AControl is TComboBox then with TComboBox(AControl) do - begin - Text := ''; - ItemIndex := -1; - end; -end; -*) - -function InfoBox(const Text, Caption: string; Flags: Word): Integer; -{ wrap the messagebox object in case we want to modify it later } -begin - Result := Application.MessageBox(PChar(Text), PChar(Caption), Flags or MB_TOPMOST); -end; - -procedure LimitEditWidth(AControl: TWinControl; NumChars: Integer); -{ limits the editing area to be no more than N characters (also sets small left margin) } -const - LEFT_MARGIN = 4; -var - ARect: TRect; - AHandle: DWORD; - AWidth, i: Integer; - x: string; -begin - Inc(NumChars); - SetString(x, nil, NumChars); - for i := 1 to NumChars do x[i] := 'X'; - with AControl do - begin - AHandle := 0; - if AControl is TEdit then AHandle := TEdit(AControl).Font.Handle; - if AControl is TMemo then AHandle := TMemo(AControl).Font.Handle; - if AControl is TRichEdit then AHandle := TRichEdit(AControl).Font.Handle; - if AHandle = 0 then Exit; - AWidth := TextWidthByFont(AHandle, x); - ARect := Rect(LEFT_MARGIN, 0, AWidth + LEFT_MARGIN, ClientHeight); - // set the editing rectangle to with with of NumChars - SendMessage(Handle, EM_SETRECT, 0, Longint(@ARect)); - // turn on auto-scrolling for a rich edit - if AControl is TRichEdit - then SendMessage(Handle, EM_SETOPTIONS, ECOOP_OR, ECO_AUTOHSCROLL + ECO_AUTOVSCROLL); - end; -end; - -function BaseFont: TFont; -begin - result := FBaseFont; -end; - -function MainFont: TFont; -begin - if Application.MainForm <> nil - then Result := Application.MainForm.Font - else Result := BaseFont; -end; - -function MainFontSize: Integer; -{ return font size of the Main Form in the application } -begin - Result := MainFont.Size; -end; - -function FontWidthSubPixel( Font: TFont): real; -{ return in pixels the average character width of the font passed in FontHandle } -var - TotalWidth: integer; -begin - TotalWidth := TextWidthByFont( Font.Handle, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'); - result := TotalWidth / 52; -end; - -function FontWidthPixel( Font: TFont): integer; -begin - //Round() is too fancy to be correct here - result := Trunc(FontWidthSubPixel(Font) + 0.5); -end; - -function MainFontWidth: Integer; -begin - Result := FontWidthPixel(MainFont); -end; - -function MainFontHeight: Integer; -{ return font size of the Main Form in the application. -Note that TFont.Height is negative of what we want (see Delphi documentation)} -begin - Result := Abs(MainFont.Height); -end; - -procedure RedrawSuspend(AHandle: HWnd); -begin - SendMessage(AHandle, WM_SETREDRAW, 0, 0); -end; - -procedure RedrawActivate(AHandle: HWnd); -begin - SendMessage(AHandle, WM_SETREDRAW, 1, 0); - InvalidateRect(AHandle, nil, True); -end; - -procedure ResetSelectedForList(AListBox: TListBox); -var - i: Integer; -begin - with AListBox do for i := 0 to Items.Count - 1 do Selected[i] := False; -end; - -function ResizeWidth( OldFont: TFont; NewFont: TFont; OldWidth: integer): integer; -begin - result := Trunc( OldWidth *FontWidthSubPixel(NewFont) / FontWidthSubPixel(OldFont) - +0.5); -end; - -function ResizeHeight( OldFont: TFont; NewFont: TFont; OldHeight: integer): integer; -begin - result := Trunc( OldHeight *Abs(NewFont.Height) / Abs(OldFont.Height) - +0.5); -end; - -procedure ResizeToFont(FontSize: Integer; var W, H: Integer); -{ resizes form relative to the font size, assumes form designed with -DefaultFont (>MS Sans Serif 8pt<) } -var - Font: TFont; -begin - Font := TFont.Create; - Font.Name := BaseFontName; - Font.Size := FontSize; - W := ResizeWidth( BaseFont, Font, W); - H := ResizeHeight( BaseFont, Font, H); -end; - -procedure ResizeHeaderControl( OldFont: TFont; NewFont: TFont; Control: THeaderControl); -{Tested against fOrders page.} -var - i: integer; -begin - for i := 0 to Control.Sections.Count-1 do - Control.Sections[i].Width := ResizeWidth( OldFont, NewFont, Control.Sections[i].Width); -end; - -procedure ResizeListView( OldFont: TFont; NewFont: TFont; Control: TListView); -var - i: integer; -begin - if not Assigned(Control.OnResize) then - for i := 0 to Control.Columns.Count-1 do - Control.Columns[i].Width := ResizeWidth( OldFont, NewFont, Control.Columns[i].Width); -end; - -procedure ResizeComboBox( OldFont: TFont; NewFont: TFont; Control: TComboBox); -begin - Control.ItemHeight := ResizeHeight( OldFont, NewFont, Control.ItemHeight); -end; - -procedure ResizeListBox( OldFont: TFont; NewFont: TFont; Control: TListBox); -begin - Control.ItemHeight := ResizeHeight( OldFont, NewFont, Control.ItemHeight); -end; - -procedure ResizeCheckListBox( OldFont: TFont; NewFont: TFont; Control: TCheckListBox); -begin - Control.ItemHeight := ResizeHeight( OldFont, NewFont, Control.ItemHeight); -end; - -procedure ResizeDescendants( OldFont: TFont; NewFont: TFont; AControl: TWinControl); -var - i: integer; - Child: TControl; - VisibleWidth, TotalWidth: integer; - VisibleHeight, TotalHeight: integer; -begin - if AControl.Align <> alNone then - Application.ProcessMessages; - AControl.DisableAlign; - try - //I think I finally got this next part right, so I will try to explain what - //it is doing. - //At this stage, the control is resized, but all of the childern are in - //original size. - //These children are corretly aligned to the visible part of the control, - //but may not be correctly aligned in the underlying canvas if there are - //scroll bars. - //We wish to transform the children to have the correct new size and be - //aligned to the new underlying canvas size. - - //For the widths, I have kept track of what parts of the screen we are - //resizing. The height will work the same way. - //The notation is A[B]C, where A is the space to the left of the child - //control, B is the space containing the child control, and C is the space - //to the right. - VisibleWidth := AControl.Width; - VisibleHeight := AControl.Height; - TotalWidth := VisibleWidth; - TotalHeight := VisibleHeight; - if AControl is TScrollingWinControl then - begin - TotalWidth := HigherOf(TotalWidth, TScrollingWinControl(AControl).HorzScrollBar.Range); - TotalHeight := HigherOf(TotalHeight, TScrollingWinControl(AControl).VertScrollBar.Range); - end; - for i := 0 to AControl.ControlCount -1 do begin - Child := AControl.Controls[i]; - //Tab sheets auto-size with their parents - if not (Child is TTabSheet) then - with Child do begin - if [akLeft,akRight] <= Anchors then //X[.]X - Width := TotalWidth - ResizeWidth( OldFont, NewFont, VisibleWidth - Width) - else //.[X]. - Width := ResizeWidth( OldFont, NewFont, Width); - if not(akLeft in Anchors) then //.[X]X - Left := TotalWidth - ResizeWidth( OldFont, NewFont, VisibleWidth - Left) - else - Left := ResizeWidth( OldFont, NewFont, Left); //X[.]. - if [akTop,akBottom] <= Anchors then - Height := TotalHeight - ResizeHeight( OldFont, NewFont, VisibleHeight - Height) - else - Height := ResizeHeight( OldFont, NewFont, Height); - if not(akTop in Anchors) then - Top := TotalHeight - ResizeHeight( OldFont, NewFont, VisibleHeight - Top) - else - Top := ResizeHeight( OldFont, NewFont, Top); - end; - //Recurse. Let Auto-Size panels take care of themselves - if (Child is TWinControl) and not (Child is TORAutoPanel) then - ResizeDescendants( OldFont, NewFont, TWinControl(Child)); - if Child is TComboBox then - ResizeComboBox( OldFont, NewFont, TComboBox(Child)); - if Child is TCheckListBox then - ResizeCheckListBox( OldFont, NewFont, TCheckListBox(Child)); - if Child is THeaderControl then - ResizeHeaderControl( OldFont, NewFont, THeaderControl(Child)); - if Child is TListBox then - ResizeListBox( OldFont, NewFont, TListBox(Child)); - if Child is TListView then - ResizeListView( OldFont, NewFont, TListView(Child)); - if Child is TDrawGrid then with TDrawGrid(Child) do - //from Win32 "How to Calculate the Height of Edit Control..." - DefaultRowHeight := Abs(NewFont.Height) * 3 div 2; - if Child is TTabControl then with TTabControl(Child) do begin - if Tabs.Count > 0 then - TabWidth := ResizeWidth( OldFont, NewFont, TabWidth); - Width := TabWidth * Tabs.Count +3; - end; - end; - finally - AControl.EnableAlign; - end; -end; - -procedure ResizeChartFonts( OldFont: TFont; NewFont: TFont; Control: TChart); -var - i: integer; -begin - with Control do begin - if LeftAxis.Title.Font.Size = OldFont.Size then - LeftAxis.Title.Font.Size := NewFont.Size; - if LeftAxis.LabelsFont.Size = OldFont.Size then - LeftAxis.LabelsFont.Size := NewFont.Size; - if BottomAxis.Title.Font.Size = OldFont.Size then - BottomAxis.Title.Font.Size := NewFont.Size; - if BottomAxis.LabelsFont.Size = OldFont.Size then - BottomAxis.LabelsFont.Size := NewFont.Size; - if Legend.Font.Size = OldFont.Size then - Legend.Font.Size := NewFont.Size; - if Title.Font.Size = OldFont.Size then - Title.Font.Size := NewFont.Size; - for i := 0 to SeriesCount - 1 do - if Series[i].Marks.Font.Size = OldFont.Size then - Series[i].Marks.Font.Size := NewFont.Size; - end; -end; - -procedure ResizeFontsInDescendants( OldFont: TFont; NewFont: TFont; AControl: TWinControl); -var - i: integer; - Child: TControl; - RESelectionStart: integer; - RESelectionLength: integer; -begin - for i := 0 to AControl.ControlCount -1 do begin - Child := AControl.Controls[i]; - if Child is TRichEdit then begin - with TRichEdit(Child) do - if Font.Size = OldFont.Size then begin - if not ParentFont then - Font.Size := NewFont.Size; - RESelectionStart := SelStart; - RESelectionLength := SelLength; - SelectAll; - SelAttributes.Size := NewFont.Size; - DefAttributes.Size := NewFont.Size; - SelStart := RESelectionStart; - SelLength := RESelectionLength; - end - end - else - if Child is TChart then - ResizeChartFonts( OldFont, NewFont, TChart(Child)) - else - with TFontControl(Child) do - if (Font.Size = OldFont.Size) and not ParentFont then - Font.Size := NewFont.Size; - - if Child is TWinControl then - ResizeFontsInDescendants( OldFont, NewFont, TWinControl(Child)); - end; -end; - -procedure ForceInsideWorkArea( var Rect: TRect); -var - Frame: TRect; -begin - Frame := Screen.WorkAreaRect; - {Veritcal version:} - {Align bottom (preserving height) if needed} - if Rect.Bottom > Frame.Bottom then - begin - Rect.Top := Rect.Top + Frame.Bottom - Rect.Bottom; - Rect.Bottom := Frame.Bottom; - end; - {Then align top (preserving height) if needed} - if Rect.Top < Frame.Top then - begin - Rect.Bottom := Rect.Bottom + Frame.Top - Rect.Top; - Rect.Top := Frame.Top; - end; - {Now shrink (preserving top) if needed} - if Rect.Bottom > Frame.Bottom then - Rect.Bottom := Frame.Bottom; - {Horizontal version:} - if Rect.Right > Frame.Right then - begin - Rect.Left := Rect.Left + Frame.Right - Rect.Right; - Rect.Right := Frame.Right; - end; - if Rect.Left < Frame.Left then - begin - Rect.Right := Rect.Right + Frame.Left - Rect.Left; - Rect.Left := Frame.Left; - end; - if Rect.Right > Frame.Right then - Rect.Right := Frame.Right; -end; - -procedure ResizeFormToFont(AForm: TForm); -var - Rect: TRect; -begin - with AForm do begin - ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); - ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); - HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); - VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); - Rect := BoundsRect; - ForceInsideWorkArea(Rect); - BoundsRect := Rect; - ResizeFontsInDescendants( Font, MainFont, AForm); - //Important: We are using the font to calculate everything, so don't - //change font until now. - Font.Size := MainFont.Size; - end; -end; - -procedure ResizeAnchoredFormToFont( AForm: TForm); -var - Rect: TRect; -begin - with AForm do begin - ClientWidth := ResizeWidth( Font, MainFont, ClientWidth); - ClientHeight := ResizeHeight( Font, MainFont, ClientHeight); - HorzScrollBar.Range := ResizeWidth( Font, MainFont, HorzScrollBar.Range); - VertScrollBar.Range := ResizeHeight( Font, MainFont, VertScrollBar.Range); - Rect := BoundsRect; - ForceInsideWorkArea(Rect); - BoundsRect := Rect; - ResizeDescendants( Font, MainFont, AForm); - ResizeFontsInDescendants( Font, MainFont, AForm); - //Important: We are using the font to calculate everything, so don't - //change font until now. - Font.Size := MainFont.Size; - end; -end; - -procedure SetEqualTabStops(AControl: TControl; TabWidth: Integer = 8); -{ sets tab stops to match the width when the tab is replaced with TabWidth spaces } -const - MAX_TABS = 10; - POINTS_PER_INCH = 72; -var - DC: HDC; - i, HorzPixelsPerInch, PixelsPerTabWidth, PointsPerTabWidth: Integer; -begin - if AControl is TRichEdit then with TRichEdit(AControl) do - begin - DC := GetDC(0); - HorzPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSX); - ReleaseDC(0, DC); - PixelsPerTabWidth := TextWidthByFont(Font.Handle, StringOfChar(' ', TabWidth)); - PointsPerTabWidth := Round((PixelsPerTabWidth / HorzPixelsPerInch) * POINTS_PER_INCH); - for i := 0 to MAX_TABS do Paragraph.Tab[i] := PointsPerTabWidth * Succ(i); - end; -end; - -procedure StatusText(const S: string); -{ sends a user defined message to the main window of an application to display the text - found in lParam. Only useful if the main window has message event for this message } -begin - if (Application.MainForm <> nil) and (Application.MainForm.HandleAllocated) - then SendMessage(Application.MainForm.Handle, UM_STATUSTEXT, 0, Integer(PChar(S))); -end; - -function ShowMsgOn(AnExpression: Boolean; const AMsg, ACaption: string): Boolean; -begin - Result := AnExpression; - if Result then InfoBox(AMsg, ACaption, MB_OK); -end; - -function TextWidthByFont(AFontHandle: THandle; const x: string): Integer; -{ returns the width of a string in pixels, given a FONT handle and string } -var - DC: HDC; - SaveFont: HFont; - TextSize: TSize; -begin - DC := GetDC(0); - SaveFont := SelectObject(DC, AFontHandle); - GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); - Result := TextSize.cx; - SelectObject(DC, SaveFont); - ReleaseDC(0, DC); -end; - -function TextHeightByFont(AFontHandle: THandle; const x: string): Integer; -var - DC: HDC; - SaveFont: HFont; - TextSize: TSize; - -begin - DC := GetDC(0); - SaveFont := SelectObject(DC, AFontHandle); - GetTextExtentPoint32(DC, PChar(x), Length(x), TextSize); - Result := TextSize.cy; - SelectObject(DC, SaveFont); - ReleaseDC(0, DC); -end; - -function WrappedTextHeightByFont(Canvas: TCanvas; NewFont: TFont; ItemText: string; var ARect: TRect): integer; -var - MyTextMetric: TTextMetric; - MyFontName: Array [0..31] of char; - MyFontHandle, RealFontHandle: HFONT; -begin - { The next bit is a bunch of Windows code to accomodate the DrawText calls - inside the try..finally block. The issue here comes when resizing the font. - The Delphi font property is already set, but the DrawText call uses a - Windows handle and the handle's font hasn't been set to the new value.} - {This still has a vertical sizing bug when there is text that doesn't wrap but is too - wide to display in the window (think long medicine names and 24 pt font on a - 640*480 screen)} - MyFontHandle := 0; - RealFontHandle := 0; - if GetTextMetrics(Canvas.Handle, MyTextMetric) then - if GetTextFace( Canvas.Handle, 32, @MyFontName) <> 0 then with MyTextMetric do - MyFontHandle := CreateFont( NewFont.Height, - tmAveCharWidth * Abs(NewFont.Height) div tmHeight, - 0, - 0, - tmWeight, - tmItalic, - tmUnderlined, - tmStruckOut, - tmCharSet, - OUT_DEFAULT_PRECIS, - CLIP_DEFAULT_PRECIS, - DEFAULT_QUALITY, - FF_DONTCARE or DEFAULT_PITCH, - @MyFontName); - if MyFontHandle <> 0 then - RealFontHandle := SelectObject( Canvas.Handle, MyFontHandle); - try - result := DrawText(Canvas.Handle, PChar(ItemText), Length(ItemText), ARect, - DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2; - finally - if MyFontHandle <> 0 then begin - SelectObject( Canvas.Handle, RealFontHandle); - DeleteObject( MyFontHandle ); - end; - end; -end; - -function NumCharsFitInWidth(AFontHandle: THandle; const x: string; const MaxLen: integer): Integer; -var - DC: HDC; - SaveFont: HFont; - TextSize: TSize; - TmpX: string; - done: boolean; - l,h: integer; - -begin - DC := GetDC(0); - SaveFont := SelectObject(DC, AFontHandle); - try - h := length(x); - l := 0; - Result := h; - repeat - TmpX := copy(x, 1, Result); - GetTextExtentPoint32(DC, PChar(TmpX), Length(TmpX), TextSize); - if(TextSize.cx > MaxLen) then - begin - h := Result; - Result := (l+h) div 2; - done := (Result <= l); - end - else - begin - l := Result; - Result := (l+h+1) div 2; - done := (Result >= h); - end; - until(done); - finally - SelectObject(DC, SaveFont); - ReleaseDC(0, DC); - end; -end; - -function PopupComponent(Sender: TObject; PopupMenu: TPopupMenu): TComponent; -begin - if(assigned(PopupMenu) and assigned(Sender) and (Sender is TPopupMenu) and - assigned(PopupMenu.PopupComponent)) then - Result := PopupMenu.PopupComponent - else - Result := Screen.ActiveControl; -end; - -procedure ReformatMemoParagraph(AMemo: TCustomMemo); -{ rewrap lines starting with current line until there is a line that starts with whitespace } -var - ALine: Integer; - x, OldText, NewText: string; -begin - with AMemo do - begin - ALine := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0); - repeat - Inc(ALine); - until (ALine >= Lines.Count) or (Lines[ALine] = '') or (Ord(Lines[ALine][1]) <= 32); - SelLength := SendMessage(Handle, EM_LINEINDEX, ALine, 0) - SelStart - 1; - if SelLength < 1 then Exit; - OldText := SelText; - NewText := ''; - repeat - x := Copy(OldText, 1, Pos(CRLF, OldText) - 1); - if Length(x) = 0 then x := OldText; - Delete(OldText, 1, Length(x) + 2); {delete text + CRLF} - if (NewText <> '') and (Copy(NewText, Length(NewText), 1) <> ' ') and - (Copy(x, 1, 1) <> ' ') then NewText := NewText + ' '; - NewText := NewText + x; - until OldText = ''; - SelText := NewText; - end; -end; - -var - uReadOnlyColor: TColor; - uHaveReadOnlyColor: boolean = FALSE; - -function ReadOnlyColor: TColor; -begin - if not uHaveReadOnlyColor then - begin - uHaveReadOnlyColor := TRUE; - if ColorToRGB(clWindow) = ColorToRGB(clWhite) then - uReadOnlyColor := $00F0FBFF - else - uReadOnlyColor := clWindow; - end; - Result := uReadOnlyColor; -end; - -{ ListBox Grid functions } - -procedure ListGridDrawCell(AListBox: TListBox; AHeader: THeaderControl; ARow, AColumn: Integer; - const x: string; WordWrap: Boolean); -var - i, Format: Integer; - ARect: TRect; -begin - ARect := AListBox.ItemRect(ARow); - ARect.Left := 0; - for i := 0 to AColumn - 1 do ARect.Left := ARect.Left + AHeader.Sections[i].Width; - Inc(ARect.Left, 2); - ARect.Right := ARect.Left + AHeader.Sections[AColumn].Width - 6; - if WordWrap - then Format := (DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) - else Format := (DT_LEFT or DT_NOPREFIX); - DrawText(AListBox.Canvas.Handle, PChar(x), Length(x), ARect, Format); -end; - -procedure ListGridDrawLines(AListBox: TListBox; AHeader: THeaderControl; Index: Integer; - State: TOwnerDrawState); -var - i, RightSide: Integer; - ARect: TRect; -begin - with AListBox do - begin - ARect := ItemRect(Index); - if odSelected in State then - begin - Canvas.Brush.Color := clHighlight; - Canvas.Font.Color := clHighlightText - end; - Canvas.FillRect(ARect); - Canvas.Pen.Color := clSilver; - Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); - Canvas.LineTo(ARect.Right, ARect.Bottom - 1); - RightSide := -2; - for i := 0 to AHeader.Sections.Count - 1 do - begin - RightSide := RightSide + AHeader.Sections[i].Width; - Canvas.MoveTo(RightSide, ARect.Bottom - 1); - Canvas.LineTo(RightSide, ARect.Top); - end; - end; -end; - -function ListGridRowHeight(AListBox: TListBox; AHeader: THeaderControl; ARow, AColumn: Integer; - const x: string): Integer; -var - ARect: TRect; -begin - ARect := AListBox.ItemRect(ARow); - ARect.Right := AHeader.Sections[AColumn].Width - 6; - Result := DrawText(AListBox.Canvas.Handle, PChar(x), Length(x), ARect, - DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2; -end; - -(* -procedure SetEditWidth(AMemo: TMemo; AWidth: Integer); -begin - //SetString(x, nil, AWidth); - //for i := 1 to AWidth do x[i] := 'X'; -end; -*) - -{ You MUST pass an address to an object variable to get KillObj to work } -procedure KillObj(ptr: Pointer; KillObjects: boolean = FALSE); -var - Obj: TObject; - Lst: TList; - SLst: TStringList; - i: integer; - -begin - Obj := TObject(ptr^); - if(assigned(Obj)) then - begin - if(KillObjects) then - begin - if(Obj is TList) then - begin - Lst := TList(Obj); - for i := Lst.count-1 downto 0 do - if assigned(Lst[i]) then - TObject(Lst[i]).Free; - end - else - if(Obj is TStringList) then - begin - SLst := TStringList(Obj); - for i := SLst.count-1 downto 0 do - if assigned(SLst.Objects[i]) then - SLst.Objects[i].Free; - end; - end; - Obj.Free; - TObject(ptr^) := nil; - end; -end; - -{ Idle Processing } - -type - TIdleCaller = class(TObject) - private - FTimerActive: boolean; - FCallList: TStringList; - FDoneList: TStringList; - FOldIdler: TIdleEvent; - FTimer: TTimer; - protected - procedure AppIdle(Sender: TObject; var Done: Boolean); - procedure TimerDone(Sender: TObject); - public - constructor Create; - destructor Destroy; override; - procedure Add(CallProc, DoneProc: TORIdleCallProc; Msg: string); - end; - -var - IdleCaller: TIdleCaller = nil; - -{ TIdleCaller } - -constructor TIdleCaller.Create; -begin - inherited; - FCallList := TStringList.Create; - FDoneList := TStringList.Create; - FTimer := TTimer.Create(nil); - FTimer.Enabled := FALSE; - FTimer.Interval := 2000; // 2 seconds - FTimer.OnTimer := TimerDone; - FTimerActive := FALSE; - FOldIdler := Application.OnIdle; - Application.OnIdle := AppIdle; -end; - -destructor TIdleCaller.Destroy; -begin - Application.OnIdle := FOldIdler; - FTimer.Enabled := FALSE; - KillObj(@FTimer); - KillObj(@FDoneList); - KillObj(@FCallList); - inherited; -end; - -procedure TIdleCaller.AppIdle(Sender: TObject; var Done: Boolean); -begin - if(not FTimerActive) and (FCallList.Count > 0) then - begin - FTimer.Enabled := TRUE; - FTimerActive := TRUE; - end; - if assigned(FOldIdler) then - FOldIdler(Sender, Done); -end; - -procedure TIdleCaller.Add(CallProc, DoneProc: TORIdleCallProc; Msg: string); -begin - FCallList.AddObject(Msg, TObject(@CallProc)); - FDoneList.AddObject(Msg, TObject(@DoneProc)); -end; - -procedure TIdleCaller.TimerDone(Sender: TObject); -var - CallProc, DoneProc: TORIdleCallProc; - CallMsg, DoneMsg: string; - -begin - FTimer.Enabled := FALSE; - CallProc := TORIdleCallProc(FCallList.Objects[0]); - CallMsg := FCallList[0]; - DoneProc := TORIdleCallProc(FDoneList.Objects[0]); - DoneMsg := FDoneList[0]; - FCallList.Delete(0); - FDoneList.Delete(0); - - if(assigned(CallProc)) then - CallProc(CallMsg); - if(assigned(DoneProc)) then - DoneProc(DoneMsg); - - FTimerActive := FALSE; -end; - -{ do NOT use CallWhenIdle to call RPCs. Use CallRPCWhenIdle in ORNet. } -procedure CallWhenIdle(CallProc: TORIdleCallProc; Msg: String); -begin - if(not assigned(IdleCaller)) then - IdleCaller := TIdleCaller.Create; - IdleCaller.Add(CallProc, nil, Msg); -end; - -procedure CallWhenIdleNotifyWhenDone(CallProc, DoneProc: TORIdleCallProc; Msg: String); -begin - if(not assigned(IdleCaller)) then - IdleCaller := TIdleCaller.Create; - IdleCaller.Add(CallProc, DoneProc, Msg); -end; - -procedure menuHideAllBut(aMenuItem: tMenuItem; butItems: array of tMenuItem); -var - aCount, bCount: integer; - butFound: boolean; -begin -for aCount := 0 to (aMenuItem.count - 1) do // Iterate through menu items. - begin - butFound := false; - for bCount := 0 to (length(butItems) - 1) do // Check for match in exceptions array. - begin - if (aMenuItem.items[aCount] = butItems[bCount]) then - begin - butFound := true; - break; - end; - end; - if (not butFound) then - aMenuItem.items[aCount].visible := false; // Hide menu item if not an exception. - end; -end; - -function HasKey(APerson: Int64; const AKey: string): Boolean; -begin - Result := sCallV('ORWU NPHASKEY', [APerson, AKey]) = '1'; -end; - -initialization - FBaseFont := TFont.Create; - FBaseFont.Name := BaseFontName; - FBaseFont.Size := BaseFontSize; - -finalization - FBaseFont.Free; - KillObj(@IdleCaller); - -end. Index: cprs/branches/GUI-config/CPRS-Lib/ORNet.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORNet.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORNet.pas (revision 492) @@ -1,7 +1,11 @@ unit ORNet; +{$DEFINE CCOWBROKER} + interface -uses SysUtils, Windows, Classes, Forms, Controls, ORFn, TRPCB, RPCConf1, Dialogs; //, SharedRPCBroker; +uses SysUtils, Windows, Classes, Forms, Controls, ORFn, TRPCB, RPCConf1, Dialogs +{$IFDEF CCOWBROKER}, CCOWRPCBroker {$ENDIF} ; //, SharedRPCBroker; + procedure SetBrokerServer(const AName: string; APort: Integer; WantDebug: Boolean); @@ -22,4 +26,5 @@ function DottedIPStr: string; procedure CallRPCWhenIdle(CallProc: TORIdleCallProc; Msg: String); + procedure EnsureBroker; @@ -31,6 +36,10 @@ var - //RPCBrokerV: TSharedRPCBroker; // an RPC Broker object - used by all calls +{$IFDEF CCOWBROKER} + RPCBrokerV: TCCOWRPCBroker; +{$ELSE} RPCBrokerV: TRPCBroker; + //RPCBrokerV: TSharedRPCBroker; +{$ENDIF} RPCLastCall: string; @@ -58,6 +67,10 @@ if RPCBrokerV = nil then begin +{$IFDEF CCOWBROKER} + RPCBrokerV := TCCOWRPCBroker.Create(Application); +{$ELSE} + RPCBrokerV := TRPCBroker.Create(Application); //RPCBrokerV := TSharedRPCBroker.Create(Application); - RPCBrokerV := TRPCBroker.Create(Application); +{$ENDIF} with RPCBrokerV do begin @@ -104,5 +117,8 @@ vtInteger: Param[i].Value := IntToStr(VInteger); vtBoolean: Param[i].Value := BoolChar[VBoolean]; - vtChar: Param[i].Value := VChar; + vtChar: if VChar = #0 then + Param[i].Value := '' + else + Param[i].Value := VChar; //vtExtended: Param[i].Value := FloatToStr(VExtended^); vtExtended: begin @@ -174,5 +190,5 @@ RPCLastCall := RPCBrokerV.RemoteProcedure + ' (CallBroker begin)'; if uShowRPCs then StatusText(RPCBrokerV.RemoteProcedure); - with RPCBrokerV do if not Connected then // Happens if broker connection is lost. + with RPCBrokerV do if not Connected then // happens if broker connection is lost begin ClearResults := True; @@ -339,5 +355,5 @@ Screen.Cursor := crHourGlass; SetParams(RPCName, AParam); - CallBroker; //RPCBrokerV.Call; //kt note: this creates an error if connection was aborted. Fix later + CallBroker; //RPCBrokerV.Call; Screen.Cursor := SavedCursor; end; Index: cprs/branches/GUI-config/CPRS-Lib/ORNet.~pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORNet.~pas (revision 476) +++ (revision ) @@ -1,498 +1,0 @@ -unit ORNet; - -interface - -uses SysUtils, Windows, Classes, Forms, Controls, ORFn, TRPCB, RPCConf1, Dialogs; //, SharedRPCBroker; - -procedure SetBrokerServer(const AName: string; APort: Integer; WantDebug: Boolean); -function AuthorizedOption(const OptionName: string): Boolean; -function ConnectToServer(const OptionName: string): Boolean; -function MRef(glvn: string): string; -procedure CallV(const RPCName: string; const AParam: array of const); -function sCallV(const RPCName: string; const AParam: array of const): string; -procedure tCallV(ReturnData: TStrings; const RPCName: string; const AParam: array of const); -function UpdateContext(NewContext: string): boolean; -function IsBaseContext: boolean; -procedure CallBrokerInContext; -procedure CallBroker; -function RetainedRPCCount: Integer; -procedure SetRetainedRPCMax(Value: Integer); -function GetRPCMax: integer; -procedure LoadRPCData(Dest: TStrings; ID: Integer); -function DottedIPStr: string; -procedure CallRPCWhenIdle(CallProc: TORIdleCallProc; Msg: String); -procedure EnsureBroker; - -(* -function pCallV(const RPCName: string; const AParam: array of const): PChar; -procedure wCallV(AControl: TControl; const RPCName: string; const AParam: array of const); -procedure WrapWP(Buf: pChar); -*) - -var - //RPCBrokerV: TSharedRPCBroker; // an RPC Broker object - used by all calls - RPCBrokerV: TRPCBroker; - RPCLastCall: string; - -implementation - -uses Winsock; - -const - // *** these are constants from RPCBErr.pas, will broker document them???? - XWB_M_REJECT = 20000 + 2; // M error - XWB_BadSignOn = 20000 + 4; // SignOn 'Error' (happens when cancel pressed) - -var - uCallList: TList; - uMaxCalls: Integer; - uShowRPCs: Boolean; - uBaseContext: string = ''; - uCurrentContext: string = ''; - -{ private procedures and functions ---------------------------------------------------------- } - -procedure EnsureBroker; -{ ensures that a broker object has been created - creates & initializes it if necessary } -begin - if RPCBrokerV = nil then - begin - //RPCBrokerV := TSharedRPCBroker.Create(Application); - RPCBrokerV := TRPCBroker.Create(Application); - with RPCBrokerV do - begin - KernelLogIn := True; - Login.Mode := lmAppHandle; - ClearParameters := True; - ClearResults := True; - DebugMode := False; - end; - end; -end; - -procedure SetList(AStringList: TStrings; ParamIndex: Integer); -{ places TStrings into RPCBrokerV.Mult[n], where n is a 1-based (not 0-based) index } -var - i: Integer; -begin - with RPCBrokerV.Param[ParamIndex] do - begin - PType := list; - with AStringList do for i := 0 to Count - 1 do Mult[IntToStr(i+1)] := Strings[i]; - end; -end; - -procedure SetParams(const RPCName: string; const AParam: array of const); -{ takes the params (array of const) passed to xCallV and sets them into RPCBrokerV.Param[i] } -const - BoolChar: array[boolean] of char = ('0', '1'); -var - i: integer; - TmpExt: Extended; -begin - RPCLastCall := RPCName + ' (SetParam begin)'; - if Length(RPCName) = 0 then raise Exception.Create('No RPC Name'); - EnsureBroker; - with RPCBrokerV do - begin - ClearParameters := True; - RemoteProcedure := RPCName; - for i := 0 to High(AParam) do with AParam[i] do - begin - Param[i].PType := literal; - case VType of - vtInteger: Param[i].Value := IntToStr(VInteger); - vtBoolean: Param[i].Value := BoolChar[VBoolean]; - vtChar: Param[i].Value := VChar; - //vtExtended: Param[i].Value := FloatToStr(VExtended^); - vtExtended: begin - TmpExt := VExtended^; - if(abs(TmpExt) < 0.0000000000001) then TmpExt := 0; - Param[i].Value := FloatToStr(TmpExt); - end; - vtString: with Param[i] do - begin - Value := VString^; - if (Length(Value) > 0) and (Value[1] = #1) then - begin - Value := Copy(Value, 2, Length(Value)); - PType := reference; - end; - end; - vtPChar: Param[i].Value := StrPas(VPChar); - vtPointer: if VPointer = nil - then ClearParameters := True {Param[i].PType := null} - else raise Exception.Create('Pointer type must be nil.'); - vtObject: if VObject is TStrings then SetList(TStrings(VObject), i); - vtAnsiString: with Param[i] do - begin - Value := string(VAnsiString); - if (Length(Value) > 0) and (Value[1] = #1) then - begin - Value := Copy(Value, 2, Length(Value)); - PType := reference; - end; - end; - vtInt64: Param[i].Value := IntToStr(VInt64^); - else raise Exception.Create('Unable to pass parameter type to Broker.'); - end; {case} - end; {for} - end; {with} - RPCLastCall := RPCName + ' (SetParam end)'; -end; - -{ public procedures and functions ----------------------------------------------------------- } - -function UpdateContext(NewContext: string): boolean; -begin - if NewContext = uCurrentContext then - Result := TRUE - else - begin - Result := RPCBrokerV.CreateContext(NewContext); - if Result then - uCurrentContext := NewContext - else - if (NewContext <> uBaseContext) and RPCBrokerV.CreateContext(uBaseContext) then - uCurrentContext := uBaseContext - else - uCurrentContext := ''; - end; -end; - -function IsBaseContext: boolean; -begin - Result := ((uCurrentContext = uBaseContext) or (uCurrentContext = '')); -end; - -procedure CallBrokerInContext; -var - AStringList: TStringList; - i, j: Integer; - x, y: string; -begin - RPCLastCall := RPCBrokerV.RemoteProcedure + ' (CallBroker begin)'; - if uShowRPCs then StatusText(RPCBrokerV.RemoteProcedure); - with RPCBrokerV do if not Connected then // Happens if broker connection is lost. - begin - ClearResults := True; - Exit; - end; - if uCallList.Count = uMaxCalls then - begin - AStringList := uCallList.Items[0]; - AStringList.Free; - uCallList.Delete(0); - end; - AStringList := TStringList.Create; - AStringList.Add(RPCBrokerV.RemoteProcedure); - if uCurrentContext <> uBaseContext then - AStringList.Add('Context: ' + uCurrentContext); - AStringList.Add(' '); - AStringList.Add('Params ------------------------------------------------------------------'); - with RPCBrokerV do for i := 0 to Param.Count - 1 do - begin - case Param[i].PType of - //global: x := 'global'; - list: x := 'list'; - literal: x := 'literal'; - //null: x := 'null'; - reference: x := 'reference'; - undefined: x := 'undefined'; - //wordproc: x := 'wordproc'; - end; - AStringList.Add(x + #9 + Param[i].Value); - if Param[i].PType = list then - begin - for j := 0 to Param[i].Mult.Count - 1 do - begin - x := Param[i].Mult.Subscript(j); - y := Param[i].Mult[x]; - AStringList.Add(#9 + '(' + x + ')=' + y); - end; - end; - end; {with...for} - //RPCBrokerV.Call; - try - RPCBrokerV.Call; - except - // The broker erroneously sets connected to false if there is any error (including an - // error on the M side). It should only set connection to false if there is no connection. - on E:EBrokerError do - begin - if E.Code = XWB_M_REJECT then - begin - x := 'An error occurred on the server.' + CRLF + CRLF + E.Action; - Application.MessageBox(PChar(x), 'Server Error', MB_OK); - end - else raise; - (* - case E.Code of - XWB_M_REJECT: begin - x := 'An error occurred on the server.' + CRLF + CRLF + E.Action; - Application.MessageBox(PChar(x), 'Server Error', MB_OK); - end; - else begin - x := 'An error occurred with the network connection.' + CRLF + - 'Action was: ' + E.Action + CRLF + 'Code was: ' + E.Mnemonic + - CRLF + CRLF + 'Application cannot continue.'; - Application.MessageBox(PChar(x), 'Network Error', MB_OK); - end; - end; - *) - // make optional later... - if not RPCBrokerV.Connected then Application.Terminate; - end; - end; - AStringList.Add(' '); - AStringList.Add('Results -----------------------------------------------------------------'); - AStringList.AddStrings(RPCBrokerV.Results); - uCallList.Add(AStringList); - if uShowRPCs then StatusText(''); - RPCLastCall := RPCBrokerV.RemoteProcedure + ' (completed)'; -end; - -procedure CallBroker; -begin - UpdateContext(uBaseContext); - CallBrokerInContext; -end; - -procedure SetBrokerServer(const AName: string; APort: Integer; WantDebug: Boolean); -{ makes the initial connection to a server } -begin - EnsureBroker; - with RPCBrokerV do - begin - Server := AName; - if APort > 0 then ListenerPort := APort; - DebugMode := WantDebug; - Connected := True; - end; -end; - -function AuthorizedOption(const OptionName: string): Boolean; -{ checks to see if the user is authorized to use this application } -begin - EnsureBroker; - Result := RPCBrokerV.CreateContext(OptionName); - if Result then - begin - if (uBaseContext = '') then - uBaseContext := OptionName; - uCurrentContext := OptionName; - end; -end; - -function ConnectToServer(const OptionName: string): Boolean; -{ establish initial connection to server using optional command line parameters and check that - this application (option) is allowed for this user } -var - WantDebug: Boolean; - AServer, APort, x: string; - i, ModalResult: Integer; -begin - Result := False; - WantDebug := False; - AServer := ''; - APort := ''; - for i := 1 to ParamCount do // params may be: S[ERVER]=hostname P[ORT]=port DEBUG - begin - if UpperCase(ParamStr(i)) = 'DEBUG' then WantDebug := True; - if UpperCase(ParamStr(i)) = 'SHOWRPCS' then uShowRPCs := True; - x := UpperCase(Piece(ParamStr(i), '=', 1)); - if (x = 'S') or (x = 'SERVER') then AServer := Piece(ParamStr(i), '=', 2); - if (x = 'P') or (x = 'PORT') then APort := Piece(ParamStr(i), '=', 2); - end; - if (AServer = '') or (APort = '') then - begin - ModalResult := GetServerInfo(AServer, APort); - if ModalResult = mrCancel then Exit; - end; - // use try..except to work around errors in the Broker SignOn screen - try - SetBrokerServer(AServer, StrToIntDef(APort, 9200), WantDebug); - Result := AuthorizedOption(OptionName); - if Result then Result := RPCBrokerV.Connected; - RPCBrokerV.RPCTimeLimit := 300; - except - on E:EBrokerError do - begin - if E.Code <> XWB_BadSignOn then InfoBox(E.Message, 'Error', MB_OK or MB_ICONERROR); - Result := False; - end; - end; -end; - -function MRef(glvn: string): string; -{ prepends ASCII 1 to string, allows SetParams to interpret as an M reference } -begin - Result := #1 + glvn; -end; - -procedure CallV(const RPCName: string; const AParam: array of const); -{ calls the broker leaving results in results property which must be read by caller } -var - SavedCursor: TCursor; -begin - SavedCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - SetParams(RPCName, AParam); - CallBroker; //RPCBrokerV.Call; - Screen.Cursor := SavedCursor; -end; - -function sCallV(const RPCName: string; const AParam: array of const): string; -{ calls the broker and returns a scalar value. } -var - SavedCursor: TCursor; -begin - SavedCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - SetParams(RPCName, AParam); - CallBroker; //RPCBrokerV.Call; - if RPCBrokerV.Results.Count > 0 then Result := RPCBrokerV.Results[0] else Result := ''; - Screen.Cursor := SavedCursor; -end; - -procedure tCallV(ReturnData: TStrings; const RPCName: string; const AParam: array of const); -{ calls the broker and returns TStrings data } -var - SavedCursor: TCursor; -begin - if ReturnData = nil then raise Exception.Create('TString not created'); - SavedCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - SetParams(RPCName, AParam); - CallBroker; //RPCBrokerV.Call; - ReturnData.Assign(RPCBrokerV.Results); - Screen.Cursor := SavedCursor; -end; - -(* uncomment if these are needed - - -function pCallV(const RPCName: string; const AParam: array of const): PChar; -{ Calls the Broker. Result is a PChar containing raw Broker data. } -{ -- Caller must dispose the string that is returned -- } -var - SavedCursor: TCursor; -begin - SavedCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - SetParams(RPCName, AParam); - RPCBrokerV.Call; - pCallV := StrNew(RPCBrokerV.Results.GetText); - Screen.Cursor := SavedCursor; -end; - -procedure wCallV(AControl: TControl; const RPCName: string; const AParam: array of const); -{ Calls the Broker. Places data into control (wrapped). } -var - BufPtr: PChar; -begin - BufPtr := pCallV(RPCName, AParam); - WrapWP(BufPtr); - AControl.SetTextBuf(BufPtr); - StrDispose(BufPtr); -end; - -procedure WrapWP(Buf: pChar); -{ Iterates through Buf and wraps text in the same way that FM wraps text. } -var - PSub: PChar; -begin - PSub := StrScan(Buf, #13); - while PSub <> nil do - begin - if Ord(PSub[2]) > 32 then - begin - StrMove(PSub, PSub + SizeOf(Char), StrLen(PSub)); - PSub[0] := #32; - end - else repeat Inc(PSub, SizeOf(Char)) until (Ord(PSub[0]) > 32) or (PSub = StrEnd(PSub)); - PSub := StrScan(PSub, #13); - end; -end; - -*) - -function RetainedRPCCount: Integer; -begin - Result := uCallList.Count; -end; - -procedure SetRetainedRPCMax(Value: Integer); -begin - if Value > 0 then uMaxCalls := Value; -end; - -function GetRPCMax: integer; -begin - Result := uMaxCalls; -end; - -procedure LoadRPCData(Dest: TStrings; ID: Integer); -begin - if (ID > -1) and (ID < uCallList.Count) then Dest.Assign(TStringList(uCallList.Items[ID])); -end; - -function DottedIPStr: string; -{ return the IP address of the local machine as a string in dotted form: nnn.nnn.nnn.nnn } -const - WINSOCK1_1 = $0101; // minimum required version of WinSock - SUCCESS = 0; // value returned by WinSock functions if no error -var - //WSAData: TWSAData; // structure to hold startup information - HostEnt: PHostEnt; // pointer to Host Info structure (see WinSock 1.1, page 60) - IPAddr: PInAddr; // pointer to IP address in network order (4 bytes) - LocalName: array[0..255] of Char; // buffer for the name of the client machine -begin - Result := 'No IP Address'; - // ensure the Winsock DLL has been loaded (should be if there is a broker connection) - //if WSAStartup(WINSOCK1_1, WSAData) <> SUCCESS then Exit; - //try - // get the name of the client machine - if gethostname(LocalName, SizeOf(LocalName) - 1) <> SUCCESS then Exit; - // get information about the client machine (contained in a record of type THostEnt) - HostEnt := gethostbyname(LocalName); - if HostEnt = nil then Exit; - // get a pointer to the four bytes that contain the IP address - // Dereference HostEnt to get the THostEnt record. In turn, dereference the h_addr_list - // field to get a pointer to the IP address. The pointer to the IP address is type PChar, - // so it needs to be typecast as PInAddr in order to make the call to inet_ntoa. - IPAddr := PInAddr(HostEnt^.h_addr_list^); - // Dereference IPAddr (which is a PChar typecast as PInAddr) to get the 4 bytes that need - // to be passed to inet_ntoa. A string with the IP address in dotted format is returned. - Result := inet_ntoa(IPAddr^); - //finally - // causes the reference counter in Winsock (set by WSAStartup, above) to be decremented - //WSACleanup; - //end; -end; - -procedure RPCIdleCallDone(Msg: string); -begin - RPCBrokerV.ClearResults := True; -end; - -procedure CallRPCWhenIdle(CallProc: TORIdleCallProc; Msg: String); -begin - CallWhenIdleNotifyWhenDone(CallProc, RPCIdleCallDone, Msg); -end; - -initialization - RPCBrokerV := nil; - RPCLastCall := 'No RPCs called'; - uCallList := TList.Create; - uMaxCalls := 10; - uShowRPCs := False; - -finalization - while uCallList.Count > 0 do - begin - TStringList(uCallList.Items[0]).Free; - uCallList.Delete(0); - end; - uCallList.Free; - -end. Index: cprs/branches/GUI-config/CPRS-Lib/ORSystem.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/ORSystem.pas (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/ORSystem.pas (revision 492) @@ -127,6 +127,9 @@ Buf: string; FileInfoPtr: Pointer; //PVSFixedFileInfo; -begin - Result := ''; + SpoofVer : string; //kt +begin + //kt Result := ''; + Result := Trim(ParamSearch('SPOOF-VER')); //kt Returns user-specified version # + if Result <> '' then exit; //kt ASize:=GetFileVersionInfoSize(PChar(AFileName), AHandle); if ASize > 0 then Index: cprs/branches/GUI-config/CPRS-Lib/TntVA10.cfg =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVA10.cfg (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVA10.cfg (revision 492) @@ -0,0 +1,42 @@ +-$A8 +-$B- +-$C- +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q+ +-$R+ +-$S- +-$T- +-$U- +-$V+ +-$W+ +-$X+ +-$YD +-$Z1 +-GD +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-E"c:\bcb\delphi\dev\exesave" +-N"..\cprs-lib\DCU" +-LE"..\Packages" +-LN"..\Packages" +-U"..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source" +-O"..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source" +-I"..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source" +-R"..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source" Index: cprs/branches/GUI-config/CPRS-Lib/TntVA10.dof =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVA10.dof (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVA10.dof (revision 492) @@ -0,0 +1,184 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=0 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=1 +R=1 +S=0 +T=0 +U=0 +V=1 +W=1 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=1 +UnsafeCode=1 +UnsafeCast=1 +[Linker] +MapFile=3 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=Wrap Grid +[Directories] +OutputDir=$(DELPHI)\dev\exesave +UnitOutputDir=..\cprs-lib\DCU +PackageDLLOutputDir=..\Packages +PackageDCPOutputDir=..\Packages +SearchPath=..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source +Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;TeeUI40;teedb40;tee40;ibevnt40;nmfast40;VistABroker +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang=$00000409 +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=11 +Item0=..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode;C:\BCB\Projects\Personal Projects\tntUniCode\Source +Item1=..\cprs-lib;..\Packages;C:\BCB\Projects\Personal Projects\tntUniCode +Item2=..\cprs-lib;..\Packages +Item3=d:\vista\main\cprs-lib;d:\vista\main\Packages +Item4=d:\vista\main\cprs-lib;d:\program files\vista\broker\bdk32\d5 +Item5=d:\vista\main\cprs-chart;d:\vista\main\cprs-lib;d:\vista\main\cprs-chart\encounter;d:\vista\main\cprs-chart\consults +Item6=d:\vista\main\cprs-lib +Item7=\Dev\CPRS\main\CPRS-Lib +Item8=C:\Dev\CPRS\main\CPRS-Lib +Item9=\Projects\Perforce\main\CPRS-Lib +Item10=$(DELPHI)\Projects\Current\CPRS-Lib +[HistoryLists\hlUnitOutputDirectory] +Count=8 +Item0=..\cprs-lib\DCU +Item1=d:\vista\main\cprs-lib\DCU +Item2=d:\vista\main\cprs-lib\DCUSave +Item3=d:\vista\main\cprs-chart\dcu +Item4=\Dev\DCUSave +Item5=C:\Dev\DCUSave +Item6=\Projects\DCUSave +Item7=$(DELPHI)\Projects\DCUSave +[HistoryLists\hlOutputDirectorry] +Count=2 +Item0=$(DELPHI)\dev\exesave +Item1=d:\vista\main\cprs-chart +[HistoryLists\hlBPLOutput] +Count=7 +Item0=..\Packages +Item1=d:\vista\main\Packages +Item2=d:\vista\main\cprs-lib +Item3=\Dev\Packages +Item4=C:\Dev\Packages +Item5=\Projects\Packages +Item6=$(DELPHI)\Projects\Packages +[HistoryLists\hlDCPOutput] +Count=7 +Item0=..\Packages +Item1=d:\vista\main\Packages +Item2=d:\vista\main\cprs-lib +Item3=\Dev\Packages +Item4=C:\Dev\Packages +Item5=\Projects\Packages +Item6=$(DELPHI)\Projects\Packages Index: cprs/branches/GUI-config/CPRS-Lib/TntVA10.dpk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVA10.dpk (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVA10.dpk (revision 492) @@ -0,0 +1,36 @@ +package TntVA10; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS ON} +{$RANGECHECKS ON} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'Wrap Grid'} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + vcl, + TntUnicodeVcl_R70; + +contains + TntVawrgrid in 'TntVawrgrid.pas'; + +end. Index: cprs/branches/GUI-config/CPRS-Lib/TntVA10.drc =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVA10.drc (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVA10.drc (revision 492) @@ -0,0 +1,14 @@ +/* VER150 + Generated by the Borland Delphi Pascal Compiler + because -GD or --drc was supplied to the compiler. + + This file contains compiler-generated resources that + were bound to the executable. + If this file is empty, then no compiler-generated + resources were bound to the produced executable. +*/ + +STRINGTABLE +BEGIN +END + Index: cprs/branches/GUI-config/CPRS-Lib/TntVA10.dsk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVA10.dsk (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVA10.dsk (revision 492) @@ -0,0 +1,376 @@ +[Closed Files] +File_0=SourceModule,'C:\BCB\Projects\Personal Projects\DKLanguage\DKLang.pas',0,1,2254,1,2270,0,0 +File_1=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntForms.pas',0,1,349,1,362,0,0 +File_2=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntStdCtrls.pas',0,1,1932,1,1949,0,0 +File_3=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntControls.pas',0,1,255,1,268,0,0 +File_4=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntMenus.pas',0,1,1126,1,1143,0,0 +File_5=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntStdActns.pas',0,1,1909,1,1922,0,0 +File_6=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntDialogs.pas',0,1,968,1,981,0,0 +File_7=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntClipBrd.pas',0,1,68,1,83,0,0 +File_8=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntExtCtrls.pas',0,1,1049,1,1062,0,0 +File_9=SourceModule,'C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntActnList.pas',0,1,822,1,835,0,0 + +[Modules] +Module0=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\TntVawrgrid.pas +Module1=C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntGrids.pas +Module2=C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\Main.pas +Count=3 +EditWindowCount=1 +PackageWindowCount=1 + +[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\TntVawrgrid.pas] +ModuleType=SourceModule +FormState=0 +FormOnTop=0 + +[C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntGrids.pas] +ModuleType=SourceModule +FormState=0 +FormOnTop=0 + +[C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\Main.pas] +ModuleType=SourceModule +FormState=0 +FormOnTop=1 + +[C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\TntVA10.dpk] +FormState=0 +FormOnTop=1 + +[C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\DKLang_Simple_Demo.dpr] +FormState=0 +FormOnTop=0 + +[C:\BCB\Delphi\Projects\ProjectGroup1.bpg] +FormState=0 +FormOnTop=0 + +[EditWindow0] +ViewCount=3 +CurrentView=1 +View0=0 +View1=1 +View2=2 +CodeExplorer=CodeExplorer@EditWindow0 +MessageView=MessageView@EditWindow0 +Create=1 +Visible=1 +State=0 +Left=198 +Top=207 +Width=791 +Height=548 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=783 +ClientHeight=514 +LeftPanelSize=117 +LeftPanelClients=CodeExplorer@EditWindow0 +LeftPanelData=000004000000000000000000000000000000000000000000000100000000000000000C000000436F64654578706C6F726572FFFFFFFF +RightPanelSize=0 +BottomPanelSize=85 +BottomPanelClients=MessageView@EditWindow0 +BottomPanelData=00000400000000000F030000000000000255000000000000000100000000000000000000000001000000000F0300000B0000004D65737361676556696577FFFFFFFF + +[View0] +Module=C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\Main.pas +CursorX=32 +CursorY=13 +TopLine=7 +LeftCol=1 + +[View1] +Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\TntVawrgrid.pas +CursorX=49 +CursorY=164 +TopLine=139 +LeftCol=1 + +[View2] +Module=C:\BCB\Projects\Personal Projects\tntUniCode\Source\TntGrids.pas +CursorX=17 +CursorY=149 +TopLine=139 +LeftCol=1 + +[PackageWindow0] +Create=1 +Visible=1 +State=0 +Left=201 +Top=132 +Width=368 +Height=244 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=360 +ClientHeight=218 +TBDockHeight=244 +LRDockWidth=368 +Dockable=1 +StatusBar=0 +TextLabels=1 +Toolbar=1 +SectionWidth0=150 +SectionWidth1=210 +Module=C:\BCB\Projects\Personal Projects\Vista\CPRS-1.0.23.15\CPRS-Lib\TntVA10.dpk + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=100 +WatchShowColumnHeaders=1 +Create=1 +Visible=0 +State=0 +Left=56 +Top=390 +Width=931 +Height=213 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=923 +ClientHeight=187 +TBDockHeight=173 +LRDockWidth=421 +Dockable=1 + +[Breakpoints] +Count=2 +Breakpoint0='C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\DKLang_Simple_Demo.dpr',18,'',0,1,'',1,0,0,'',1,'','','' +Breakpoint1='C:\BCB\Projects\Personal Projects\DKLanguage\Examples\Simple\Main.pas',35,'',0,1,'',1,0,0,'',1,'','','' + +[AddressBreakpoints] +Count=0 + +[Main Window] +Create=1 +Visible=1 +State=0 +Left=0 +Top=0 +Width=1024 +Height=112 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1016 +ClientHeight=78 + +[ProjectManager] +Create=1 +Visible=0 +State=0 +Left=369 +Top=372 +Width=438 +Height=305 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=430 +ClientHeight=279 +TBDockHeight=305 +LRDockWidth=438 +Dockable=1 + +[Components] +Left=308 +Top=167 +Width=183 +Height=266 +Create=1 +Visible=0 +State=0 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=175 +ClientHeight=240 +TBDockHeight=235 +LRDockWidth=183 +Dockable=1 + +[CPUWindow] +Create=1 +Visible=0 +State=0 +Left=133 +Top=123 +Width=533 +Height=353 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=525 +ClientHeight=319 +DumpPane=79 +DisassemblyPane=187 +RegisterPane=231 +FlagPane=64 + +[AlignmentPalette] +Create=1 +Visible=0 +State=0 +Left=200 +Top=114 +Width=156 +Height=84 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=150 +ClientHeight=60 + +[PropertyInspector] +Create=1 +Visible=1 +State=0 +Left=0 +Top=374 +Width=190 +Height=383 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=182 +ClientHeight=357 +TBDockHeight=383 +LRDockWidth=190 +Dockable=1 +SplitPos=85 +ArrangeBy=Name +SelectedItem= +ExpandedItems= +HiddenCategories= + +[BreakpointWindow] +Create=1 +Visible=0 +State=0 +Left=31 +Top=201 +Width=737 +Height=350 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=729 +ClientHeight=324 +TBDockHeight=197 +LRDockWidth=737 +Dockable=1 +Column0Width=100 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=75 +Column5Width=75 + +[CallStackWindow] +Create=1 +Visible=1 +State=0 +Left=365 +Top=303 +Width=294 +Height=161 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=286 +ClientHeight=135 +TBDockHeight=161 +LRDockWidth=294 +Dockable=1 + +[ObjectTree] +Create=1 +Visible=1 +State=0 +Left=0 +Top=112 +Width=190 +Height=260 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=182 +ClientHeight=234 +TBDockHeight=260 +LRDockWidth=190 +Dockable=1 + +[ToDo List] +Create=1 +Visible=0 +State=0 +Left=268 +Top=585 +Width=787 +Height=145 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=779 +ClientHeight=119 +TBDockHeight=250 +LRDockWidth=470 +Dockable=1 +Column0Width=355 +Column1Width=30 +Column2Width=100 +Column3Width=70 +Column4Width=70 +SortOrder=0 +ShowHints=1 +ShowChecked=0 + +[ModuleWindow] +Create=1 +Visible=0 +State=0 +Left=63 +Top=224 +Width=638 +Height=355 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=630 +ClientHeight=329 +TBDockHeight=355 +LRDockWidth=638 +Dockable=1 +Column0Width=125 +Column1Width=100 +Column2Width=155 +EntryPointPane=225 +CompUnitPane=104 + +[CodeExplorer@EditWindow0] +Create=1 +Visible=1 +State=0 +Left=0 +Top=12 +Width=117 +Height=414 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=117 +ClientHeight=414 +TBDockHeight=305 +LRDockWidth=117 +Dockable=1 + +[MessageView@EditWindow0] +Create=1 +Visible=1 +State=0 +Left=12 +Top=0 +Width=771 +Height=85 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=771 +ClientHeight=85 +TBDockHeight=85 +LRDockWidth=443 +Dockable=1 + +[DockHosts] +DockHostCount=0 + Index: cprs/branches/GUI-config/CPRS-Lib/TntVawrgrid.pas =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/TntVawrgrid.pas (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/TntVawrgrid.pas (revision 492) @@ -0,0 +1,168 @@ +unit TntVawrgrid; + + + +interface + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, + Forms, Dialogs, Grids, TntStdCtrls, TntGrids; + +type + TTntVAWrapGrid = class(TTntStringGrid) + private + { Private declarations } + fHiddenCols: string; + fHiddenColMap: string[255]; + procedure SetHiddenCols(Value:string); + protected + { Protected declarations } + { This DrawCell procedure wraps text in the grid cell } + procedure DrawCell(Col, Row : Longint; Rect : TRect; State : TGridDrawState); override ; + public + constructor Create(AOwner : TComponent); override ; + published + { Published declarations } + property HiddenCols: string read fHiddenCols write SetHiddenCols; + end; + +procedure Register; + +implementation + +constructor TTntVAWrapGrid.Create(AOwner : TComponent); +begin + { Create a TStringGrid } + inherited Create(AOwner); + HiddenCols:=''; + {change to bit map someday} + fHiddenColMap:=''; +end; + + +procedure TTntVAWrapGrid.SetHiddenCols(value:string); +var + v,old:string; + j:integer; + procedure SetCol(val:string); + var + i:integer; + begin + i:=strtoint(val) + 1; {offset for 1 based string index} + if (i in [1..255]) then fHiddenColMap[i]:='1'; + end; +begin + old:=fHiddenColMap; {save oldmap image} + fHiddenCols:=Value; + fHiddenColMap:=''; {reset the map} + for j:=1 to 255 do + fHiddenColMap:=fHiddenColMap + '0'; + while pos(',',value)>0 do + begin + v:=copy(value,1,pos(',',value)-1); + SetCol(v); + Delete(value,1,pos(',',value)); + end; + if value <> '' then + begin + SetCol(value); {get the last piece} + if not (csDesigning in componentstate) then + invalidate; + end; + if old='' then exit; + if (old <> fHiddenColMap) and (not (csDesigning in componentState)) then + begin + j:=pos('1',old); + while j > 0 do + begin + if fHiddenColMap[j]='0' then + if pred(j) < colcount then colwidths[pred(j)]:=defaultcolwidth; + old[j]:='0'; {get rid of hit} + j:=pos('1',old); + end; + end; +end; + + +{ This DrawCell procedure wraps text in the grid cell } +procedure TTntVAWrapGrid.DrawCell(Col,Row: Longint; Rect: TRect; State: TGridDrawState); +var + i, MaxRowHeight, CurrRowHeight, hgt, CellLen :integer; + CellValue :PChar; +begin + {don't display hidden cols} + if RowHeights[Row] = 0 then exit; + if (fHiddenColMap[succ(col)] = '1') and (not (csDesigning in componentstate)) then + {disappear the column} + begin + if colwidths[col] > 0 then colwidths[col] := 0; + exit; + end; + with Canvas do {not a hidden col} + begin + if colwidths[col]=0 then ColWidths[col] := defaultcolwidth; + { Initialize the font to be the control's font } + Canvas.Font := Font; + Canvas.Font.Color := Font.Color; + {If this is a fixed cell, then use the fixed color } + if gdFixed in State then + begin + Pen.Color := FixedColor; + Brush.Color := FixedColor; + font.color := self.font.color; + end + {if highlighted cell} + else if (gdSelected in State) and + (not (gdFocused in State) or + ([goDrawFocusSelected, goRowSelect] * Options <> [])) then + begin + Brush.Color := clHighlight; + Font.Color := clHighlightText; + end + {else, use the normal color } + else + begin + Pen.Color := Color; + Brush.Color := Color; + font.color := self.font.color; + end; + {Prepaint cell in cell color } + FillRect(rect); + end; + + CellValue := PChar(cells[col,row]); + CellLen := strlen(CellValue); + + {get cell size} + Drawtext(canvas.handle,CellValue,CellLen,rect,DT_LEFT or DT_WORdbreak or DT_CALCRECT or DT_NOPREFIX); + + {Draw text in cell} + Drawtext(canvas.handle,CellValue,CellLen,rect,DT_LEFT or DT_WORdbreak or DT_NOPREFIX); + + {adjust row heights up OR DOWN} + MaxRowHeight := DefaultRowHeight; + CurrRowHeight := RowHeights[row]; + for i := pred(colcount) downto 0 do + begin + if (not (gdFixed in state)) then + begin + rect := cellrect(i,row); + hgt := Drawtext(canvas.handle,PChar(cells[i,row]),length(cells[i,row]),rect,DT_LEFT or + DT_WORdbreak or DT_CALCRECT or DT_NOPREFIX); + if hgt > MaxRowHeight then MaxRowHeight := hgt; + end; + end; + + if MaxRowHeight <> CurrRowHeight then rowheights[row] := MaxRowHeight; + +end; + +procedure Register; +begin + { You can change Samples to whichever part of the Component Palette you want + to install this component to } + RegisterComponents('TntCPRS', [TTntVAWrapGrid]); +end; + +end. + Index: cprs/branches/GUI-config/CPRS-Lib/VA10.cfg =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/VA10.cfg (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/VA10.cfg (revision 492) @@ -33,5 +33,5 @@ -$M16384,1048576 -K$00400000 --E"c:\program files\borland\delphi7\dev\exesave" +-E"c:\program files\borland\delphi6\dev\exesave" -N"..\cprs-lib\DCU" -LE"..\Packages" Index: cprs/branches/GUI-config/CPRS-Lib/VA10.dof =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/VA10.dof (revision 476) +++ cprs/branches/GUI-config/CPRS-Lib/VA10.dof (revision 492) @@ -1,4 +1,4 @@ [FileVersion] -Version=7.0 +Version=6.0 [Compiler] A=8 @@ -31,53 +31,4 @@ ShowWarnings=1 UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=1 -UnsafeCode=1 -UnsafeCast=1 [Linker] MapFile=3 Index: cprs/branches/GUI-config/CPRS-Lib/VA10.dsk =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/VA10.dsk (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/VA10.dsk (revision 492) @@ -0,0 +1,357 @@ +[Closed Files] +File_0=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\XMLUtils.pas',0,1,1,1,1,0,0 +File_1=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORSystem.pas',0,1,1,1,1,0,0 +File_2=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORNet.pas',0,1,1,1,1,0,0 +File_3=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORFn.pas',0,1,1,1,1,0,0 +File_4=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTmRng.pas',0,1,1,1,1,0,0 +File_5=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTmCal.pas',0,1,1,1,1,0,0 +File_6=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORDtTm.pas',0,1,1,1,1,0,0 +File_7=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrlsDsgn.pas',0,1,1,1,1,0,0 +File_8=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORCtrls.pas',0,1,1,1,1,0,0 +File_9=SourceModule,'P:\Vista\CPRS-1.0.26.69\CPRS-Lib\ORClasses.pas',0,1,1,1,1,0,0 + +[Modules] +Count=0 +EditWindowCount=0 +PackageWindowCount=1 + +[P:\Vista\CPRS-1.0.26.69\CPRS-Lib\VA10.dpk] +FormState=0 +FormOnTop=1 + +[C:\Program Files\Borland\Delphi7\Projects\ProjectGroup1.bpg] +FormState=0 +FormOnTop=0 + +[PackageWindow0] +Create=1 +Visible=0 +State=0 +Left=224 +Top=256 +Width=368 +Height=244 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=360 +ClientHeight=218 +TBDockHeight=244 +LRDockWidth=368 +Dockable=1 +StatusBar=0 +TextLabels=1 +Toolbar=1 +SectionWidth0=150 +SectionWidth1=210 +Module=P:\Vista\CPRS-1.0.26.69\CPRS-Lib\VA10.dpk + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=100 +WatchShowColumnHeaders=1 +Create=1 +Visible=0 +State=0 +Left=185 +Top=498 +Width=809 +Height=202 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=801 +ClientHeight=176 +TBDockHeight=176 +LRDockWidth=426 +Dockable=1 + +[Breakpoints] +Count=0 + +[AddressBreakpoints] +Count=0 + +[Main Window] +Create=1 +Visible=1 +State=2 +Left=0 +Top=0 +Width=1024 +Height=112 +MaxLeft=-4 +MaxTop=-4 +MaxWidth=1032 +MaxHeight=112 +ClientWidth=1024 +ClientHeight=78 + +[ProjectManager] +Create=1 +Visible=0 +State=0 +Left=213 +Top=185 +Width=587 +Height=462 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=579 +ClientHeight=436 +TBDockHeight=489 +LRDockWidth=719 +Dockable=1 + +[Components] +Left=240 +Top=237 +Width=183 +Height=235 +Create=1 +Visible=0 +State=0 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=175 +ClientHeight=209 +TBDockHeight=235 +LRDockWidth=183 +Dockable=1 + +[CPUWindow] +Create=1 +Visible=0 +State=0 +Left=0 +Top=1 +Width=800 +Height=565 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=792 +ClientHeight=531 +DumpPane=79 +DisassemblyPane=264 +RegisterPane=231 +FlagPane=104 + +[AlignmentPalette] +Create=1 +Visible=0 +State=0 +Left=200 +Top=114 +Width=156 +Height=84 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=150 +ClientHeight=60 + +[PropertyInspector] +Create=1 +Visible=1 +State=0 +Left=10 +Top=107 +Width=188 +Height=493 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=180 +ClientHeight=467 +TBDockHeight=367 +LRDockWidth=190 +Dockable=1 +SplitPos=84 +ArrangeBy=Name +SelectedItem= +ExpandedItems= +HiddenCategories= + +[BreakpointWindow] +Create=1 +Visible=0 +State=0 +Left=143 +Top=285 +Width=737 +Height=197 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=729 +ClientHeight=171 +TBDockHeight=197 +LRDockWidth=737 +Dockable=1 +Column0Width=100 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=75 +Column5Width=75 + +[CallStackWindow] +Create=1 +Visible=0 +State=0 +Left=46 +Top=403 +Width=469 +Height=294 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=461 +ClientHeight=268 +TBDockHeight=294 +LRDockWidth=469 +Dockable=1 + +[ThreadStatusWindow] +Create=1 +Visible=0 +State=0 +Left=0 +Top=0 +Width=800 +Height=600 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=792 +ClientHeight=574 +TBDockHeight=152 +LRDockWidth=624 +Dockable=1 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=250 + +[ObjectTree] +Create=1 +Visible=0 +State=0 +Left=0 +Top=114 +Width=250 +Height=274 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=242 +ClientHeight=248 +TBDockHeight=248 +LRDockWidth=190 +Dockable=1 + +[DebugLogView] +Create=1 +Visible=0 +State=0 +Left=431 +Top=254 +Width=417 +Height=291 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=409 +ClientHeight=265 +TBDockHeight=291 +LRDockWidth=417 +Dockable=1 + +[LocalVarsWindow] +Create=1 +Visible=0 +State=0 +Left=441 +Top=447 +Width=421 +Height=192 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=413 +ClientHeight=166 +TBDockHeight=192 +LRDockWidth=421 +Dockable=1 + +[ToDo List] +Create=1 +Visible=0 +State=0 +Left=268 +Top=585 +Width=787 +Height=145 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=779 +ClientHeight=119 +TBDockHeight=250 +LRDockWidth=470 +Dockable=1 +Column0Width=355 +Column1Width=30 +Column2Width=100 +Column3Width=70 +Column4Width=70 +SortOrder=0 +ShowHints=1 +ShowChecked=0 + +[FPUWindow] +Create=1 +Visible=0 +State=0 +Left=306 +Top=280 +Width=457 +Height=250 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=449 +ClientHeight=216 +RegisterPane=121 +FlagPane=59 + +[ModuleWindow] +Create=1 +Visible=0 +State=0 +Left=63 +Top=224 +Width=638 +Height=355 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=630 +ClientHeight=329 +TBDockHeight=355 +LRDockWidth=638 +Dockable=1 +Column0Width=125 +Column1Width=100 +Column2Width=155 +EntryPointPane=225 +CompUnitPane=104 + +[MessageHintFrm] +Create=1 +Visible=0 +State=0 +Left=481 +Top=423 +Width=383 +Height=195 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=375 +ClientHeight=169 +TBDockHeight=195 +LRDockWidth=383 +Dockable=1 + +[DockHosts] +DockHostCount=0 + Index: cprs/branches/GUI-config/CPRS-Lib/fGMV_InputTemp.dfm =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/fGMV_InputTemp.dfm (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/fGMV_InputTemp.dfm (revision 492) @@ -0,0 +1,328 @@ +object frmGMV_InputTemp: TfrmGMV_InputTemp + Left = 322 + Top = 254 + BorderStyle = bsNone + Caption = 'frmGMV_InputTemp' + ClientHeight = 447 + ClientWidth = 728 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnResize = FormResize + PixelsPerInch = 96 + TextHeight = 13 + object pnlInputTemplate: TPanel + Left = 0 + Top = 41 + Width = 728 + Height = 406 + Align = alClient + BevelOuter = bvNone + Caption = 'pnlInputTemplate' + TabOrder = 0 + object Bevel1: TBevel + Left = 0 + Top = 50 + Width = 728 + Height = 2 + Align = alTop + Shape = bsBottomLine + end + object pnlInputTemplateHeader: TPanel + Left = 0 + Top = 0 + Width = 728 + Height = 24 + Align = alTop + Alignment = taLeftJustify + Caption = ' Input Template' + TabOrder = 1 + end + object hc: THeaderControl + Left = 0 + Top = 52 + Width = 728 + Height = 17 + DragReorder = False + Enabled = False + Sections = < + item + Alignment = taCenter + ImageIndex = -1 + Text = '#' + Width = 29 + end + item + ImageIndex = -1 + Text = 'Unavailable' + Width = 0 + end + item + ImageIndex = -1 + Text = 'U... R...' + Width = 60 + end + item + ImageIndex = -1 + Text = 'Vital' + Width = 111 + end + item + ImageIndex = -1 + Text = 'Value' + Width = 90 + end + item + ImageIndex = -1 + Text = 'Units' + Width = 75 + end + item + ImageIndex = -1 + Text = 'Qualifiers' + Width = 50 + end> + Style = hsFlat + end + object pnlScrollBox: TPanel + Left = 0 + Top = 69 + Width = 728 + Height = 337 + Align = alClient + BevelOuter = bvNone + BorderWidth = 4 + TabOrder = 3 + object sbxMain: TScrollBox + Left = 4 + Top = 4 + Width = 707 + Height = 261 + BorderStyle = bsNone + TabOrder = 0 + end + end + object pnlOptions: TPanel + Left = 0 + Top = 24 + Width = 728 + Height = 26 + Align = alTop + BevelOuter = bvNone + Color = 12698049 + TabOrder = 0 + object bvU: TBevel + Left = 8 + Top = 3 + Width = 20 + Height = 21 + Shape = bsFrame + Visible = False + end + object bvUnavailable: TBevel + Left = 135 + Top = 3 + Width = 21 + Height = 21 + Shape = bsFrame + Visible = False + end + object lblUnavailable: TLabel + Left = 160 + Top = 6 + Width = 56 + Height = 13 + Caption = 'Un&available' + FocusControl = ckbUnavailable + Visible = False + WordWrap = True + end + object Label3: TLabel + Left = 34 + Top = 6 + Width = 73 + Height = 13 + Caption = '&Patient on pass' + FocusControl = ckbOnPass + end + object ckbOnPass: TCheckBox + Left = 12 + Top = 5 + Width = 12 + Height = 17 + Hint = 'Mark all vitals in the template as "Patient On Pass"' + Alignment = taLeftJustify + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = ckbOnPassClick + OnEnter = ckbOnPassEnter + OnExit = ckbOnPassExit + end + object pnlCPRSMetricStyle: TPanel + Left = 584 + Top = 0 + Width = 144 + Height = 26 + Align = alRight + BevelOuter = bvNone + ParentColor = True + TabOrder = 2 + object chkCPRSSTyle: TCheckBox + Left = 1 + Top = 5 + Width = 136 + Height = 17 + Hint = 'Switch between dropdown and check box presentation of metric' + TabStop = False + Alignment = taLeftJustify + Caption = '&Units as Drop Down List' + TabOrder = 0 + OnClick = acMetricStyleChangedExecute + end + end + object ckbUnavailable: TCheckBox + Left = 140 + Top = 5 + Width = 11 + Height = 17 + Hint = 'Mark all vitals in the template as "Patient Unavailable" ' + Alignment = taLeftJustify + Caption = 'Patient on Pass' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + Visible = False + end + end + end + object pnlTools: TPanel + Left = 0 + Top = 0 + Width = 728 + Height = 41 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + Visible = False + object pnlPatient: TPanel + Left = 0 + Top = 0 + Width = 208 + Height = 41 + Align = alLeft + Color = clInfoBk + Constraints.MinWidth = 165 + TabOrder = 0 + object lblPatientName: TLabel + Left = 7 + Top = 5 + Width = 73 + Height = 13 + Caption = 'PatientName' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object lblPatientInfo: TLabel + Left = 7 + Top = 21 + Width = 85 + Height = 13 + Caption = 'PatientInformation' + end + end + object pnlSettings: TPanel + Left = 208 + Top = 0 + Width = 520 + Height = 41 + Align = alClient + TabOrder = 1 + object lblHospital: TLabel + Left = 115 + Top = 5 + Width = 3 + Height = 13 + end + object lblDateTime: TLabel + Left = 115 + Top = 21 + Width = 3 + Height = 13 + end + object lblHospitalCap: TLabel + Left = 7 + Top = 5 + Width = 100 + Height = 13 + Caption = 'Hospital Location' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Label2: TLabel + Left = 7 + Top = 21 + Width = 61 + Height = 13 + Caption = 'Date/Time' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Panel1: TPanel + Left = 445 + Top = 1 + Width = 74 + Height = 39 + Align = alRight + BevelOuter = bvNone + TabOrder = 0 + object SpeedButton1: TSpeedButton + Left = 8 + Top = 8 + Width = 57 + Height = 25 + Flat = True + OnClick = SpeedButton1Click + end + end + end + end + object ActionList1: TActionList + Left = 336 + Top = 8 + object acMetricStyleChanged: TAction + Caption = 'acMetricStyleChanged' + OnExecute = acMetricStyleChangedExecute + end + object acSaveInput: TAction + Caption = 'acSaveInput' + OnExecute = acSaveInputExecute + end + object acSetOnPass: TAction + Caption = 'acSetOnPass' + OnExecute = acSetOnPassExecute + end + object acUnavailableBoxStatus: TAction + Caption = 'acUnavailableBoxStatus' + end + end +end Index: cprs/branches/GUI-config/CPRS-Lib/fGMV_Qualifiers.dfm =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/fGMV_Qualifiers.dfm (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/fGMV_Qualifiers.dfm (revision 492) @@ -0,0 +1,74 @@ +object frmGMV_Qualifiers: TfrmGMV_Qualifiers + Left = 460 + Top = 247 + BorderIcons = [] + BorderStyle = bsNone + ClientHeight = 246 + ClientWidth = 247 + Color = clBtnFace + Constraints.MinWidth = 127 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -14 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnActivate = FormActivate + OnClose = FormClose + OnCreate = FormCreate + PixelsPerInch = 120 + TextHeight = 16 + object pnlMain: TPanel + Left = 0 + Top = 0 + Width = 247 + Height = 246 + Align = alClient + BevelInner = bvLowered + BorderWidth = 1 + TabOrder = 0 + object pnlBottom: TPanel + Left = 3 + Top = 178 + Width = 241 + Height = 65 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + OnResize = pnlBottomResize + DesignSize = ( + 241 + 65) + object btnOK: TButton + Left = 85 + Top = 34 + Width = 74 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object btnCancel: TButton + Left = 161 + Top = 34 + Width = 74 + Height = 25 + Anchors = [akTop, akRight] + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 1 + end + object edtQuals: TEdit + Left = 9 + Top = 0 + Width = 224 + Height = 24 + TabOrder = 2 + Text = 'edtQuals' + end + end + end +end Index: cprs/branches/GUI-config/CPRS-Lib/fGMV_SupO2.dfm =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/fGMV_SupO2.dfm (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/fGMV_SupO2.dfm (revision 492) @@ -0,0 +1,202 @@ +object frmGMV_SupO2: TfrmGMV_SupO2 + Left = 815 + Top = 181 + BorderIcons = [biSystemMenu] + BorderStyle = bsNone + Caption = 'frmGMV_SupO2' + ClientHeight = 193 + ClientWidth = 313 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -14 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDefault + OnActivate = FormActivate + PixelsPerInch = 120 + TextHeight = 16 + object pnlMain: TPanel + Left = 0 + Top = 0 + Width = 313 + Height = 193 + Align = alClient + BevelInner = bvLowered + BorderWidth = 1 + TabOrder = 0 + object pnlBottom: TPanel + Left = 3 + Top = 142 + Width = 307 + Height = 48 + Align = alBottom + BevelOuter = bvLowered + TabOrder = 0 + DesignSize = ( + 307 + 48) + object btnOK: TButton + Left = 146 + Top = 12 + Width = 73 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'O&K' + ModalResult = 1 + TabOrder = 0 + OnClick = btnOKClick + end + object btnCancel: TButton + Left = 223 + Top = 12 + Width = 70 + Height = 25 + Anchors = [akTop, akRight] + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 1 + end + end + object Panel1: TPanel + Left = 3 + Top = 30 + Width = 307 + Height = 74 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object lblFlow: TLabel + Left = 9 + Top = 21 + Width = 63 + Height = 16 + Caption = '&Flow Rate:' + FocusControl = edtFlow + end + object lblO2Con: TLabel + Left = 9 + Top = 50 + Width = 105 + Height = 16 + Caption = '&O2 Concentration:' + FocusControl = edtO2Con + end + object lblPercent: TLabel + Left = 117 + Top = 50 + Width = 20 + Height = 16 + Caption = '(%)' + ParentShowHint = False + ShowHint = False + end + object lblLitMin: TLabel + Left = 98 + Top = 21 + Width = 38 + Height = 16 + Hint = 'liters/minute' + Caption = '(l/min)' + ParentShowHint = False + ShowHint = True + end + object edtFlow: TEdit + Left = 146 + Top = 16 + Width = 121 + Height = 24 + Hint = 'Enter values between 0.5 and 20' + MaxLength = 4 + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnKeyUp = edtFlowKeyUp + end + object edtO2Con: TEdit + Left = 146 + Top = 46 + Width = 121 + Height = 24 + Hint = 'Enter value between 21 and 100' + MaxLength = 3 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnKeyUp = edtO2ConKeyUp + end + object udFlow: TUpDown + Left = 271 + Top = 16 + Width = 19 + Height = 26 + Min = -32768 + Max = 32767 + TabOrder = 2 + OnChangingEx = udFlowChangingEx + end + object udO2: TUpDown + Left = 271 + Top = 46 + Width = 19 + Height = 25 + Min = -32768 + Max = 32767 + TabOrder = 3 + OnChangingEx = udO2ChangingEx + end + end + object Panel2: TPanel + Left = 3 + Top = 3 + Width = 307 + Height = 27 + Align = alTop + BevelInner = bvRaised + BevelOuter = bvNone + Caption = 'Supplemental Oxygen' + TabOrder = 2 + end + object pnlQual: TPanel + Left = 3 + Top = 138 + Width = 307 + Height = 4 + Align = alClient + BevelOuter = bvNone + TabOrder = 3 + end + object Panel5: TPanel + Left = 3 + Top = 104 + Width = 307 + Height = 34 + Align = alTop + BevelOuter = bvNone + TabOrder = 4 + object lblMethodValue: TLabel + Left = 10 + Top = 7 + Width = 45 + Height = 16 + Caption = '&Method' + FocusControl = cbMethod + end + object cbMethod: TComboBox + Left = 146 + Top = 1 + Width = 147 + Height = 24 + Hint = 'Select Method from the list' + Style = csDropDownList + ItemHeight = 16 + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnChange = cbMethodChange + end + end + end +end Index: cprs/branches/GUI-config/CPRS-Lib/mGMV_InputOne2.dfm =================================================================== --- cprs/branches/GUI-config/CPRS-Lib/mGMV_InputOne2.dfm (revision 492) +++ cprs/branches/GUI-config/CPRS-Lib/mGMV_InputOne2.dfm (revision 492) @@ -0,0 +1,262 @@ +object fraGMV_InputOne2: TfraGMV_InputOne2 + Left = 0 + Top = 0 + Width = 854 + Height = 25 + TabOrder = 0 + object pnlMain: TPanel + Left = 0 + Top = 0 + Width = 854 + Height = 25 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + object pnlValues: TPanel + Left = 205 + Top = 0 + Width = 187 + Height = 25 + Align = alLeft + BevelOuter = bvNone + ParentColor = True + TabOrder = 1 + object lblUnit: TLabel + Left = 119 + Top = 8 + Width = 29 + Height = 13 + Caption = 'lblUnit' + end + object bvMetric: TBevel + Left = 162 + Top = 4 + Width = 21 + Height = 21 + Shape = bsFrame + Visible = False + end + object cbxInput: TComboBox + Left = 1 + Top = 1 + Width = 112 + Height = 21 + Hint = 'Enter the appropriate vitals measurement' + Style = csDropDownList + DropDownCount = 12 + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnChange = cbxInputChange + OnClick = cbxInputClick + OnExit = cbxInputExit + OnKeyDown = cbxInputKeyDown + end + object ckbMetric: TCheckBox + Left = 166 + Top = 6 + Width = 15 + Height = 17 + Hint = + 'Check to switch display values between English and Metric equiva' + + 'lents' + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnClick = ckbMetricClick + OnEnter = ckbMetricEnter + OnExit = ckbMetricExit + end + object cbxUnits: TComboBox + Left = 116 + Top = 1 + Width = 69 + Height = 21 + Hint = 'Press to select metric' + Style = csDropDownList + ItemHeight = 13 + ParentShowHint = False + ShowHint = True + TabOrder = 2 + Visible = False + OnChange = acMetricChangedExecute + end + end + object pnlRefusedUnavailable: TPanel + Left = 0 + Top = 0 + Width = 75 + Height = 25 + Align = alLeft + BevelOuter = bvNone + ParentColor = True + TabOrder = 0 + object lblNum: TLabel + Left = 0 + Top = 0 + Width = 24 + Height = 25 + Align = alLeft + Alignment = taRightJustify + AutoSize = False + Caption = '#. ' + Layout = tlCenter + end + object bvU: TBevel + Left = 28 + Top = 3 + Width = 21 + Height = 21 + Shape = bsFrame + Visible = False + end + object bvR: TBevel + Left = 53 + Top = 3 + Width = 21 + Height = 21 + Shape = bsFrame + Visible = False + end + object cbxRefused: TCheckBox + Left = 54 + Top = 5 + Width = 16 + Height = 17 + Hint = 'Mark as Refused' + Alignment = taLeftJustify + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnClick = cbxRefusedClick + OnEnter = cbxRefusedEnter + OnExit = cbxRefusedExit + OnMouseUp = cbxRefusedMouseUp + end + object cbxUnavailable: TCheckBox + Left = 32 + Top = 5 + Width = 13 + Height = 17 + Hint = 'Mark as Unavailable' + Alignment = taLeftJustify + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = cbxUnavailableClick + OnEnter = cbxUnavailableEnter + OnExit = cbxUnavailableExit + OnMouseUp = cbxUnavailableMouseUp + end + end + object pnlQualifiers: TPanel + Left = 392 + Top = 0 + Width = 462 + Height = 25 + Align = alClient + BevelOuter = bvNone + ParentColor = True + TabOrder = 2 + object lblQualifiers: TLabel + Left = 28 + Top = 5 + Width = 53 + Height = 13 + Hint = 'Current qualifiers to be filed with this vital measurement' + Caption = 'lblQualifiers' + ParentShowHint = False + ShowHint = True + end + object bvQual: TBevel + Left = 2 + Top = 3 + Width = 23 + Height = 21 + Shape = bsFrame + Visible = False + end + object bbtnQualifiers: TBitBtn + Left = 5 + Top = 5 + Width = 17 + Height = 16 + Hint = 'Press to display the qualifier selection screen' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = bbtnQualifiersClick + OnEnter = bbtnQualifiersEnter + OnExit = bbtnQualifiersExit + Glyph.Data = { + 7E040000424D7E0400000000000036040000280000000B000000060000000100 + 08000000000048000000C40E0000C40E00000001000000000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA + A6000020400000206000002080000020A0000020C0000020E000004000000040 + 20000040400000406000004080000040A0000040C0000040E000006000000060 + 20000060400000606000006080000060A0000060C0000060E000008000000080 + 20000080400000806000008080000080A0000080C0000080E00000A0000000A0 + 200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0 + 200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0 + 200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000 + 20004000400040006000400080004000A0004000C0004000E000402000004020 + 20004020400040206000402080004020A0004020C0004020E000404000004040 + 20004040400040406000404080004040A0004040C0004040E000406000004060 + 20004060400040606000406080004060A0004060C0004060E000408000004080 + 20004080400040806000408080004080A0004080C0004080E00040A0000040A0 + 200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0 + 200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0 + 200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000 + 20008000400080006000800080008000A0008000C0008000E000802000008020 + 20008020400080206000802080008020A0008020C0008020E000804000008040 + 20008040400080406000804080008040A0008040C0008040E000806000008060 + 20008060400080606000806080008060A0008060C0008060E000808000008080 + 20008080400080806000808080008080A0008080C0008080E00080A0000080A0 + 200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0 + 200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0 + 200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000 + 2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020 + 2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040 + 2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060 + 2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080 + 2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0 + 2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0 + 2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FAFAFAFAFA00 + FAFAFAFAFA00FAFAFAFA000000FAFAFAFA00FAFAFA0000000000FAFAFA00FAFA + 00000000000000FAFA00FA000000000000000000FA0000000000000000000000 + 0000} + end + end + object pnlName: TPanel + Left = 75 + Top = 0 + Width = 130 + Height = 25 + Align = alLeft + BevelOuter = bvNone + ParentColor = True + TabOrder = 3 + object lblVital: TLabel + Left = 0 + Top = 0 + Width = 113 + Height = 25 + Hint = 'Display name of the vitals measurement' + Align = alLeft + AutoSize = False + Caption = 'lblVital' + ParentShowHint = False + ShowHint = True + Layout = tlCenter + end + end + end +end