From 888b7fd2cd1150f147df0be388c2babaaa6e9638 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 13 Mar 2018 15:25:01 +0000 Subject: [PATCH] jvcllaz: Add Jan's simulation components (JvJansSim), incl JvSimScope demo. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6242 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvJans/images/images.txt | 10 + .../jvcllaz/design/JvJans/images/tjvlogic.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimbin.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimbutton.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimconnector.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimindicator.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimlight.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimlogicbox.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimpid.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimpidlinker.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimreverse.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvsimscope.bmp | Bin 0 -> 1654 bytes .../jvcllaz/design/JvJans/jvjansreg.pas | 11 +- .../examples/JvSimScope/JvSimScopeDemo.lpi | 81 + .../examples/JvSimScope/JvSimScopeDemo.lpr | 16 + .../jvcllaz/examples/JvSimScope/MainForm.lfm | 93 + .../jvcllaz/examples/JvSimScope/MainForm.pas | 93 + components/jvcllaz/packages/jvcllaz_all.lpg | 4 +- components/jvcllaz/packages/jvjanslazd.lpk | 7 +- components/jvcllaz/packages/jvjanslazr.lpk | 29 +- components/jvcllaz/resource/JvSimImages.res | Bin 0 -> 3004 bytes components/jvcllaz/resource/jvjansreg.res | Bin 1724 -> 18676 bytes .../jvcllaz/run/JvCtrls/JvMovableBevel.pas | 6 - .../jvcllaz/run/JvJans/JvSimIndicator.pas | 203 ++ components/jvcllaz/run/JvJans/JvSimLogic.pas | 2801 +++++++++++++++++ components/jvcllaz/run/JvJans/JvSimPID.pas | 352 +++ .../jvcllaz/run/JvJans/JvSimPIDLinker.pas | 123 + components/jvcllaz/run/JvJans/JvSimScope.pas | 860 +++++ 28 files changed, 4674 insertions(+), 15 deletions(-) create mode 100644 components/jvcllaz/design/JvJans/images/tjvlogic.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimbin.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimbutton.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimconnector.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimindicator.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimlight.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimlogicbox.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimpid.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimpidlinker.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimreverse.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvsimscope.bmp create mode 100644 components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi create mode 100644 components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr create mode 100644 components/jvcllaz/examples/JvSimScope/MainForm.lfm create mode 100644 components/jvcllaz/examples/JvSimScope/MainForm.pas create mode 100644 components/jvcllaz/resource/JvSimImages.res create mode 100644 components/jvcllaz/run/JvJans/JvSimIndicator.pas create mode 100644 components/jvcllaz/run/JvJans/JvSimLogic.pas create mode 100644 components/jvcllaz/run/JvJans/JvSimPID.pas create mode 100644 components/jvcllaz/run/JvJans/JvSimPIDLinker.pas create mode 100644 components/jvcllaz/run/JvJans/JvSimScope.pas diff --git a/components/jvcllaz/design/JvJans/images/images.txt b/components/jvcllaz/design/JvJans/images/images.txt index 7ffe3857a..ca47fac72 100644 --- a/components/jvcllaz/design/JvJans/images/images.txt +++ b/components/jvcllaz/design/JvJans/images/images.txt @@ -1 +1,11 @@ tjvyeargrid.bmp +tjvsimlogicbox.bmp +tjvsimindicator.bmp +tjvsimconnector.bmp +tjvsimpid.bmp +tjvsimpidlinker.bmp +tjvsimscope.bmp +tjvsimbutton.bmp +tjvsimreverse.bmp +tjvsimlight.bmp +tjvlogic.bmp diff --git a/components/jvcllaz/design/JvJans/images/tjvlogic.bmp b/components/jvcllaz/design/JvJans/images/tjvlogic.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0fd7d27a629a0cc5c4e240eae01310649b102fc0 GIT binary patch literal 1654 zcmaLVv2GMG5P;zcLL3q$4ds+P0jcgXqURmvDX8aBrdaVD(;@K;6!QpaFF{#;uPZl(q<)v& z|N0@K1_uqAD71(P6jaO+NEBMc1quT%9!M1WG_Mj3jzFT&B2*<621g)KXcj3@7#x8_ zp+&f*6$VEjQD`w?nW7k%BakTc{4`af!4XIldVaPk(clOq3O%>Pm1uAT5`~`I6-qQX z0*OM;txP2v9Dzik=QfuT4URyf(AzJtR-(ZXNEBLv?+;OoFL#V9QD_MjC=8B3qR{iV znGy|-K%&s|m%0)SjzFT&^LH~zguxL=6nY+oRHDHVNECV=lTxC=5l9qzJ3`S)G&ll@ zLQC=eB?^NhkQi6bqoqnTI0A`6&tqpwG&ll@LeC@VN;EhEi9*lg8cH-c0*OM;qnt`K zI0A`6&tqOnG&lk&_m8VA^b5ulS+`r(b=1H$QapYhUX=ZQ|MX{;7g?%X{_&Bf%lv`< zWV!Fw<)WPPyNj}ozxChk*7e+U&MyxS59fye=2;K(UiN>QXrlj=lCNtT9)JSxGsmoMV_`-@-l`w=TGYygN!m(w~aGj>3eDzZDah? s{*avw+j{=ZJCY-R9{+hC<^|*KaAJ-?qR=8PP#E~*fkdIt`zq1k2qX$E!l|Uf;0PoN%|i+l21g)KXb}!+ zg~1U>6k1GpOi_&85l9qzO-+?(a0C*CUeh)u8XSQ{q1P*MB^n%oM4{K~3MCpGfkdI# zt4t*t9Dzik*J~~%8XSQ{q30*CR-(ZXNEBLv`G+XR%pGG-6k0+B3WFn%DD?VlrbL4y zkSO%}q^?ARBakTc`rOD$(EwBnrKjNh#6b2qX$Umr%444URyf&{E95 zL}73Q5@YYRv{Z=(M<7w?wd_oZ21g)K=(QwWi3Ud?QRuZ?Lx~1QAW`VGlv9ZYM<7w? zwaiP221g*}*V7?8bwNLoV;*uG;|%O0#n1Qq{eHWVB;Fq%AOHMb+sGcbYh>o1o){u| zjQlx5Jy{OYvwn@-?^pi0eqA#Azo;K0SN^$v+eWV|fA!zScH36|`FUpT82NK#`#C?gT@W%s*LZ6?jq`?tL6k3F?q{83`Bnr(-3KRxMAW>)$ zPHBa~5l9qTOn6OE%!eb8DD;?`Drs;85``YqHYE*?K%&rNNnA;TBakTcSgugg;0PoN zJ(e<+G&ll@LXTxGB@K>1qR`7HuvXIG2qX$E!TduM^UNLdktno;3KRxMAW`V?*-S}; zBakTc_@u6+!4XIldVFpk5@B!z5``XHA(b>Z0*OM8ZBj}a9Dzikmn{^nq`?tL6k3Y; zmnaO5Kw>_6Y%NvN;0PoNJ+_@GX>bG*g&tedl{7d4i9(O<8cG@*fkdIlR!$`ijzFT& zW1E+f21g*}t=e|GJ-v>$s?uHR$0L_^)BdKNUa4|E zO`Dtc_d0{zz5iEz{fOm#&iAh$ae2@Axi|IGXusDt`^{$0{O;D7->N<>w8i*~*+>emsjou&Tx`1D6(oS(1W BBclKS literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimconnector.bmp b/components/jvcllaz/design/JvJans/images/tjvsimconnector.bmp new file mode 100644 index 0000000000000000000000000000000000000000..5ed39e4547271f185d836761760a6e0c6fb3f681 GIT binary patch literal 1654 zcmaLVL5|Z<490N}LWm=<^pX=Wt4S^P+`*?{?W1^sIEQygoPmXpFk2{^@=u)3v>l0; z{NnU`FKJ%#K7aZ8PPX>xt;k2tKJ4z~{g&ICt<2$$vf5gRuuH@gj+{zWN&PB${P|r( z4GuaqQD_kpC^#`kAW>)$7bpz;@Ia!_`~ND{;0PoNEyAg!!r%xb3e7_b6b45iQD_l% zX@$WNNEBL3cuY~On%JGcCJq-&8sv~#{N zo|OG?oi8`}^S!qFUyYx8z2xWry~z)>?P)G@o@b4xW6z(aO}<_+`F1Ju+jBZD^5rEz zT;)^N7js U&p)5*p1e%M-4}3TfU;qFB literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimindicator.bmp b/components/jvcllaz/design/JvJans/images/tjvsimindicator.bmp new file mode 100644 index 0000000000000000000000000000000000000000..61dd1a4e7cccf42515dc2cae89b42d648d8d5018 GIT binary patch literal 1654 zcmbW#O>R>`48U<0A;J+@ddUgss)@y(JNOi=eH1Su&fy&rXJFwYbWKnn|Cwn@6SYEO z-upejcqa4a>+_ed?_`!wZ$&=x_TkZuyq|e{GsAk^5QbSogj*t3;K{30mDJCY`yby# z)Zm~(6NMHrfr1xv1QLZ7ae>0X4-X^?{rFua8XSQ{p+$I=R2UqAM4=g^Kw)qM5``Aw zmR1-XfkdIjgkg$eT#i7Z&}(X{M1v!cDD;}PDbe5vBnrKj#Fc1p1QLZ_%N0sAI0A`6 zucb^S8XSQ{q1Q5(5)F<(qR?{-td(eR1QLaoVE!SBF>}Yb5`~sffx_SjBnrK@&6H?x z1QLZ_Tk1+QI0A`6ukGd|5e7#fQRsCPQi%pfAW`UbOiGCcM<7w?d4!^sXmA7)g_dIe zB?^NhkQi65qoqnTI0A`6uVZIQG&ll@La!s~N;EhEi9)aA8cH-c0*OMeqnt`KI0A`6 zuVY?HG&lk&_oq#cv* z@4EfWQ}J?s|5|?kV*hmZN(y literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimlight.bmp b/components/jvcllaz/design/JvJans/images/tjvsimlight.bmp new file mode 100644 index 0000000000000000000000000000000000000000..f090eb658023cfaecaefb578ae48078f774cc9f8 GIT binary patch literal 1654 zcmaLVyK&q=41i(i#^ZAd4iUNnE7A$$+&!QQ$0!8>$8{j{jB9X!5|m4G^v~UsMZLV_ zN9=)n%YA+O{^O&J^7Vtr7iym`uH@6m+hK(HxFT#u2@!6In1Lr%sVb>IC3nAnim1WC z3r!SS!~_Z|<_IJTE#d-&fgc`76#DXAB^n%oM4?5fN-7MFK%&qLQlKz60*OM4a7!x; zjzFT&V!|**v0aWpqR?|{szie$kSO$=wkgrz2qX$Um&BE5a0C*Cp34 zQlh~TNV&UTWuaZrpU66HS=X%wt}Vsm*J)R7Zf?#Gv+S}|NB;hvSEqG(R?ZJ(xo_9w zv+{nPPIm2QXUF6C?o)m_jIzAQU($!e@;J`%-F3F!p65$>nO_*)!u+=Ut~ouCXMS(z zPw(YV@3jAKe*fVy9#;0vaX#js{xDW|`ImouF&BN8KeDHkxfT2Tesi|`^`*`0{On=> N9PO{KZ(kMq`3vIx2Ydhk literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimlogicbox.bmp b/components/jvcllaz/design/JvJans/images/tjvsimlogicbox.bmp new file mode 100644 index 0000000000000000000000000000000000000000..e26efa0d6052ccf94c102946856e1d8fada66bcc GIT binary patch literal 1654 zcmbW#F>(`841i&UVK7IaRLKeG%xLJjgHA!Mqp0w34t30M1_~V^t&@z+zbiXg2WWV^ z-%8QGJiqt$efj$BoviKCTak}sA1?0X{aUv-YnaC!VX?Ll;g*OAJV~Xhq<)p$|NJhZ z1_v)RQD_kpC`il^NEBMc1quUycpy>e%kL`D;0PoNEkY`(FgOBPj>?0*OM;=jKNu430pe&~p@0i3Ud?QRq1)r9^`xkSO$egrb#ba0C*CmSX)S z3WFn%SgxLMUhY5V>D^fYZ#C0*-}kGwh`ZrkaJD))K! z(w6++bq1OK*MWA^|60F}bojG=JRWzuO?{cq(ra5kOb_eR0_PTyM|7-u} z?)=v#KWz8mCVv@*-+FG>{NdqYN4|u0*8f}I2^(=c{<;a5`gVNkeDmr5sy@^E+kBQc LH{);DzRiCF`7&Y^ literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimpid.bmp b/components/jvcllaz/design/JvJans/images/tjvsimpid.bmp new file mode 100644 index 0000000000000000000000000000000000000000..aa697f14466b6ae7f356ca1ebfa6f1b527ad7651 GIT binary patch literal 1654 zcmcK2JCYMY41i&Ip(u_(sE`xj$g?VP?x0f;>nI9boI@E^oPj_`*p&5_%|G1>>j#jb znQzqAbhW2v^zqZ@H!|YGYmxVi-aXsM+flc>k>+JXT8#)1PKlU_D?_O&sqZBZ-@b^b z!NCnp6k5at3I^r~BnmC!0)>Ge9!M1W`G1vca0C*C7GWr6k3E+ zT48Vm5``8M9#a(S;RqxOJ-4PxHaG%_LeFiRk`0bPqR{h|xRMQyK%&s|b%l}*jzFT& z^Hrvj4URyf(DOByk`0bPqR`_LSS#7!2qX$E!Tv)O>&_kPktno;3KRxMAW`V~*-Xg> zM<7w?`AJ>L21g)K==r(%lL&(&kSO$Qg;cV^5l9qzwn-`3;0PoNJz6MQ$p%LtQD`al zU!pKL0*UqL*;=Y(gCmeA^lUp*vcVBZ6neI#E7{-(Bnmy-HI!^{1QLawt(;0WI0A`6 z&o(b58yta@hr>zs%nQ~NIgL|Jr*#C5wZ!G?au&PY?)WrgS@zt13F?Ofx2UtiOB|o5 za^A1?AA~#-a`;`pzpk^$I)AO7#rWS}^^0}R=3m#jb+gWK#;A|^cZ3`WHoV*YvwrqG zV|ZGw=f5IYXIZY+xvbx=Gv{vz8P9V$|8MpGxX$+K{Xg$_*>3lLh=uz0{w8RhpE=(c Au>b%7 literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimpidlinker.bmp b/components/jvcllaz/design/JvJans/images/tjvsimpidlinker.bmp new file mode 100644 index 0000000000000000000000000000000000000000..9b5c92defbc32b162205128faee29a626b866765 GIT binary patch literal 1654 zcma*lF>c&I3_wvj2%H=tCCi*3u2xI9&mDM*)I17{Mb5!4K+ceYM{v7dz{;0KT5pU5 z$Vg9|C1*z(X&%3RyO*_nc`x#r-lxr-d|dPPZVlsdM_8;aL^vg41g>qQMbJ6ncDaZW3W|1QLZFTOpNba0C*C9^0gpXmA7)gzeoQy*a5%i&k9L!#yXG$!O4EE=+g4{h zS)qzl^zgQ@{GX5U8;8_4Q2+n{ literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvsimreverse.bmp b/components/jvcllaz/design/JvJans/images/tjvsimreverse.bmp new file mode 100644 index 0000000000000000000000000000000000000000..a1bcba6a1ae8075d4b2e21b61ccc156307da9266 GIT binary patch literal 1654 zcma*lJ8s-S41i%e2;v+eCCi*3u69kN&mDM*)I16cA?IKhAZJLyBe?b2u<~oh`+|cY zBYom5H9Mk4^Yz>J4>H=9_adL^eR_2xA4lHajW91agw1Fn!YL6maHT6%CH1@H;nxol zH8{ATi9(B*KtabGfkdH2T%a)U!vl#zzdl!q21g)KXc4-S3WFn%C^SV16b45iQD_lP zX@$WNNEBL3C{q;M;RqxOJzq_gXmA7)g`Tf%N;EhEi9*jMaU~iYfkdI_a)lBNjzFT& zb174a21g)K=()_LM1v!cDD?OQ)=D%u0*OLP@cto+?adwAktno;3KRxMAW`V~*-VKB zM<7w?`AJ=g21g)K==r&MNQA)=NECW*g;b)!5l9qzZj(}?!4XIldTgO+B^n%oM4_d4 z{}P445lC!D&#k3OG&ll@LeFhyN;EhEi9*jU=}I&>0*OM;?HWonI0A`6&#jzFG&ll@ zLeFhpN;EhEDGyJpEQ|~06IsV8>$>&8v8A~D++VcaZujy$+eMb{$Ui-C>pH(@JXy~B zb-8Ni{Owg6^N;bT^t#f0lV2VmAGz_*JoVgff8N@0{L5^o{Oz*L0o$0}?wmhmPx(>E zHcYmA{95*mf1Q|lg#2ET-0&wUgwWxU5`JOwf*OE b{D0=}j_Y}fDG@7hr7Be=^{eFm=XVh` zIC!9mLW`I{LB$+_M4?4opfGUbfkdG%-&LZ)5l9qTgsP;%;0PoN%^(E|gCmeAvJUr9^`xkSO%rLeWYzI0A`6OELcv zg~1U>jHB1qQY9K3fkdI#wlgIf9Dzik*Oqi88XSQ{q1Sc|B^n%oM4{JKP9+)~fkdI# zHZLU_9D$Vk(^-!63-XDa=PBp&sDWcNaryCSSMKiao*q}(wNjn!rxTBkytFS*kF;_g z$$Qv&-M($l&u0G7|3KO1IckTOc5-YZ50~-If7{1+=)Q7qtN+s~$A^dQVU|l+H|HbS z_x(qG+qPZ%OTLl!e7uZ<`ufhgKhN>ck&jut%!53C)`70i^M2KS*q+Bg{$2kyuKE5x d|N6?hUhjV`&+*^o_VZt5{_@)^4{onK_zeRN4d4I( literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/jvjansreg.pas b/components/jvcllaz/design/JvJans/jvjansreg.pas index 0f6cbb3aa..cc0899dec 100644 --- a/components/jvcllaz/design/JvJans/jvjansreg.pas +++ b/components/jvcllaz/design/JvJans/jvjansreg.pas @@ -14,13 +14,22 @@ implementation {$R ../../resource/jvjansreg.res} uses - Classes, JvDsgnConsts, JvYearGrid; + Classes, JvDsgnConsts, + JvYearGrid, + JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic; procedure Register; begin RegisterComponents(RsPaletteJvcl, [ TJvYearGrid ]); + + // Simulator Components + RegisterComponents(RsPaletteJvcl, [ // was: RsPaletteJansSim + TJvSimScope, TJvSimIndicator, TJvSimPID, + TJvSimPIDLinker, TJvSimConnector, TJvLogic, TJvSimButton, TJvSimLight, + TJvSimLogicBox, TJvSimReverse]); + end; end. diff --git a/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi b/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi new file mode 100644 index 000000000..8714e393a --- /dev/null +++ b/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi @@ -0,0 +1,81 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="JvJansLazR"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="JvSimScopeDemo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="MainForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frmMain"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\..\bin\JvSimScopeDemo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr b/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr new file mode 100644 index 000000000..dc392eba5 --- /dev/null +++ b/components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr @@ -0,0 +1,16 @@ +program JvSimScopeDemo; + +uses + Forms, Interfaces, LclVersion, + MainForm in 'MainForm.pas' {frmMain}; + +{$R *.res} + +begin + {$IF LCL_FullVersion >= 1080000} + Application.Scaled := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/components/jvcllaz/examples/JvSimScope/MainForm.lfm b/components/jvcllaz/examples/JvSimScope/MainForm.lfm new file mode 100644 index 000000000..0a0165262 --- /dev/null +++ b/components/jvcllaz/examples/JvSimScope/MainForm.lfm @@ -0,0 +1,93 @@ +object frmMain: TfrmMain + Left = 0 + Height = 271 + Top = 0 + Width = 541 + BorderStyle = bsSingle + Caption = 'JvSimScope demo' + ClientHeight = 271 + ClientWidth = 541 + Color = clBtnFace + Font.Color = clWindowText + Position = poScreenCenter + LCLVersion = '1.9.0.0' + object jssRandom: TJvSimScope + Left = 264 + Height = 208 + Top = 48 + Width = 256 + Active = False + BaseLine = 0 + BaseLineUnit = jluAbsolute + DisplayUnits = jduLogical + Interval = 100 + Lines = < + item + Name = 'Random' + Color = clAqua + Position = 0 + PositionUnit = jluAbsolute + end + item + Name = 'Random 2' + Color = clYellow + Position = 0 + PositionUnit = jluAbsolute + end> + Minimum = -100 + Maximum = 100 + TotalTimeSteps = 240 + OnUpdate = jssRandomUpdate + end + object lblRandomDetails1: TLabel + Left = 16 + Height = 80 + Top = 48 + Width = 232 + AutoSize = False + Caption = 'This scope shows random values but uses logical units to show a more advanced usage. Here, the Minimum and Maximum values are used and can be adjusted to make the lines fit in the display.' + ParentColor = False + WordWrap = True + end + object Label1: TLabel + Left = 16 + Height = 96 + Top = 128 + Width = 225 + AutoSize = False + Caption = 'The yellow line values are meant to go higher than the maximum value set at design time for the scope. Use the button below to change that value and notice how the lines are completely adjusted to this change.' + ParentColor = False + WordWrap = True + end + object lblWelcome: TLabel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 114 + Height = 28 + Top = 8 + Width = 312 + Caption = 'Welcome to the TJvSimScope demo' + Font.Color = clWindowText + Font.Height = -20 + ParentColor = False + ParentFont = False + end + object btnActivateDeactivateRandom: TButton + Left = 32 + Height = 25 + Top = 232 + Width = 75 + Caption = 'Activate' + OnClick = btnActivateDeactivateRandomClick + TabOrder = 0 + end + object btnAdjustMax: TButton + Left = 113 + Height = 25 + Top = 232 + Width = 100 + Caption = 'Adjust Max value' + OnClick = btnAdjustMaxClick + TabOrder = 1 + end +end diff --git a/components/jvcllaz/examples/JvSimScope/MainForm.pas b/components/jvcllaz/examples/JvSimScope/MainForm.pas new file mode 100644 index 000000000..c10305c7c --- /dev/null +++ b/components/jvcllaz/examples/JvSimScope/MainForm.pas @@ -0,0 +1,93 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: MainForm.pas, released on 2007-02-06. + +The Initial Developer of the Original Code is Olivier Sannier [obones att altern dott org] +Portions created by Olivier Sannier are Copyright (C) 2007 Olivier Sannier. +All Rights Reserved. + +Contributor(s): None to date. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Description: + Demonstrates the usage of TJvSimScope + +Known Issues: +-----------------------------------------------------------------------------} +unit MainForm; + +interface + +uses + SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, JvSimScope, StdCtrls; + +type + TfrmMain = class(TForm) + jssRandom: TJvSimScope; + lblRandomDetails1: TLabel; + btnActivateDeactivateRandom: TButton; + btnAdjustMax: TButton; + Label1: TLabel; + lblWelcome: TLabel; + procedure jssRandomUpdate(Sender: TObject); + procedure btnActivateDeactivateRandomClick(Sender: TObject); + procedure btnAdjustMaxClick(Sender: TObject); + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.lfm} + +{ TfrmMain } + +procedure TfrmMain.btnActivateDeactivateRandomClick(Sender: TObject); +begin + jssRandom.Active := not jssRandom.Active; + if jssRandom.Active then + btnActivateDeactivateRandom.Caption := 'Deactivate' + else + btnActivateDeactivateRandom.Caption := 'Activate'; +end; + +procedure TfrmMain.btnAdjustMaxClick(Sender: TObject); +var + I: Integer; + LineMax: Integer; +begin + // We check all values of line number 1 to see if there is one that is greater + // than the current max value of the scope. If so, we change the Maximum value + // to demonstrate how redrawing is done and how past values were kept to allow + // redrawing with a new scale. + LineMax := jssRandom.Minimum; + for I := 0 to jssRandom.Lines[1].Values.Count - 1 do + begin + if jssRandom.Lines[1].Values[I] > LineMax then + LineMax := jssRandom.Lines[1].Values[I]; + end; + + if LineMax > jssRandom.Maximum then + jssRandom.Maximum := LineMax; +end; + +procedure TfrmMain.jssRandomUpdate(Sender: TObject); +begin + jssRandom.Lines[0].Position := Random(200) - 100; + jssRandom.Lines[1].Position := Random(200); // this one will eventually go out of scope +end; + +end. diff --git a/components/jvcllaz/packages/jvcllaz_all.lpg b/components/jvcllaz/packages/jvcllaz_all.lpg index 002bfcce8..0a893a56a 100644 --- a/components/jvcllaz/packages/jvcllaz_all.lpg +++ b/components/jvcllaz/packages/jvcllaz_all.lpg @@ -1,7 +1,7 @@ <?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectGroup FileVersion="1"> - <Targets Count="19"> + <Targets Count="21"> <Target0 FileName="JvCoreLazR.lpk"/> <Target1 FileName="JvCoreLazD.lpk"/> <Target2 FileName="JvCtrlsLazR.lpk"/> @@ -21,6 +21,8 @@ <Target16 FileName="jvcustomlazr.lpk"/> <Target17 FileName="jvcustomlazd.lpk"/> <Target18 FileName="jvcmpr.lpk"/> + <Target19 FileName="jvjanslazr.lpk"/> + <Target20 FileName="jvjanslazd.lpk"/> </Targets> </ProjectGroup> </CONFIG> diff --git a/components/jvcllaz/packages/jvjanslazd.lpk b/components/jvcllaz/packages/jvjanslazd.lpk index 6685b2ac7..974e5f0fb 100644 --- a/components/jvcllaz/packages/jvjanslazd.lpk +++ b/components/jvcllaz/packages/jvjanslazd.lpk @@ -2,7 +2,7 @@ <CONFIG> <Package Version="4"> <PathDelim Value="\"/> - <Name Value="jvjanslazd"/> + <Name Value="JvJansLazD"/> <Type Value="RunAndDesignTime"/> <Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/> <CompilerOptions> @@ -11,11 +11,12 @@ <SearchPaths> <IncludeFiles Value="..\run\JvJans"/> <OtherUnitFiles Value="..\run\JvJans;..\design\JvJans"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> </CompilerOptions> <Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code of Jan's Components): -- YearGrid"/> +- YearGrid +- Simulation components"/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <Version Major="1" Release="4"/> <Files Count="1"> diff --git a/components/jvcllaz/packages/jvjanslazr.lpk b/components/jvcllaz/packages/jvjanslazr.lpk index 678f04989..2f773cae8 100644 --- a/components/jvcllaz/packages/jvjanslazr.lpk +++ b/components/jvcllaz/packages/jvjanslazr.lpk @@ -2,21 +2,22 @@ <CONFIG> <Package Version="4"> <PathDelim Value="\"/> - <Name Value="jvjanslazr"/> + <Name Value="JvJansLazR"/> <Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/> <CompilerOptions> <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> <OtherUnitFiles Value="..\run\JvJans"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> </CompilerOptions> <Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code of Jan's Components): -- YearGrid"/> +- YearGrid +- Simulation components"/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <Version Major="1" Release="4"/> - <Files Count="2"> + <Files Count="7"> <Item1> <Filename Value="..\run\JvJans\JvYearGrid.pas"/> <UnitName Value="JvYearGrid"/> @@ -25,6 +26,26 @@ <Filename Value="..\run\JvJans\JvYearGridEditForm.pas"/> <UnitName Value="JvYearGridEditForm"/> </Item2> + <Item3> + <Filename Value="..\run\JvJans\JvSimIndicator.pas"/> + <UnitName Value="JvSimIndicator"/> + </Item3> + <Item4> + <Filename Value="..\run\JvJans\JvSimLogic.pas"/> + <UnitName Value="JvSimLogic"/> + </Item4> + <Item5> + <Filename Value="..\run\JvJans\JvSimPID.pas"/> + <UnitName Value="JvSimPID"/> + </Item5> + <Item6> + <Filename Value="..\run\JvJans\JvSimPIDLinker.pas"/> + <UnitName Value="JvSimPIDLinker"/> + </Item6> + <Item7> + <Filename Value="..\run\JvJans\JvSimScope.pas"/> + <UnitName Value="JvSimScope"/> + </Item7> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/components/jvcllaz/resource/JvSimImages.res b/components/jvcllaz/resource/JvSimImages.res new file mode 100644 index 0000000000000000000000000000000000000000..8c6d320ad00d3522f36990d55e246467b04f7c1b GIT binary patch literal 3004 zcmdT`y>1gh5S~Oxm(G-w)-`qqj}Q@%2@0G91n~%zr<0{|cdIlxXk5FZ_fz<hB6QNG zTfW)dS+65(>?ladB)9X;&wjVFe?B6jAs*+#1GpjIkBLs<aqgJj(^vXT=k$RtsG<qb z8NCMjhW4C3rhcyyA{qk^<8wsMLIj*D&lPxWi11Iw1cermR;v}X1Z0q+Tu^AkxE*zW z6GJDt+Ysjtm^OD%+ge^bOkpkT<S?y|Cx<~;;&Awv#CSOx)xq}hvMkk>{ta`oL;ptY zBF33Re|fzvN6byI2Z;YJOT2I7tMc*YI@uDp4f69ikGPqId>`kA%PW@te)tyb<v7^r zF7-3spm8S-3|R&s<#jxlj9^>WRTG{&wcD<rPFveK8wwz<s><E=@Wlf9Y47IMWYXS% z4~$O2eQ)a%Z+C;<(ZE%=(L};cX9j3g28bAGq8QP>>AEALH-2mE-lv!J1%FlAt#|k8 z3vkGzdvyq2m517^GKKe-HWV)l&uySN2xGxC|Hs1q6VH&W`SP~i*m?0eVQBYhWi3xJ z>AUZovuqWK9@RS5M1>Y!FPAw^5$}(Y4J;X{2Uz|K&PG_&i-o>}XpK4ZZ{k#g*0@FQ zcP20J+cBYcIF%}oYAv_acGrzVsjeCB{Of330gnT20X2|g-06^zbSTbwa?C>XGLAt4 zHe$y4RCtiycP;h1;AyR8oD)$$msTc5uEwoc?nFpb9*4$pO*pWTr(jAva;BBDsOx}1 zP~+$+58P3}Bj-Ny2-d!!Tw`Q=|JLy+-=^O0e*Hvm@x7<=WX`1jh6(k~7Qa&A+c2kN kn^FN};!RL8!5xLI0E~+>;pF%8Z_+yEO#C3@*<eh@AI@e|cmMzZ literal 0 HcmV?d00001 diff --git a/components/jvcllaz/resource/jvjansreg.res b/components/jvcllaz/resource/jvjansreg.res index 3c12f20cd930310332a07624e679a9ba05912b2c..bad99bbeb92a07e2fb01fc70bc26267812d9f764 100644 GIT binary patch literal 18676 zcmeI)v5q8Jb{^ofBVk&A90GJ?UQ?zF0V6}xeaYouwGy=?xFR8W$K+$2M>$48&v88g zdIlNy5$JZ0FvTx2GOMzxyJu&(J6=cBS2ycK<c)}|sQBwfWp_lx;PLU~;fv`XzmE8i zDvys}#s7%^8vhXgE53`rh`)>9@Z0#S>)L<zXU|Xj_a6Sct6#;xxh$ApJui=6d3?A` z72zYQ&c<gCW33hI|E>6^|NFn~;3TnNG>aWEgMkM#DVoKO$Y3z>MHbCsU$;B7lcZ=C zJHo^0!6Ye~#kP~dV3HKgVn_IhJ(wg#v)D1iZpPr4lcHJd^U%i7PLiTo?DMea&`y$~ zS?u#A$)TMjMYGuF%T+@=Ns4B%&zG`?c9Im$VxKSb8rn%xG>d)t7R)`glcZ=CJIe7_ z42~mDj=5Rvs1Xb%Nzp9!`E8p+J4uRWvCnU54(%i<n#Df9-8ND+Ns4B%&r_j?c9Im$ zVxOnU8rn%xG>d&Xg=!D&Bq^H3j^+4Q3?@m@9P>U;tueHdq-YlVJniPtPLiTo?DLe& zp`9c}v)Je9T0=WYie|CTQ@MwBk`&EipQrg6+DTG${L}Z3@nF5upDV}Z<G8?hg!yu< zd5r(__HO$2+i!pP|L1g9_3%>v{(FmF*56uR)yKP63!dr^Hh4E(`ajlxczk?w_wk48 zZ(dBd{rsq(AI|A@{oGc3`|jaIH`gzYx}ACd{(hG{{%rm2XZlgUJE*7L;z#PA+#l=z z>rYHaKbP{u^K^XuRKF~I{&dtoIlcYn-AB{qJNV6K7JT!W1xGghXW!rFZ2G-K`tR}A z@i*}skA5A0>CyjuIs?9BRE8gHn#Gnw!C;aU&0@!lU~tSy(JZzc3I>y;Xck)z1%pXa zG>aWd3?@m@EVdj929u;{7F!MlgGo{}i!FzO!6Ye~#g4gy!6Ye~#SWWia2$DZ%*|rU zp<pmcie|CpP%xMzMYGs)C>TtVqFHR$&|ol0ie|CpP%xMzMYGs)C>TtVqFHP?6bvRw z(JXd&I)h14G{?N<P%xMzMYGs)C>TtVqFHP?6bvRw(Jc0Py4KK6lA>Ac^HlDkog_uG z*ym}!hIWz^zg$K=zPjYyvgq;dQhPl9d|lAVDC^vMdULLStKWKh__+RFh`hP0dy1fY zBU_&9*NnQ<FZ*<^f8D)@BN)%=b^ZAOZhN3&rRVAH@x%S=@Z#}vH@5XO-5!7V@ZpWe zM|0Whe`)<q*teJcUtWZ3{l0&7=lHq)tNOWnpW2^e$&3E)kNy7f=Q8TI@w@n|OGf>L zan;`#OP$k~jLPtXO|#f?C>TtVqFL;i5e$wwDVoKWL&0E@6wPAGp<pmcie|CpP%xMz zMYGspbq159Xck)z1%pXaG>a{Vg25yyn#Gnw!C;aU&0>emGdPYsIp$`u<xnt~Bt^5> zawr%~lA>8`ITQ>gNzp8}90~@Lq-Yjf4h4frQZ$P#hl0T*DVoKWL&0E@6wP9Xr!$x& zMRUws4h4frQZ$P#hl0T*DVoKWL&0E@6wP9vr)v%EBq^H3K2PNy+DTG0i+!HvYiK7) z@u$hCyKC<;zIqx*JzpCiUW}ve>Thou_09n6(dF(ky?IbSv&e7pN8PLMckq|>cfNKp z{qW%r)^&A^241Xx8%Le>r~WU41mncl>z~8F&(+_4X8pHsul>C2UuU20|6g4HT>rQF z)A04x{v0p+WxCeS-v{12`0}hD!==0L*Rk4V!7*HVPUXj=ep&Ey$5FqQOTROJ7r*|J zQOmc>&!`ImNzp8}90~@Lq-Yj9W(0#{PKsu+<xnt~Bt^5>awr%~lA>AcP+~Aiie|CH z>I^1H(JXf8ioql)n#Gnw!C;aU&0@=;U@%FFX0gNO85~ER9CNeSawr%~lA>8`ITQ>g zNzp8}90~@Lq-Yjf4h4frQZ$P#hl0T*DVoKWL&0E@6wPAGp<pmcie|CH(-};XqB-V$ zo?2sQCrQyP_IcXPp`9c}v)Jb;nL|5Cie|CT)3t_nk`&EipQmyU?IbCh#Xe8-HMEnY z_!DH5*Tr;R(C+W`#gQJj`rW<0m-Xk2I_pn;J!RC>`e$Fy_1kt|)o&New|DhxMx9sD zYyB>x&dcjrzZ}Rlqt34G>W=TIU8ZaQw*$YG-@UtE|ID0o*=Oswn7DLx*Uv2`KCa(A z<Hh=yXIx&Fcvbg|Fi?7bUq4rj*Y(>o&-%x=^se=f7M$JvSVsK^tGvF~_qSjE1{E$4 zOp>BmY}peGCP~pOcFYI{$D9<+V#}UjFiDDLv1Ly%m?TBB*s>=WOp>BmY}peGCP~pO zw(JQ8lcZ=CTlNHlNm4Y6Eqj8&Bq^H34x49i9C>og&0@=*U@%FFX0c^YFqkAov)HmH z7)+9)S!~%83?@m@EVk?k29u;{7F+fNgGo{}i!FPC!6Ye~#STwrFiDE$nD=>VjiH?+ zMYGuFX*Y*<k`&EipQmIF?IbCh#Xe8h8rn%xG>d(n%00A`q-YlVJk8h8PLkqJkV|i` z<DKg-($8b32d~)k^fX3#tA4pcUUKXEr~13s_1oC#bw79Y7ybN5{gO+s`gzKw+jhS) z#rGx`&m(_+r2c$Z=cC7C?DS&&e`V6okxM^P|G1xX{a=~lvOh2T`CR=M?B|<f|6fmz z>zi+Gw_WesqyAA~UDEP%_xH|R`fKU*yZCSM-Ix1&enwpoNQ!2$<xnt~Bt^5>F(Vip zb5b;mEr)`^Bq^H3mP5f{k`&Ei%b{Q}Ns4B%<xnt~Bt^5>p(_THq-Yjf4h4frQZ$P# zhl0T*DVoI&n`dwwd2-CnV#}dmFiDDLvE@)Om?TBB*m5WsOp>BmY&jGRCP~pOwj2ru zlcZ=CTMh+-Nm4Y6Er)`^Bq^H34o_z=Ns8u}w;T!vlcZ=C`#kOD&`y$~S?u$a%%Pnm zMYGuF=~_cONs4B%&r`XFc9Im$VxOn^8rn%x{1F-T^*LR~4!0r1w?BOS_4nUf^!9qw z@3!EFuT_0qZx%h=p7;5>PR{j(nHzi8N&i2k{{F@Ko^o#Y`}em6*NFPzx<5|~&U;x8 z->P4>dt30j{_eWqy4utF@2(53^|!a<H6pn@<F0<`|G9qobI!5;wSI2k6YIZ!ZzObA zzdZ5m=e_!^pUW=|$BnvU!?$iP_Z5%YWwPL@pKIx9!MPi+-zV|?t^e0ibpDF+@S_>^ z@;!X#`y_rJ#~r@Ejqm(?9n+V;J!SZTrde$H6AUIv(JXe%2nNTT6wPAGpI|Uaie|Cp zPcWDyMYGtU#9)#X&0@=+U@%FFX0bz83?@m@EVld!29u;{7F+%VgGo{}iyb!4;5hQ+ zn486xKfz#<6wPAGpI|Uaie|CpPcWDyMYGuQCm2kUqFHSD6AUIv(JZ$72?mp-Xck-k z1cOOZG>aXc&R~)h%`tEJ6AUIv(JZ$72?mp-Xck-k1cOOZG>d(nt~Ioiq-YlVJe7NB zCrQyP_IaAGp`9efACXPQB*%2ifU|vm58umC)#KxBob=#z{OZoj`iBp<Ww-lx563X# z!{y_6^wm>cA0Li>d^(=<qjmdfyVt%yoa<l1>EZqR563X<sX4!Re9-&3FSk|){>=4U zf9mh(_wnJnA0D6EIlq3q?EhuYkE3`x4*fj84pzM#_lx>hZj7G$p#Qt|ueD>@egEfH z&d;A;|8xD^4}<O=e|j`@jFVo3+2xDl9Qd*E(|@w<*Z1}QGXCD*oQ`)!{La#I`jSr> zeyC{{TLuM#Nm4Y69W#Q#F(*Z{*fJ;>Op>BmY#9^`CP~pOwhRgelcZ=CTLuM#Nm4Y6 zErWu=Bq^H3mO;T_k`&Ei%b;K|Ns4B%!{!+rN1hyWv)D2y7)+9)S!@{;3?@m@EVc{^ z29u;{7Fz}dgGo{}i!FnK!6Ye~#g;+AV3HKgV#}alFiDDLvBT3DOp>BG<}HJQ!6Ye~ z#g;+AV3HKgV#}alFiDDLvCq@BhIWz^&0?RYau4k!DVoJTPxCdjlcf0N^655qx?SpS zIdmOMTz<npK7GC}RF3zUpTDf%t^ZuVdr!v0EuW6{@1Jt1d&)=k+x@*)>w72On}_4? zPM@kDe|LJWKVG(TtnbbBPj!K3K%#i5U&c=7dOx%7ZHt$Ke%;UQmH1=o*L$(&=<0bt zZ(ZNoW5D{&W#?~|vpwtgo!mxFKR=)TF23_`p^p1{zxVl^zU0$!F({hFmO;T_k`&Ei z$BbZb%t_HKwhRgelcZ=CTLuM#Nm4Y6ErWu=Bq^H3mO;T_k`&Eihpre*lA>8`859gA zNzp8}3<?I5q-Yj9Y@We!<jFBNi!FnK!6Ye~#g;+AV3HKgV#}alFiDDLv1L#&m?TBB z*fJ;>Op>BmY#9^`CP~pOwhRgelcZ=CJ3O7iBq^F>-ZCf{Op>BmY#9^`CP~pOwhRge zlcZ=C`#fE1XeUY0EcSUS_s~v~qFL<oG+#qINs3=EpUwf*?ep_{_wGYQc>Rogy5zxq z4qdL6*F5;q`Zb?ktbdnJ*Q@TC2gerz>d2dqrfdBSCaZZfwlqB6I%xf;V0yT`N&7O` z^7p4(-TCv$x*U30zXj8^|0AXZ!l(D=Mg6v0FW0~A*0HPi{rtrGb3R@3^4iaH{U}@~ z{eSauY&|}zfBf%rZ~q4BxAB|!FGf)3^d*}z{6Nzzw)_bOlcZ=CJ7xrfV@`@@vE@%N zm?TBB*zzYBOp>BmZ21!mCP~pOc37RkBq^H3mOsH@k`&Ei%b#E{Ns4B%WA0!uNs4B% z!{!+rN1hyWv)J+{7)+9)S#0?e3?@m@EVld!29u;{7F+%VgGo{}i!FbG!6Ye~#g;$8 zV3HKgV#}XkFiDDLvBT3DOp>BG<}H7M!6Ye~#g;$8V3HKgV#}XkFiDDLvCq@BhIWz^ z&0?RYau4k!DVoJTPxCdjlce|sv*{;ikO9&k7$Y55zH<zAjJ2M}PDlB?mG$td{&Yv} z98=x0>GApY*NeY9-PMnPdKx=Dum06nmx#EIoj$5x$4(#D&#}|btiO4^KN9|uO`oej zKj9pv-PRYJ=cdn~6%kJvcSgwZ%3dPtseV?@&&T?o%Am9UaR^=NpSkIGWYf#{>^=X> zTt8Zu>8Iq<pa0v4L;ULM^300x;X-gWK6~i=USIy-h!OH<FiDDLv1Ly%m?TBB*s>=W zOp>BmY}peGCP~pOw(JQ8lcZ=CTlNHlNm4Y6Eqj8&Bq^H34x48%NshT$Y}peGCP~pO zw(JQ8lcZ=CTlNHlNm4Y6eL2s{MoLFz<*K4tY}peGCP~pOw(JQ8lcZ=CTlNHlNm4Y6 z9iGl$k`&D`Z`l(JCP~pOw(JQ8lcZ=CTlNHlNm4Y6Eqj8&Bq^H3mOa5>k`&Ei`xy-e zlce|sbICRBZu+CfOwWUX`&>Hyt<&?s<~grEQNQHUtNQbp>25G^T%?Zx`UzvEI7T|h zpvm5yW2Vdg9F@x$=(vUFLT$|STtB-1xE_~(Ap2Cmj+u^5j_LK7>9Y2@=r#trygt{x mx$e)?c8|V~o?dVF+{;hZ&%ST#%cW1eKA+C3V}Cw3X8LF6Vl&kM delta 8 Pcmew|k#P_2hCOTm6B7f% diff --git a/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas b/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas index 1bed5045e..78ea9549d 100644 --- a/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas +++ b/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas @@ -26,7 +26,6 @@ Known Issues: unit JvMovableBevel; {$mode objfpc}{$H+} -//{$I jvcl.inc} interface @@ -41,9 +40,6 @@ type tdRightToLeft, tdTopLeftToBottomRight, tdTopRightToBottomLeft, tdBottomLeftToTopRight, tdBottomRightToTopLeft); -// {$IFDEF RTL230_UP} -// [ComponentPlatformsAttribute(pidWin32 or pidWin64)] -// {$ENDIF RTL230_UP} TJvMovableBevel = class(TBevel) //TJvExBevel) private FStartX: Integer; @@ -69,8 +65,6 @@ type X, Y: Integer); override; procedure MouseEnter; override; procedure MouseLeave; override; -// procedure MouseEnter(Control: TControl); override; -// procedure MouseLeave(Control: TControl); override; public constructor Create(AOwner: TComponent); override; published diff --git a/components/jvcllaz/run/JvJans/JvSimIndicator.pas b/components/jvcllaz/run/JvJans/JvSimIndicator.pas new file mode 100644 index 000000000..5418a8a3d --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvSimIndicator.pas @@ -0,0 +1,203 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvSimIndicator.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvSimIndicator; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, + SysUtils, Classes, Graphics, Controls, ExtCtrls, + JvComponent, JvJVCLUtils; + +type + TJvSimIndicator = class(TJvGraphicControl) + private + FValue: Integer; + FMaximum: Integer; + FMinimum: Integer; + FBarColor: TColor; + FBackColor: TColor; + FMargins: TJvRect; + procedure SetBarColor(const Value: TColor); + procedure SetMaximum(const Value: Integer); + procedure SetMinimum(const Value: Integer); + procedure SetValue(const Value: Integer); + procedure SetBackColor(const Value: TColor); + procedure SetMargins(const Value: TJvRect); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Value: Integer read FValue write SetValue; + property Minimum: Integer read FMinimum write SetMinimum default 0; + property Maximum: Integer read FMaximum write SetMaximum default 100; + property BarColor: TColor read FBarColor write SetBarColor default clLime; + property BackColor: TColor read FBackColor write SetBackColor default clSilver; + property Width default 25; + property Height default 100; + property Margins: TJvRect read FMargins write SetMargins; + + property Align; + property Anchors; + property ParentShowHint; + property ShowHint; + property Visible; + +// property OnCanResize; --- wp removed + property OnClick; + property OnConstrainedResize; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + property OnStartDock; + property OnStartDrag; + end; + + +implementation + +constructor TJvSimIndicator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 25; + Height := 100; + FMinimum := 0; + FMaximum := 100; + FValue := 50; + FBarColor := clLime; + FBackColor := clSilver; + FMargins := TJvRect.Create; +end; + +destructor TJvSimIndicator.Destroy; +begin + FMargins.Free; + inherited Destroy; +end; + +procedure TJvSimIndicator.Paint; +const + NumberOfBars = 20; +var + R, Ri: TRect; + I, n: Integer; + h, dh: Integer; +begin + R := ClientRect; + Canvas.Brush.Color := clSilver; + Canvas.FillRect(R); + Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1); + + Dec(R.Top, Margins.Top); + Dec(R.Left, Margins.Left); + Dec(R.Bottom, Margins.Bottom); + Dec(R.Right, Margins.Right); + Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1); + + Canvas.Brush.Color := FBackColor; + InflateRect(R, -1, -1); + Canvas.FillRect(R); + Dec(R.Right); + h := R.Bottom - R.Top; + dh := h div NumberOfBars; + n := Round(NumberOfBars * (FValue - FMinimum)/(FMaximum - FMinimum)); + Canvas.Brush.Color := FBarColor; + Ri := Classes.Rect(R.Left + 1, R.Bottom - dh + 1, R.Right - 1, R.Bottom); + for I := 1 to n do + begin + Canvas.FillRect(Ri); + Dec(Ri.Top, dh); + Dec(Ri.Bottom, dh); + end; +end; + +procedure TJvSimIndicator.SetBackColor(const Value: TColor); +begin + if FBackColor <> Value then + begin + FBackColor := Value; + Invalidate; + end; +end; + +procedure TJvSimIndicator.SetBarColor(const Value: TColor); +begin + if FBarColor <> Value then + begin + FBarColor := Value; + Invalidate; + end; +end; + +procedure TJvSimIndicator.SetMaximum(const Value: Integer); +begin + if FMaximum <> Value then + begin + FMaximum := Value; + Invalidate; + end; +end; + +procedure TJvSimIndicator.SetMinimum(const Value: Integer); +begin + if FMinimum <> Value then + begin + FMinimum := Value; + Invalidate; + end; +end; + +procedure TJvSimIndicator.SetValue(const Value: Integer); +begin + if FValue <> Value then + begin + FValue := Value; + Invalidate; + end; +end; + +procedure TJvSimIndicator.SetMargins(const Value: TJvRect); +begin + FMargins.Assign(Value); + Invalidate; +end; + + +end. diff --git a/components/jvcllaz/run/JvJans/JvSimLogic.pas b/components/jvcllaz/run/JvJans/JvSimLogic.pas new file mode 100644 index 000000000..592e2a013 --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvSimLogic.pas @@ -0,0 +1,2801 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvSimLogic.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Description: + This unit includes several visual logic blocks that can be used without any programming. + It is the start of a whole series of simulation blocks. + + There is a string seperation between the visual part and functionality. + + The user creates and removes blocks; joins and moves them. + + The functionality is created every 50 msec in the onTimer event of TJvSimLogicBox. + + No programming is required, just drop a TJvLogicBox in the corner of a form and Build the program. + + All the rest is up to the user. + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvSimLogic; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, + Graphics, Controls, Forms, Dialogs, ExtCtrls, + SysUtils, Classes, + JvTypes; + +type + TJvLogic = class; + + TJvGateStyle = (jgsDI, jgsDO); + TJvLogicFunc = (jlfAND, jlfOR, jlfNOT); + TJvGate = record + Style: TJvGateStyle; + State: Boolean; + Active: Boolean; + Pos: TPoint; + end; + + TJvPointX = class(TPersistent) + private + FX: Integer; + FY: Integer; + public + function Point: TPoint; + procedure SetPoint(const Pt: TPoint); + procedure Assign(Source: TPersistent); override; + published + property X: Integer read FX write FX; + property Y: Integer read FY write FY; + end; + + TJvConMode = (jcmTL, jcmTR, jcmBR, jcmBL); + TJvConPos = (jcpTL, jcpTR, jcpBR, jcpBL); + TJvConShape = (jcsTLBR, jcsTRBL); + + TJvSIMConnector = class(TGraphicControl) + private + FMdp: TPoint; + FOldp: TPoint; + FConAnchor: TPoint; + FConOffset: TPoint; + FConMode: TJvConMode; + FConHot: TJvConPos; + FDoMove: Boolean; + FDoEdge: Boolean; + FDisCon: TControl; + FDisConI: Integer; + FMode: TJvConMode; + FShape: TJvConShape; + FConSize: Integer; + FConPos: TJvConPos; + FEdge: Extended; + + FFromLogic: TJvLogic; + FToLogic: TJvLogic; + FFromGate: Integer; + FToGate: Integer; + FFromPoint: TJvPointX; + FToPoint: TJvPointX; + procedure SetFromLogic(const Value: TJvLogic); + procedure SetToLogic(const Value: TJvLogic); + procedure SetFromGate(const Value: Integer); + procedure SetToGate(const Value: Integer); + procedure SetFromPoint(const Value: TJvPointX); + procedure SetToPoint(const Value: TJvPointX); + procedure DisconnectFinal; + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoMouseDown(X, Y: Integer); + procedure DoMouseMove(dx, dy: Integer); + procedure AnchorCorner(LogTL: TPoint; ACorner: TJvConMode); + procedure MoveConnector(LogTL: TPoint); + procedure Connect; + procedure Disconnect; + published + property FromLogic: TJvLogic read FFromLogic write SetFromLogic; + property FromGate: Integer read FFromGate write SetFromGate; + property FromPoint: TJvPointX read FFromPoint write SetFromPoint; + property ToLogic: TJvLogic read FToLogic write SetToLogic; + property ToGate: Integer read FToGate write SetToGate; + property ToPoint: TJvPointX read FToPoint write SetToPoint; + end; + + TJvLogicGates = array [0..5] of TJvGate; + + TJvLogic = class(TGraphicControl) + private + FDoMove: Boolean; + FDoStyle: Boolean; + FStyleDown: Boolean; + FMdp: TPoint; + FOldp: TPoint; + FGates: TJvLogicGates; + FConnectors: TList; + FNewLeft: Integer; + FNewTop: Integer; + FInput1: Boolean; + FInput2: Boolean; + FInput3: Boolean; + FOutput1: Boolean; + FOutput2: Boolean; + FOutput3: Boolean; + FLogicFunc: TJvLogicFunc; + function GetGate(Index: Integer): TJvGate; + procedure AnchorConnectors; + procedure MoveConnectors; + procedure PaintLed(Index: Integer); + procedure SetInput1(const Value: Boolean); + procedure SetInput2(const Value: Boolean); + procedure SetInput3(const Value: Boolean); + procedure SetOutput1(const Value: Boolean); + procedure SetOutput2(const Value: Boolean); + procedure SetOutput3(const Value: Boolean); + procedure SetLogicFunc(const Value: TJvLogicFunc); + procedure OutCalc; + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + property Gates[Index: Integer]: TJvGate read GetGate; + published + property Input1: Boolean read FInput1 write SetInput1; + property Input2: Boolean read FInput2 write SetInput2; + property Input3: Boolean read FInput3 write SetInput3; + property Output1: Boolean read FOutput1 write SetOutput1; + property Output2: Boolean read FOutput2 write SetOutput2; + property Output3: Boolean read FOutput3 write SetOutput3; + property LogicFunc: TJvLogicFunc read FLogicFunc write SetLogicFunc; + end; + + TJvSimReverseGates = array [0..3] of TJvGate; + + TJvSimReverse = class(TGraphicControl) + private + FDoMove: Boolean; + FMdp: TPoint; + FOldp: TPoint; + FGates: TJvSimReverseGates; + FConnectors: TList; + FNewLeft: Integer; + FNewTop: Integer; + FInput1: Boolean; + FOutput1: Boolean; + FOutput2: Boolean; + FOutput3: Boolean; + function GetGate(Index: Integer): TJvGate; + procedure AnchorConnectors; + procedure MoveConnectors; + procedure PaintLed(Index: Integer); + procedure SetInput1(const Value: Boolean); + procedure SetOutput1(const Value: Boolean); + procedure OutCalc; + procedure SetOutput2(const Value: Boolean); + procedure SetOutput3(const Value: Boolean); + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + property Gates[Index: Integer]: TJvGate read GetGate; + published + property Input1: Boolean read FInput1 write SetInput1; + property Output1: Boolean read FOutput1 write SetOutput1; + property Output2: Boolean read FOutput2 write SetOutput2; + property Output3: Boolean read FOutput3 write SetOutput3; + end; + + TJvSimButton = class(TGraphicControl) + private + FDoMove: Boolean; + FMdp: TPoint; + FOldp: TPoint; + FConnectors: TList; + FDown: Boolean; + FDepressed: Boolean; + FNewLeft: Integer; + FNewTop: Integer; + procedure AnchorConnectors; + procedure MoveConnectors; + procedure PaintLed(Pt: TPoint; Lit: Boolean); + procedure SetDown(const Value: Boolean); + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Down: Boolean read FDown write SetDown; + end; + + TJvSimLight = class(TGraphicControl) + private + FDoMove: Boolean; + FMdp: TPoint; + FOldp: TPoint; + FConnectors: TList; + FLit: Boolean; + FColorOn: TColor; + FColorOff: TColor; + FNewLeft: Integer; + FNewTop: Integer; + procedure AnchorConnectors; + procedure MoveConnectors; + procedure SetLit(const Value: Boolean); + procedure SetColorOff(const Value: TColor); + procedure SetColorOn(const Value: TColor); + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Lit: Boolean read FLit write SetLit; + property ColorOn: TColor read FColorOn write SetColorOn; + property ColorOff: TColor read FColorOff write SetColorOff; + end; + + TJvSimBin = class(TGraphicControl) + private + FBmpBin: TBitmap; + protected + procedure Resize; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + end; + + TJvSimLogicBox = class(TGraphicControl) + private + FCpu: TTimer; + FBmpCon: TBitmap; + FRCon: TRect; + FDCon: Boolean; + FBmpLogic: TBitmap; + FRLogic: TRect; + FDLogic: Boolean; + FBmpButton: TBitmap; + FRButton: TRect; + FDButton: Boolean; + FBmpLight: TBitmap; + FRLight: TRect; + FDLight: Boolean; + FBmpRev: TBitmap; + FRRev: TRect; + FDRev: Boolean; + FBmpBin: TBitmap; + procedure CpuOnTimer(Sender: TObject); + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure Resize; override; + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + end; + + +implementation + +uses + JvJVCLUtils; + +{$R ..\..\resource\JvSimImages.res} + +// general bin procedure + +procedure BinCheck(AControl: TControl); +var + Wc: TWinControl; + I: Integer; + R, Rb: TRect; + Keep: Boolean; +begin + // check for TJvSimLogicBox + Wc := AControl.Parent; + R := AControl.BoundsRect; + Keep := False; + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSimLogicBox then + begin + Rb := Wc.Controls[I].BoundsRect; + Rb.Left := Rb.Right - 32; + if PtInRect(Rb, Point(R.Left, R.Top)) then + Break + else + if PtInRect(Rb, Point(R.Right, R.Top)) then + Break + else + if PtInRect(Rb, Point(R.Right, R.Bottom)) then + Break + else + if PtInRect(Rb, Point(R.Left, R.Bottom)) then + Break + else + Keep := True; + end; + if not Keep then + AControl.Free; +end; + +//=== { TJvPointX } ========================================================== + +procedure TJvPointX.Assign(Source: TPersistent); +begin + if Source is TJvPointX then + begin + FX := TJvPointX(Source).X; + FY := TJvPointX(Source).Y; + end + else + inherited Assign(Source); +end; + +function TJvPointX.Point: TPoint; +begin + Result.X := FX; + Result.Y := FY; +end; + +procedure TJvPointX.SetPoint(const Pt: TPoint); +begin + FX := Pt.X; + FY := Pt.Y; +end; + +//=== { TJvSIMConnector } ==================================================== + +constructor TJvSIMConnector.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 100; + Height := 50; + FMode := jcmTL; + FShape := jcsTLBR; + FConSize := 8; + FConPos := jcpTL; + FEdge := 0.5; + FFromPoint := TJvPointX.Create; + FToPoint := TJvPointX.Create; +end; + +destructor TJvSIMConnector.Destroy; +begin + FFromPoint.Free; + FToPoint.Free; + inherited Destroy; +end; + +procedure TJvSIMConnector.DoMouseDown(X, Y: Integer); +var + P: TPoint; + Rtl, Rbr, Rtr, Rbl: TRect; + D: Integer; +begin + FDoMove := False; + FDoEdge := False; + D := FConSize; + FOldp := Point(X, Y); + Rtl := Rect(0, 0, D, D); + Rbr := Rect(Width - 1 - D, Height - 1 - D, Width - 1, Height - 1); + Rtr := Rect(Width - 1 - D, 0, Width - 1, D); + Rbl := Rect(0, Height - 1 - D, D, Height - 1); + P := Point(X, Y); + if PtInRect(Rtl, P) and (FShape = jcsTLBR) then + begin + FMode := jcmTL; + FMdp := Point(X, Y); + end + else + if PtInRect(Rtr, P) and (FShape = jcsTRBL) then + begin + FMode := jcmTR; + FMdp := Point(Width - X, Y); + end + else + if PtInRect(Rbr, P) and (FShape = jcsTLBR) then + begin + FMode := jcmBR; + FMdp := Point(Width - X, Height - Y); + end + else + if PtInRect(Rbl, P) and (FShape = jcsTRBL) then + begin + FMode := jcmBL; + FMdp := Point(X, Height - Y); + end + else + if Abs(X - Round(FEdge * Width)) < 10 then + FDoEdge := True + else + begin + FDoMove := True; + FMdp := Point(X, Y); + SetFromLogic(nil); + SetToLogic(nil); + end; + if not FDoEdge then + Disconnect; +end; + +procedure TJvSIMConnector.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + DoMouseDown(X, Y); +end; + +procedure TJvSIMConnector.DoMouseMove(dx, dy: Integer); +var + P: TPoint; + D, d2, nw, nh: Integer; + X, Y: Integer; +begin + X := dx + FOldp.X; + Y := dy + FOldp.Y; + FOldp := Point(X, Y); + P := ClientToScreen(Point(X, Y)); + P := Parent.ScreenToClient(P); + D := FConSize; + d2 := D div 2; + if FDoEdge then + begin + FEdge := X / Width; + Invalidate; + end + else + if FDoMove then + begin + Left := P.X - FMdp.X; + Top := P.Y - FMdp.Y; + end + else + begin + case FMode of + jcmTL: + begin + Left := P.X - FMdp.X; + Top := P.Y - FMdp.Y; + nw := Width + (FMdp.X - X); + if nw < d2 then + begin + Left := Left + nw - D; + Width := -nw + D + D; + FMode := jcmTR; + FShape := jcsTRBL; + case FConPos of + jcpTL: + FConPos := jcpTR; + jcpBR: + FConPos := jcpBL; + end; + FEdge := 1 - FEdge; + end + else + Width := nw; + nh := Height + (FMdp.Y - Y); + if nh < d2 then + begin + Top := Top + nh - D; + Height := -nh + D + D; + FMode := jcmBL; + FShape := jcsTRBL; + case FConPos of + jcpTL: + FConPos := jcpBL; + jcpBR: + FConPos := jcpTR; + end; + end + else + Height := nh; + end; + jcmTR: + begin + Top := P.Y - FMdp.Y; + nw := X + FMdp.X; + if nw < d2 then + begin + Left := Left + nw - D; + Width := -nw + D + D; + FMode := jcmTL; + FShape := jcsTLBR; + case FConPos of + jcpTR: + FConPos := jcpTL; + jcpBL: + FConPos := jcpBR; + end; + FEdge := 1 - FEdge; + end + else + Width := nw; + nh := Height + (FMdp.Y - Y); + if nh < d2 then + begin + Top := Top + nh - D; + Height := -nh + D + D; + FMode := jcmBR; + FShape := jcsTLBR; + case FConPos of + jcpTR: + FConPos := jcpBR; + jcpBL: + FConPos := jcpTL; + end; + end + else + Height := nh; + end; + jcmBR: + begin + nw := X + FMdp.X; + if nw < d2 then + begin + Left := Left + nw - D; + Width := -nw + D + D; + FMode := jcmBL; + FShape := jcsTRBL; + case FConPos of + jcpBR: + FConPos := jcpBL; + jcpTL: + FConPos := jcpTR; + end; + FEdge := 1 - FEdge; + end + else + Width := nw; + nh := Y + FMdp.Y; + if nh < d2 then + begin + Top := Top + nh - D; + Height := -nh + D + D; + FMode := jcmTR; + FShape := jcsTRBL; + case FConPos of + jcpBR: + FConPos := jcpTR; + jcpTL: + FConPos := jcpBL; + end; + end + else + Height := nh; + end; + jcmBL: + begin + Left := P.X - FMdp.X; + nw := Width + (FMdp.X - X); + if nw < d2 then + begin + Left := Left + nw - D; + Width := -nw + D + D; + FMode := jcmBR; + FShape := jcsTLBR; + case FConPos of + jcpBL: + FConPos := jcpBR; + jcpTR: + FConPos := jcpTL; + end; + FEdge := 1 - FEdge; + end + else + Width := nw; + nh := Y + FMdp.Y; + if nh < d2 then + begin + Top := Top + nh - D; + Height := -nh + D + D; + FMode := jcmTL; + FShape := jcsTLBR; + case FConPos of + jcpBL: + FConPos := jcpTL; + jcpTR: + FConPos := jcpBR; + end; + end + else + Height := nh; + end; + end; + end; +end; + +procedure TJvSIMConnector.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + if ssLeft in Shift then + DoMouseMove(X - FOldp.X, Y - FOldp.Y); +end; + +procedure TJvSIMConnector.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if not FDoEdge then + DisconnectFinal; + BinCheck(Self); +end; + +procedure TJvSIMConnector.DisconnectFinal; +begin + if FDisCon = nil then + Exit; + if FDisCon is TJvSimLight then + TJvSimLight(FDisCon).Lit := False + else + if FDisCon is TJvLogic then + begin + if FDisConI = 1 then + TJvLogic(FDisCon).Input1 := False + else + if FDisConI = 2 then + TJvLogic(FDisCon).Input2 := False + else + if FDisConI = 3 then + TJvLogic(FDisCon).Input3 := False + end; +end; + +procedure TJvSIMConnector.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) then + if (AComponent = FromLogic) then + FromLogic := nil + else if (AComponent = ToLogic) then + ToLogic := nil; +end; + +procedure TJvSIMConnector.Paint; +var + D, d2, w2, xw, yh: Integer; +begin + D := FConSize; + d2 := D div 2; + w2 := Round(FEdge * Width); + xw := Width - 1; + yh := Height - 1; + + with Canvas do + begin + Brush.Color := clLime; + case FShape of + jcsTLBR: + // a connector is drawn depending in the FConPos + begin + // start new code + case FConPos of + jcpTL: // Draw regular connector + begin + MoveTo(D, d2); + LineTo(w2, d2); + LineTo(w2, yh - d2); + LineTo(xw - D, yh - d2); + Brush.Color := clRed; + Rectangle(0, 0, D, D); + Brush.Color := clLime; + Rectangle(xw - D, yh - D, xw, yh); + end; + jcpBR: + begin + MoveTo(D, d2); + LineTo(xw - d2, d2); + LineTo(xw - d2, yh - D); + Brush.Color := clLime; + Rectangle(0, 0, D, D); + Brush.Color := clRed; + Rectangle(xw - D, yh - D, xw, yh); + end; + end; + // end new code + { MoveTo(D,d2); + LineTo(w2,d2); + LineTo(w2,yh-d2); + LineTo(xw-D,yh-d2); + case FConPos of + jcpTL: Brush.Color:=clRed; + else Brush.Color:=clLime; + end; + Rectangle(0,0,D,D); + case FConPos of + jcpBR: Brush.Color:=clRed; + else Brush.Color:=clLime; + end; + Rectangle(xw-D,yh-D,xw,yh);} + end; + jcsTRBL: + begin + // start new code + case FConPos of + jcpTR: // Draw reverted connector + begin + MoveTo(xw - d2, D); + LineTo(xw - d2, yh - d2); + LineTo(D, yh - d2); + Brush.Color := clRed; + Rectangle(xw - D, 0, xw, D); + Brush.Color := clLime; + Rectangle(0, yh - D, D, yh); + end; + jcpBL: // Draw regular connector + begin + MoveTo(xw - D, d2); + LineTo(w2, d2); + LineTo(w2, yh - d2); + LineTo(D - 1, yh - d2); + Brush.Color := clLime; + Rectangle(xw - D, 0, xw, D); + Brush.Color := clRed; + Rectangle(0, yh - D, D, yh); + end; + end; + // end new code + { MoveTo(xw-D,d2); + LineTo(w2,d2); + LineTo(w2,yh-d2); + LineTo(D-1,yh-d2); + case FConPos of + jcpTR: Brush.Color:=clRed; + else Brush.Color:=clLime; + end; + Rectangle(xw-D,0,xw,D); + case FConPos of + jcpBL: Brush.Color:=clRed; + else Brush.Color:=clLime; + end; + Rectangle(0,yh-D,D,yh);} + end; + end; + end; +end; + +procedure TJvSIMConnector.SetFromGate(const Value: Integer); +begin + FFromGate := Value; +end; + +procedure TJvSIMConnector.SetFromLogic(const Value: TJvLogic); +begin + ReplaceComponentReference(Self, Value, TComponent(FFromLogic)); +end; + +procedure TJvSIMConnector.SetToGate(const Value: Integer); +begin + FToGate := Value; +end; + +procedure TJvSIMConnector.SetToLogic(const Value: TJvLogic); +begin + ReplaceComponentReference(Self, Value, TComponent(FToLogic)); +end; + +procedure TJvSIMConnector.SetFromPoint(const Value: TJvPointX); +begin + if Assigned(Value) then + FFromPoint.Assign(Value); +end; + +procedure TJvSIMConnector.SetToPoint(const Value: TJvPointX); +begin + if Assigned(Value) then + FToPoint.Assign(Value); +end; + +procedure TJvSIMConnector.AnchorCorner(LogTL: TPoint; ACorner: TJvConMode); +var + Rc: TRect; +begin + FConMode := ACorner; + Rc := BoundsRect; + FConHot := FConPos; + case ACorner of + jcmTL: + begin + FConOffset := Point(Rc.Left - LogTL.X, Rc.Top - LogTL.Y); + FConAnchor := Parent.ScreenToClient(ClientToScreen(Point(Width, Height))); + end; + jcmTR: + begin + FConOffset := Point(Rc.Right - LogTL.X, Rc.Top - LogTL.Y); + FConAnchor := Parent.ScreenToClient(ClientToScreen(Point(0, Height))); + end; + jcmBR: + begin + FConOffset := Point(Rc.Right - LogTL.X, Rc.Bottom - LogTL.Y); + FConAnchor := Parent.ScreenToClient(ClientToScreen(Point(0, 0))); + end; + jcmBL: + begin + FConOffset := Point(Rc.Left - LogTL.X, Rc.Bottom - LogTL.Y); + FConAnchor := Parent.ScreenToClient(ClientToScreen(Point(Width, 0))); + end; + end; +end; + +procedure TJvSIMConnector.MoveConnector(LogTL: TPoint); +var + nw, nh: Integer; + D: Integer; + nc: TPoint; +begin + D := FConSize; +// d2 := D div 2; + nc := Point(LogTL.X + FConOffset.X, LogTL.Y + FConOffset.Y); + case FConMode of + jcmTL: + begin + nw := FConAnchor.X - nc.X; + if nw < D then + begin + Left := FConAnchor.X - D; + Width := -nw + D + D; + end + else + begin + Left := nc.X; + Width := FConAnchor.X - Left; + end; + nh := FConAnchor.Y - nc.Y; + + // adjust new hot position + if (nw < D) and not (nh < D) then + begin + case FConHot of + jcpTL: + FConPos := jcpTR; + jcpBR: + FConPos := jcpBL; + end; + FShape := jcsTRBL; + end + else + if (nw < D) and (nh < D) then + begin + case FConHot of + jcpTL: + FConPos := jcpBR; + jcpBR: + FConPos := jcpTL; + end; + FShape := jcsTLBR; + end + else + if (not nw < D) and (nh < D) then + begin + case FConHot of + jcpTL: + FConPos := jcpBL; + jcpBR: + FConPos := jcpTR; + end; + FShape := jcsTRBL; + end + else + begin + case FConHot of + jcpTL: + FConPos := jcpTL; + jcpBR: + FConPos := jcpBR; + end; + FShape := jcsTLBR; + end; + // end of adjust TL new hot + if nh < D then + begin + Top := FConAnchor.Y - D; + Height := -nh + D + D; + end + else + begin + Top := nc.Y; + Height := FConAnchor.Y - Top; + end; + end; + jcmTR: + begin + nw := nc.X - FConAnchor.X; + if nw <= 0 then + begin + Left := FConAnchor.X + nw - D; + Width := -nw + D + D; + end + else + if nw <= D then + begin + Left := nc.X - D; + Width := -nw + D + D; + end + else + Width := nw; + nh := FConAnchor.Y - nc.Y; + // adjust TR new hot position + if (nw < D) and (not (nh < D)) then + begin + case FConHot of + jcpTR: + FConPos := jcpTL; + jcpBL: + FConPos := jcpBR; + end; + FShape := jcsTLBR; + end + else + if (nw < D) and (nh < D) then + begin + case FConHot of + jcpTR: + FConPos := jcpBL; + jcpBL: + FConPos := jcpTR; + end; + FShape := jcsTRBL; + end + else + if (not nw < D) and (nh < D) then + begin + case FConHot of + jcpTR: + FConPos := jcpBR; + jcpBL: + FConPos := jcpTL; + end; + FShape := jcsTLBR; + end + else + begin + case FConHot of + jcpTR: + FConPos := jcpTR; + jcpBL: + FConPos := jcpBL; + end; + FShape := jcsTRBL; + end; + // end of adjust TR new hot + if nh < D then + begin + Top := FConAnchor.Y - D; + Height := -nh + D + D; + end + else + begin + Top := FConAnchor.Y - nh; + Height := nh; + end; + end; + jcmBR: + begin + nw := nc.X - FConAnchor.X; + if nw <= 0 then + begin + Left := nc.X - D; + Width := -nw + D + D; + end + else + if nw <= D then + begin + Left := nc.X - D; + Width := -nw + D + D; + end + else + Width := nw; + nh := nc.Y - FConAnchor.Y; + // adjust BR new hot position + if (nw < D) and (not (nh < D)) then + begin + case FConHot of + jcpBR: + FConPos := jcpBL; + jcpTL: + FConPos := jcpTR; + end; + FShape := jcsTRBL; + end + else + if (nw < D) and (nh < D) then + begin + case FConHot of + jcpBR: + FConPos := jcpTL; + jcpTL: + FConPos := jcpBR; + end; + FShape := jcsTLBR; + end + else + if (not nw < D) and (nh < D) then + begin + case FConHot of + jcpBR: + FConPos := jcpTR; + jcpTL: + FConPos := jcpBL; + end; + FShape := jcsTRBL; + end + else + begin + case FConHot of + jcpBR: + FConPos := jcpBR; + jcpTL: + FConPos := jcpTL; + end; + FShape := jcsTLBR; + end; + // end of adjust BR new hot + if nh < D then + begin + Top := FConAnchor.Y + nh - D; + Height := -nh + D + D; + end + else + Height := nh; + end; + jcmBL: + begin + nw := FConAnchor.X - nc.X; + if nw < D then + begin + Left := FConAnchor.X - D; + Width := -nw + D + D; + end + else + begin + Left := FConAnchor.X - nw; + Width := nw; + end; + nh := nc.Y - FConAnchor.Y; + // adjust BL new hot position + if (nw < D) and (not (nh < D)) then + begin + case FConHot of + jcpBL: + FConPos := jcpBR; + jcpTR: + FConPos := jcpTL; + end; + FShape := jcsTLBR; + end + else + if (nw < D) and (nh < D) then + begin + case FConHot of + jcpBL: + FConPos := jcpTR; + jcpTR: + FConPos := jcpBL; + end; + FShape := jcsTRBL; + end + else + if (not nw < D) and (nh < D) then + begin + case FConHot of + jcpBL: + FConPos := jcpTL; + jcpTR: + FConPos := jcpBR; + end; + FShape := jcsTLBR; + end + else + begin + case FConHot of + jcpBL: + FConPos := jcpBL; + jcpTR: + FConPos := jcpTR; + end; + FShape := jcsTRBL; + end; + // end of adjust BL new hot + if nh < D then + begin + Top := FConAnchor.Y + nh - D; + Height := -nh + D + D; + end + else + Height := nh; + end; + end; +end; + +procedure TJvSIMConnector.Connect; +var + Pi, Po: TPoint; + R: TRect; + D, d2, xw, yh: Integer; + Wc: TWinControl; + Vi: Boolean; + sBut: TJvSimButton; + sLog: TJvLogic; + sLight: TJvSimLight; + sRev: TJvSimReverse; + pl: TPoint; + + // convert a corner point to a Parent point + + function ParentPoint(X, Y: Integer): TPoint; + var + P: TPoint; + begin + P := Point(X, Y); + P := ClientToScreen(P); + Result := Wc.ScreenToClient(P); + end; + + function GetVi: Boolean; + var + J: Integer; + begin + Result := True; + for J := 0 to Wc.ControlCount - 1 do + begin + if Wc.Controls[J] is TJvSimButton then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Pi) then + begin + sBut := TJvSimButton(Wc.Controls[J]); + Vi := sBut.Down; + Exit; + end; + end + else + if Wc.Controls[J] is TJvSimReverse then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, D); + if PtInRect(R, Pi) then + begin + sRev := TJvSimReverse(Wc.Controls[J]); + // now check if P is the output area + pl := sRev.Gates[1].Pos; + R := Rect(sRev.Left + pl.X, sRev.Top - D, sRev.Left + pl.X + 12, sRev.Top + pl.Y + 12); + if PtInRect(R, Pi) and sRev.Gates[1].Active then + begin // output + Vi := sRev.Output1; + Exit; + end; + pl := sRev.Gates[2].Pos; + R := Rect(sRev.Left - D, sRev.Top + pl.Y, sRev.Left + pl.X + 12, sRev.Top + pl.Y + 12); + if PtInRect(R, Pi) and sRev.Gates[2].Active then + begin // output + Vi := sRev.Output2; + Exit; + end; + pl := sRev.Gates[3].Pos; + R := Rect(sRev.Left + pl.X, sRev.Top + pl.Y, sRev.Left + pl.X + 12, sRev.Top + sRev.Height + D); + if PtInRect(R, Pi) and sRev.Gates[3].Active then + begin // output + Vi := sRev.Output3; + Exit; + end; + end; + end + else + if Wc.Controls[J] is TJvLogic then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Pi) then + begin + sLog := TJvLogic(Wc.Controls[J]); + // now check if P is in one of the 3 output area's + R := Rect(sLog.Left + 33, sLog.Top, sLog.Left + sLog.Width + FConSize, sLog.Top + 22); + if PtInRect(R, Pi) and sLog.Gates[3].Active then + begin // output is gate 3 + Vi := sLog.Output1; + Exit; + end; + R := Rect(sLog.Left + 33, sLog.Top + 23, sLog.Left + sLog.Width + FConSize, sLog.Top + 44); + if PtInRect(R, Pi) and sLog.Gates[4].Active then + begin // output is gate 4 + Vi := sLog.Output2; + Exit; + end; + R := Rect(sLog.Left + 33, sLog.Top + 45, sLog.Left + sLog.Width + FConSize, sLog.Top + 64); + if PtInRect(R, Pi) and sLog.Gates[5].Active then + begin // output is gate 5 + Vi := sLog.Output3; + Exit; + end; + end; + end; + end; + Result := False; + end; + + procedure SetVo; + var + J: Integer; + begin + for J := 0 to Wc.ControlCount - 1 do + begin + if (Wc.Controls[J] is TJvSimLight) then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Po) then + begin + sLight := TJvSimLight(Wc.Controls[J]); + sLight.Lit := Vi; + Exit; + end; + end + else + if Wc.Controls[J] is TJvSimReverse then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Po) then + begin + sRev := TJvSimReverse(Wc.Controls[J]); + // now check if P is in the input area + pl := sRev.Gates[0].Pos; + R := Rect(sRev.Left + pl.X, sRev.Top + pl.Y, sRev.Left + sRev.Width + D, sRev.Top + pl.Y + 12); + if PtInRect(R, Po) and sRev.Gates[0].Active then + begin // input + sRev.Input1 := Vi; + Exit; + end; + end; + end + else + if Wc.Controls[J] is TJvLogic then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Po) then + begin + sLog := TJvLogic(Wc.Controls[J]); + // now check if P is in one of the 3 input area's + R := Rect(sLog.Left - D, sLog.Top, sLog.Left + 32, sLog.Top + 22); + if PtInRect(R, Po) and sLog.Gates[0].Active then + begin // input is gate 0 + sLog.Input1 := Vi; + Exit; + end; + R := Rect(sLog.Left - D, sLog.Top + 23, sLog.Left + 32, sLog.Top + 44); + if PtInRect(R, Po) and sLog.Gates[1].Active then + begin // input is gate 1 + sLog.Input2 := Vi; + Exit; + end; + R := Rect(sLog.Left - D, sLog.Top + 45, sLog.Left + 32, sLog.Top + 64); + if PtInRect(R, Po) and sLog.Gates[2].Active then + begin // input is gate 2 + sLog.Input3 := Vi; + Exit; + end; + end; + end; + end; + end; + +begin + // connect input and output using the FConPos + d2 := FConSize div 2; + D := FConSize; + xw := Width - 1; + yh := Height - 1; + Wc := Parent; + case FConPos of + jcpTL: + begin + Pi := ParentPoint(d2, d2); + Po := ParentPoint(xw - d2, yh - d2); + end; + jcpTR: + begin + Pi := ParentPoint(xw - d2, d2); + Po := ParentPoint(d2, yh - d2); + end; + jcpBR: + begin + Pi := ParentPoint(xw - d2, yh - d2); + Po := ParentPoint(d2, d2); + end; + jcpBL: + begin + Pi := ParentPoint(d2, yh - d2); + Po := ParentPoint(xw - d2, d2); + end; + end; + // get input Vi + if GetVi then + SetVo; +end; + +procedure TJvSIMConnector.Disconnect; +var + Pi, Po: TPoint; + R: TRect; + D, d2, xw, yh: Integer; + Wc: TWinControl; + sLog: TJvLogic; + sLight: TJvSimLight; + + // convert a corner point to a Parent point + + function ParentPoint(X, Y: Integer): TPoint; + var + P: TPoint; + begin + P := Point(X, Y); + P := ClientToScreen(P); + Result := Wc.ScreenToClient(P); + end; + + procedure SetVo; + var + J: Integer; + begin + for J := 0 to Wc.ControlCount - 1 do + begin + if Wc.Controls[J] is TJvSimLight then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Po) then + begin + sLight := TJvSimLight(Wc.Controls[J]); + FDisCon := sLight; + //sLight.Lit:=False; + Exit; + end; + end + else + if Wc.Controls[J] is TJvLogic then + begin + R := Wc.Controls[J].BoundsRect; + InflateRect(R, D, 0); + if PtInRect(R, Po) then + begin + sLog := TJvLogic(Wc.Controls[J]); + // now check if P is in one of the 3 input area's + R := Rect(sLog.Left - D, sLog.Top, sLog.Left + 32, sLog.Top + 22); + if PtInRect(R, Po) and sLog.Gates[0].Active then + begin // input is gate 0 + FDisCon := sLog; + FDisConI := 1; + // sLog.Input1:=False; + Exit; + end; + R := Rect(sLog.Left - D, sLog.Top + 23, sLog.Left + 32, sLog.Top + 44); + if PtInRect(R, Po) and sLog.Gates[1].Active then + begin // input is gate 1 + FDisCon := sLog; + FDisConI := 2; + // sLog.Input2:=False; + Exit; + end; + R := Rect(sLog.Left - D, sLog.Top + 45, sLog.Left + 32, sLog.Top + 64); + if PtInRect(R, Po) and sLog.Gates[2].Active then + begin // input is gate 2 + FDisCon := sLog; + FDisConI := 3; + // sLog.Input3:=False; + Exit; + end; + end; + end; + end; + end; + +begin + // connect input and output using the FConPos + FDisCon := nil; + FDisConI := 0; + d2 := FConSize div 2; + D := FConSize; + xw := Width - 1; + yh := Height - 1; + Wc := Parent; + case FConPos of + jcpTL: + begin + Pi := ParentPoint(d2, d2); + Po := ParentPoint(xw - d2, yh - d2); + end; + jcpTR: + begin + Pi := ParentPoint(xw - d2, d2); + Po := ParentPoint(d2, yh - d2); + end; + jcpBR: + begin + Pi := ParentPoint(xw - d2, yh - d2); + Po := ParentPoint(d2, d2); + end; + jcpBL: + begin + Pi := ParentPoint(d2, yh - d2); + Po := ParentPoint(xw - d2, d2); + end; + end; + // clear logic inputs and lights + SetVo; +end; + +//=== { TJvLogic } =========================================================== + +constructor TJvLogic.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited Create(AOwner); + Width := 65; + Height := 65; + // initialize Gates + FGates[0].Pos := Point(1, 10); + FGates[1].Pos := Point(1, 28); + FGates[2].Pos := Point(1, 46); + FGates[3].Pos := Point(52, 10); + FGates[4].Pos := Point(52, 28); + FGates[5].Pos := Point(52, 46); + for I := 0 to 5 do + FGates[I].State := False; + for I := 0 to 2 do + begin + FGates[I].Style := jgsDI; + FGates[I + 3].Style := jgsDO; + end; + FLogicFunc := jlfAND; + FGates[0].Active := True; + FGates[1].Active := False; + FGates[2].Active := True; + FGates[3].Active := False; + FGates[4].Active := True; + FGates[5].Active := False; + FConnectors := TList.Create; +end; + +destructor TJvLogic.Destroy; +begin + FConnectors.Free; + inherited Destroy; +end; + +function TJvLogic.GetGate(Index: Integer): TJvGate; +begin + Result := FGates[Index]; +end; + +procedure TJvLogic.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; +begin + FDoMove := False; + FDoStyle := False; + FStyleDown := False; + FMdp := Point(X, Y); + R := ClientRect; + InflateRect(R, -15, -15); + FDoStyle := PtInRect(R, FMdp); + FDoMove := not FDoStyle; + FOldp := Point(X, Y); + if FDoMove then + AnchorConnectors; + if FDoStyle then + begin + FStyleDown := True; + Invalidate; + end; +end; + +procedure TJvLogic.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + P := ClientToScreen(Point(X, Y)); + P := Parent.ScreenToClient(P); + if ssLeft in Shift then + begin + if FDoMove then + begin + FNewLeft := P.X - FMdp.X; + FNewTop := P.Y - FMdp.Y; + MoveConnectors; + Left := FNewLeft; + Top := FNewTop; + end + end; +end; + +procedure TJvLogic.AnchorConnectors; +var + Wc: TWinControl; + I: Integer; + Con: TJvSIMConnector; + R, Rc: TRect; + P: TPoint; +begin + Wc := Parent; + FConnectors.Clear; + R := BoundsRect; + InflateRect(R, 8, 0); + P := Point(Left, Top); + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSIMConnector then + begin + Con := TJvSIMConnector(Wc.Controls[I]); + // check for corners in bounds + Rc := Con.BoundsRect; + // TL + if PtInRect(R, Point(Rc.Left, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTL); + end + // TR + else + if PtInRect(R, Point(Rc.Right, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTR); + end + // BR + else + if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBR); + end + // BL + else + if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBL); + end + end; +end; + +procedure TJvLogic.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FStyleDown := False; + if FDoStyle then + begin + FDoStyle := False; + case FLogicFunc of + jlfAND: + LogicFunc := jlfOR; + jlfOR: + LogicFunc := jlfNOT; + jlfNOT: + LogicFunc := jlfAND; + end; + end; + BinCheck(Self); +end; + +procedure TJvLogic.PaintLed(Index: Integer); +var + SurfCol, LitCol: TColor; + P: TPoint; + X, Y: Integer; + Lit: Boolean; +begin + if not Gates[Index].Active then + Exit; + P := Gates[Index].Pos; + X := P.X; + Y := P.Y; + if Index = 0 then + Lit := FInput1 + else + if Index = 1 then + Lit := FInput2 + else + if Index = 2 then + Lit := FInput3 + else + if Index = 3 then + Lit := FOutput1 + else + if Index = 4 then + Lit := FOutput2 + else + if Index = 5 then + Lit := FOutput3 + else + Lit := False; + if Lit then + begin + if Gates[Index].Style = jgsDI then + SurfCol := clLime + else + SurfCol := clRed; + LitCol := clWhite; + end + else + begin + if Gates[Index].Style = jgsDI then + begin + SurfCol := clGreen; + LitCol := clLime; + end + else + begin + SurfCol := clMaroon; + LitCol := clRed; + end; + end; + with Canvas do + begin + Brush.Color := clSilver; + FillRect(Rect(X, Y, X + 12, Y + 13)); + Brush.Style := bsClear; + Pen.Color := clGray; + Ellipse(X, Y, X + 12, Y + 13); + Pen.Color := clBlack; + Brush.Color := SurfCol; + Ellipse(X + 1, Y + 1, X + 11, Y + 12); + Pen.Color := clWhite; + Arc(X + 1, Y + 1, X + 11, Y + 12, X + 0, Y + 12, X + 12, Y + 0); + Pen.Color := LitCol; + Arc(X + 3, Y + 3, X + 8, Y + 9, X + 5, Y + 0, X + 0, Y + 8); + end; +end; + +procedure TJvLogic.Paint; +var + I: Integer; + R: TRect; + S: string; + ts: TTextStyle; +begin + with Canvas do + begin + Brush.Color := clSilver; + R := ClientRect; + FillRect(R); + Frame3D(R, clBtnHighlight, clBtnShadow, 1); + // Frame3D(Canvas,R,clBtnShadow,clBtnHighlight,1); + Brush.Color := clRed; + for I := 0 to 5 do + PaintLed(I); + R := ClientRect; + InflateRect(R, -15, -15); + if FStyleDown then + Frame3D(R, clBtnShadow, clBtnHighlight, 1) + else + Frame3D(R, clBtnHighlight, clBtnShadow, 1); + // Draw caption + case FLogicFunc of + jlfAND: + S := 'AND'; // do not localize + jlfOR: + S := 'OR'; // do not localize + jlfNOT: + S := 'NOT'; // do not localize + end; + Brush.Style := bsClear; + ts := TextStyle; + ts.Alignment := taCenter; + ts.Layout := tlCenter; + TextRect(R, R.Left, R.Top, S, ts); +// DrawText(Canvas.handle, PChar(S), -1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER); + end; +end; + +procedure TJvLogic.Resize; +begin + Width := 65; + Height := 65; +end; + +procedure TJvLogic.MoveConnectors; +var + I: Integer; + Con: TJvSIMConnector; +begin + for I := 0 to FConnectors.Count - 1 do + begin + Con := TJvSIMConnector(FConnectors[I]); + Con.MoveConnector(Point(FNewLeft, FNewTop)); + end; +end; + +procedure TJvLogic.OutCalc; +begin + case FLogicFunc of + jlfAND: + Output2 := Input1 and Input3; + jlfOR: + Output2 := Input1 or Input3; + jlfNOT: + Output2 := not Input2; + end; + +end; + +procedure TJvLogic.SetInput1(const Value: Boolean); +begin + if Value <> FInput1 then + begin + FInput1 := Value; + Invalidate; + OutCalc; + end; +end; + +procedure TJvLogic.SetInput2(const Value: Boolean); +begin + if Value <> FInput2 then + begin + FInput2 := Value; + Invalidate; + OutCalc; + end; +end; + +procedure TJvLogic.SetInput3(const Value: Boolean); +begin + if Value <> FInput3 then + begin + FInput3 := Value; + Invalidate; + OutCalc; + end; +end; + +procedure TJvLogic.SetOutput1(const Value: Boolean); +begin + if Value <> FOutput1 then + begin + FOutput1 := Value; + Invalidate; + end; +end; + +procedure TJvLogic.SetOutput2(const Value: Boolean); +begin + if Value <> FOutput2 then + begin + FOutput2 := Value; + Invalidate; + end; +end; + +procedure TJvLogic.SetOutput3(const Value: Boolean); +begin + if Value <> FOutput3 then + begin + FOutput3 := Value; + Invalidate; + end; +end; + +procedure TJvLogic.SetLogicFunc(const Value: TJvLogicFunc); +begin + if Value <> FLogicFunc then + begin + FLogicFunc := Value; + case FLogicFunc of + jlfAND: + begin + FGates[0].Active := True; + FGates[1].Active := False; + FGates[2].Active := True; + FGates[3].Active := False; + FGates[4].Active := True; + FGates[5].Active := False; + end; + jlfOR: + begin + FGates[0].Active := True; + FGates[1].Active := False; + FGates[2].Active := True; + FGates[3].Active := False; + FGates[4].Active := True; + FGates[5].Active := False; + end; + jlfNOT: + begin + FGates[0].Active := False; + FGates[1].Active := True; + FGates[2].Active := False; + FGates[3].Active := False; + FGates[4].Active := True; + FGates[5].Active := False; + end; + end; + Invalidate; + OutCalc; + end; +end; + +//=== { TJvSimButton } ======================================================= + +constructor TJvSimButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDown := False; + Width := 65; + Height := 65; + FConnectors := TList.Create; +end; + +destructor TJvSimButton.Destroy; +begin + FConnectors.Free; + inherited Destroy; +end; + +procedure TJvSimButton.AnchorConnectors; +var + Wc: TWinControl; + I: Integer; + Con: TJvSIMConnector; + R, Rc: TRect; + P: TPoint; +begin + Wc := Parent; + FConnectors.Clear; + R := BoundsRect; + InflateRect(R, 8, 8); + P := Point(Left, Top); + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSIMConnector then + begin + Con := TJvSIMConnector(Wc.Controls[I]); + // check for corners in bounds + Rc := Con.BoundsRect; + // TL + if PtInRect(R, Point(Rc.Left, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTL); + end + // TR + else + if PtInRect(R, Point(Rc.Right, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTR); + end + // BR + else + if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBR); + end + // BL + else + if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBL); + end + end; +end; + +procedure TJvSimButton.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; +begin + FMdp := Point(X, Y); + R := ClientRect; + InflateRect(R, -15, -15); + FDoMove := not PtInRect(R, FMdp); + FDepressed := not FDoMove; + FOldp := Point(X, Y); + if FDoMove then + AnchorConnectors + else + Invalidate; +end; + +procedure TJvSimButton.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + if FDepressed then + Exit; + P := ClientToScreen(Point(X, Y)); + P := Parent.ScreenToClient(P); + if ssLeft in Shift then + begin + if FDoMove then + begin + FNewLeft := P.X - FMdp.X; + FNewTop := P.Y - FMdp.Y; + MoveConnectors; + Left := FNewLeft; + Top := FNewTop; + end + end; +end; + +procedure TJvSimButton.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; + P: TPoint; +begin + FDepressed := False; + P := Point(X, Y); + R := ClientRect; + InflateRect(R, -15, -15); + if PtInRect(R, P) then + begin + Down := not FDown; + end + else + BinCheck(Self); +end; + +procedure TJvSimButton.MoveConnectors; +var + I: Integer; + Con: TJvSIMConnector; +begin + for I := 0 to FConnectors.Count - 1 do + begin + Con := TJvSIMConnector(FConnectors[I]); + Con.MoveConnector(Point(FNewLeft, FNewTop)); + end; +end; + +procedure TJvSimButton.Paint; +var + P: TPoint; + R: TRect; +begin + with Canvas do + begin + Brush.Color := clSilver; + R := ClientRect; + FillRect(R); + Frame3D(R, clBtnHighlight, clBtnShadow, 1); + InflateRect(R, -15, -15); + if FDepressed or FDown then + Frame3D(R, clBtnShadow, clBtnHighlight, 1) + else + Frame3D(R, clBtnHighlight, clBtnShadow, 1); + P := Point((Self.Width div 2) - 6, (Self.Height div 2) - 6); + PaintLed(P, FDown); + end; +end; + +procedure TJvSimButton.PaintLed(Pt: TPoint; Lit: Boolean); +var + SurfCol, LitCol: TColor; + X, Y: Integer; +begin + X := Pt.X; + Y := Pt.Y; + if Lit then + begin + SurfCol := clRed; + LitCol := clWhite + end + else + begin + SurfCol := clMaroon; + LitCol := clRed; + end; + with Canvas do + begin + Brush.Style := bsSolid; + Brush.Color := clSilver; + FillRect(Rect(X, Y, X + 12, Y + 13)); + Brush.Style := bsClear; + Pen.Color := clGray; + Ellipse(X, Y, X + 12, Y + 13); + Pen.Color := clBlack; + Brush.Color := SurfCol; + Ellipse(X + 1, Y + 1, X + 11, Y + 12); + Pen.Color := clWhite; + Arc(X + 1, Y + 1, X + 11, Y + 12, X + 0, Y + 12, X + 12, Y + 0); + Pen.Color := LitCol; + Arc(X + 3, Y + 3, X + 8, Y + 9, X + 5, Y + 0, X + 0, Y + 8); + end; +end; + +procedure TJvSimButton.Resize; +begin + Width := 65; + Height := 65; +end; + +procedure TJvSimButton.SetDown(const Value: Boolean); +begin + if Value <> FDown then + begin + FDown := Value; + FDepressed := Value; + Invalidate; + end; +end; + +//=== { TJvSimLight } ======================================================== + +constructor TJvSimLight.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FLit := False; + Width := 65; + Height := 65; + FColorOn := clLime; + FColorOff := clGreen; + FConnectors := TList.Create; +end; + +destructor TJvSimLight.Destroy; +begin + FConnectors.Free; + inherited Destroy; +end; + +procedure TJvSimLight.AnchorConnectors; +var + Wc: TWinControl; + I: Integer; + Con: TJvSIMConnector; + R, Rc: TRect; + P: TPoint; +begin + Wc := Parent; + FConnectors.Clear; + R := BoundsRect; + InflateRect(R, 8, 8); + P := Point(Left, Top); + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSIMConnector then + begin + Con := TJvSIMConnector(Wc.Controls[I]); + // check for corners in bounds + Rc := Con.BoundsRect; + // TL + if PtInRect(R, Point(Rc.Left, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTL); + end + // TR + else + if PtInRect(R, Point(Rc.Right, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTR); + end + // BR + else + if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBR); + end + // BL + else + if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBL); + end + end; +end; + +procedure TJvSimLight.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FMdp := Point(X, Y); + FDoMove := True; + FOldp := Point(X, Y); + AnchorConnectors; +end; + +procedure TJvSimLight.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + P := ClientToScreen(Point(X, Y)); + P := Parent.ScreenToClient(P); + if ssLeft in Shift then + begin + if FDoMove then + begin + FNewLeft := P.X - FMdp.X; + FNewTop := P.Y - FMdp.Y; + MoveConnectors; + Left := FNewLeft; + Top := FNewTop; + end + end; +end; + +procedure TJvSimLight.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + BinCheck(Self); +end; + +procedure TJvSimLight.MoveConnectors; +var + I: Integer; + Con: TJvSIMConnector; +begin + for I := 0 to FConnectors.Count - 1 do + begin + Con := TJvSIMConnector(FConnectors[I]); + Con.MoveConnector(Point(FNewLeft, FNewTop)); + end; +end; + +procedure TJvSimLight.Paint; +var + TlPoly, BrPoly: array [0..2] of TPoint; + xw, yh: Integer; + R: TRect; + HiColor, LoColor, SurfCol: TColor; + + procedure DrawFrame; + begin + // rgn := CreatePolygonRgn(TlPoly,3,WINDING); + // SelectClipRgn(Canvas.handle,rgn); + with Canvas do + begin + Brush.Color := SurfCol; + Pen.Color := HiColor; + Pen.Width := 2; + Ellipse(15, 15, xw - 15, yh - 15); + end; + // SelectClipRgn(Canvas.handle,0); + // DeleteObject(rgn); + // rgn := CreatePolygonRgn(BrPoly,3,WINDING); + // SelectClipRgn(Canvas.handle,rgn); + with Canvas do + begin + Brush.Color := SurfCol; + Pen.Color := LoColor; + Pen.Width := 2; + Arc(15, 15, xw - 15, yh - 15, 0, yh, xw, 0); + Pen.Width := 1; + end; + // SelectClipRgn(Canvas.handle,0); + // DeleteObject(rgn); + end; + +begin + if Lit then + SurfCol := ColorOn + else + SurfCol := ColorOff; + Canvas.Brush.Style := bsSolid; + R := ClientRect; + Canvas.Brush.Color := clSilver; + Canvas.FillRect(R); + Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1); + xw := Width - 1; + yh := Height - 1; +// cr := Width div 4; +// x4 := Width div 4; + // topleft region + TlPoly[0] := Point(Left, Top + yh); + TlPoly[1] := Point(Left, Top); + TlPoly[2] := Point(Left + xw, Top); + // Bottom Right region + BrPoly[0] := Point(Left + xw, Top); + BrPoly[1] := Point(Left + xw, Top + yh); + BrPoly[2] := Point(Left, Top + yh); + Canvas.Pen.Style := psSolid; + HiColor := clBtnHighlight; + LoColor := clBtnShadow; + DrawFrame; +end; + +procedure TJvSimLight.Resize; +begin + Width := 65; + Height := 65; +end; + +procedure TJvSimLight.SetLit(const Value: Boolean); +begin + if Value <> FLit then + begin + FLit := Value; + Invalidate; + end; +end; + +procedure TJvSimLight.SetColorOff(const Value: TColor); +begin + if Value <> FColorOff then + begin + FColorOff := Value; + Invalidate; + end; +end; + +procedure TJvSimLight.SetColorOn(const Value: TColor); +begin + if Value <> FColorOn then + begin + FColorOn := Value; + Invalidate; + end; +end; + +//=== { TJvSimBin } ========================================================== + +constructor TJvSimBin.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 65; + Height := 65; + FBmpBin := TBitmap.Create; + FBmpBin.LoadFromResourceName(HInstance, 'JvSimLogicBoxBIN'); // do not localize +end; + +destructor TJvSimBin.Destroy; +begin + FBmpBin.Free; + inherited Destroy; +end; + +procedure TJvSimBin.Paint; +var + Rf: TRect; +begin + Rf := ClientRect; + Canvas.Brush.Color := clSilver; + Canvas.FillRect(Rect(0, 0, Width, Height)); + Frame3D(Canvas, Rf, clBtnHighlight, clBtnShadow, 1); + Canvas.Draw(16, 16, FBmpBin); +end; + +procedure TJvSimBin.Resize; +begin + inherited Resize; + Width := 65; + Height := 65; +end; + +//=== { TJvSimLogicBox } ===================================================== + +constructor TJvSimLogicBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 130; + Height := 65; + FBmpCon := TBitmap.Create; + FBmpLogic := TBitmap.Create; + FBmpButton := TBitmap.Create; + FBmpLight := TBitmap.Create; + FBmpRev := TBitmap.Create; + FBmpBin := TBitmap.Create; + FBmpCon.LoadFromResourceName(HInstance, 'JvSimLogicBoxCON'); // do not localize + FBmpLogic.LoadFromResourceName(HInstance, 'JvSimLogicBoxLOGIC'); // do not localize + FBmpButton.LoadFromResourceName(HInstance, 'JvSimLogicBoxBUTTON'); // do not localize + FBmpLight.LoadFromResourceName(HInstance, 'JvSimLogicBoxLIGHT'); // do not localize + FBmpRev.LoadFromResourceName(HInstance, 'JvSimLogicBoxREV'); // do not localize + FBmpBin.LoadFromResourceName(HInstance, 'JvSimLogicBoxBIN'); // do not localize + FRCon := Rect(0, 0, 32, 32); + FRLogic := Rect(33, 0, 64, 32); + FRButton := Rect(0, 33, 32, 64); + FRLight := Rect(33, 33, 64, 64); + FRRev := Rect(65, 0, 97, 32); + FDCon := False; + FDLogic := False; + FDButton := False; + FDLight := False; + FDRev := False; + FCpu := TTimer.Create(Self); + FCpu.Enabled := False; + FCpu.OnTimer := @CpuOnTimer; + FCpu.Interval := 50; +end; + +destructor TJvSimLogicBox.Destroy; +begin + FCpu.Free; + FBmpCon.Free; + FBmpLogic.Free; + FBmpButton.Free; + FBmpLight.Free; + FBmpRev.Free; + FBmpBin.Free; + inherited Destroy; +end; + +procedure TJvSimLogicBox.Loaded; +begin + inherited Loaded; + FCpu.Enabled := True; +end; + +procedure TJvSimLogicBox.CpuOnTimer(Sender: TObject); +var + Wc: TWinControl; + I: Integer; +begin + Wc := Parent; + // reset inputs +{ for I:=0 to Wc.ControlCount-1 do + if (Wc.Controls[I] is TJvLogic) then + begin + sLogic:=TJvLogic(Wc.Controls[I]); + for j:=0 to 2 do + sLogic.FGates[j].State:=False; + end + else + if (Wc.Controls[I] is TJvSimLight) then + begin + sLight:=TJvSimLight(Wc.Controls[I]); + sLight.Lit:=False; + end;} + // make connections + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSIMConnector then + TJvSIMConnector(Wc.Controls[I]).Connect; +end; + +procedure TJvSimLogicBox.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + P := Point(X, Y); + FDCon := False; + FDLogic := False; + FDButton := False; + FDLight := False; + if PtInRect(FRCon, P) then + FDCon := True + else + if PtInRect(FRLogic, P) then + FDLogic := True + else + if PtInRect(FRButton, P) then + FDButton := True + else + if PtInRect(FRLight, P) then + FDLight := True + else + if PtInRect(FRRev, P) then + FDRev := True; + Invalidate; +end; + +procedure TJvSimLogicBox.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Wc: TWinControl; + l, t: Integer; +begin + Wc := Parent; + l := Left; + t := Top + Height + 10; + if FDCon then + with TJvSIMConnector.Create(Wc) do + begin + Parent := Wc; + Left := l; + Top := t; + end + else + if FDLogic then + with TJvLogic.Create(Wc) do + begin + Parent := Wc; + Left := l; + Top := t; + end + else + if FDButton then + with TJvSimButton.Create(Wc) do + begin + Parent := Wc; + Left := l; + Top := t; + end + else + if FDLight then + with TJvSimLight.Create(Wc) do + begin + Parent := Wc; + Left := l; + Top := t; + end + else + if FDRev then + with TJvSimReverse.Create(Wc) do + begin + Parent := Wc; + Left := l; + Top := t; + end; + FDCon := False; + FDLogic := False; + FDButton := False; + FDLight := False; + FDRev := False; + Invalidate; +end; + +procedure TJvSimLogicBox.Paint; +var + Rb: TRect; +begin + with Canvas do + begin + Brush.Color := clSilver; + FillRect(ClientRect); + Rb := FRCon; + if not FDCon then + Frame3D(Rb, clBtnHighlight, clBtnShadow, 1) + else + Frame3D(Rb, clBtnShadow, clBtnHighlight, 1); + Draw(4, 4, FBmpCon); + Rb := FRLogic; + if not FDLogic then + Frame3D(Rb, clBtnHighlight, clBtnShadow, 1) + else + Frame3D(Rb, clBtnShadow, clBtnHighlight, 1); + Draw(36, 4, FBmpLogic); + Rb := FRButton; + if not FDButton then + Frame3D(Rb, clBtnHighlight, clBtnShadow, 1) + else + Frame3D(Rb, clBtnShadow, clBtnHighlight, 1); + Draw(4, 36, FBmpButton); + Rb := FRLight; + if not FDLight then + Frame3D(Rb, clBtnHighlight, clBtnShadow, 1) + else + Frame3D(Rb, clBtnShadow, clBtnHighlight, 1); + Draw(36, 36, FBmpLight); + Rb := FRRev; + if not FDRev then + Frame3D(Rb, clBtnHighlight, clBtnShadow, 1) + else + Frame3D(Rb, clBtnShadow, clBtnHighlight, 1); + Draw(Rb.Left + 3, Rb.Top + 3, FBmpRev); + + // Draw bin + Draw(100, 16, FBmpBin); + end; +end; + +procedure TJvSimLogicBox.Resize; +begin + Width := 130; + Height := 65; +end; + +//=== { TJvSimReverse } ====================================================== + +constructor TJvSimReverse.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited Create(AOwner); + Width := 42; + Height := 42; + // initialize Gates + FGates[0].Pos := Point(28, 14); + FGates[1].Pos := Point(14, 1); + FGates[2].Pos := Point(1, 14); + FGates[3].Pos := Point(14, 28); + for I := 0 to 3 do + begin + FGates[I].State := False; + FGates[I].Active := True; + FGates[I].Style := jgsDO; + end; + FGates[0].Style := jgsDI; + FConnectors := TList.Create; +end; + +destructor TJvSimReverse.Destroy; +begin + FConnectors.Free; + inherited Destroy; +end; + +procedure TJvSimReverse.AnchorConnectors; +var + Wc: TWinControl; + I: Integer; + Con: TJvSIMConnector; + R, Rc: TRect; + P: TPoint; +begin + Wc := Parent; + FConnectors.Clear; + R := BoundsRect; + InflateRect(R, 8, 0); + P := Point(Left, Top); + for I := 0 to Wc.ControlCount - 1 do + if Wc.Controls[I] is TJvSIMConnector then + begin + Con := TJvSIMConnector(Wc.Controls[I]); + // check for corners in bounds + Rc := Con.BoundsRect; + // TL + if PtInRect(R, Point(Rc.Left, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTL); + end + // TR + else + if PtInRect(R, Point(Rc.Right, Rc.Top)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmTR); + end + // BR + else + if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBR); + end + // BL + else + if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then + begin + FConnectors.Add(Con); + Con.AnchorCorner(P, jcmBL); + end + end; +end; + +function TJvSimReverse.GetGate(Index: Integer): TJvGate; +begin + Result := FGates[Index]; +end; + +procedure TJvSimReverse.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FMdp := Point(X, Y); + FOldp := Point(X, Y); + FDoMove := True; + AnchorConnectors; +end; + +procedure TJvSimReverse.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; +begin + P := ClientToScreen(Point(X, Y)); + P := Parent.ScreenToClient(P); + if ssLeft in Shift then + begin + if FDoMove then + begin + FNewLeft := P.X - FMdp.X; + FNewTop := P.Y - FMdp.Y; + MoveConnectors; + Left := FNewLeft; + Top := FNewTop; + end + end; +end; + +procedure TJvSimReverse.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + BinCheck(Self); +end; + +procedure TJvSimReverse.MoveConnectors; +var + I: Integer; + Con: TJvSIMConnector; +begin + for I := 0 to FConnectors.Count - 1 do + begin + Con := TJvSIMConnector(FConnectors[I]); + Con.MoveConnector(Point(FNewLeft, FNewTop)); + end; +end; + +procedure TJvSimReverse.OutCalc; +begin + Output1 := Input1; + Output2 := Input1; + Output3 := Input1; +end; + +procedure TJvSimReverse.Paint; +var + I: Integer; + R: TRect; + Poly: array [0..2] of TPoint; +begin + with Canvas do + begin + Brush.Color := clSilver; + R := ClientRect; + FillRect(R); + Frame3D(R, clBtnHighlight, clBtnShadow, 1); + Brush.Color := clRed; + for I := 0 to 3 do + PaintLed(I); + R := ClientRect; + // paint triangle + Poly[0] := Point(14, 20); + Poly[1] := Point(26, 14); + Poly[2] := Point(26, 26); + Pen.Style := psClear; + Brush.Color := clBlack; + Polygon(Poly); + Pen.Style := psSolid; + end; +end; + +procedure TJvSimReverse.PaintLed(Index: Integer); +var + SurfCol, LitCol: TColor; + P: TPoint; + X, Y: Integer; + Lit: Boolean; +begin + if not Gates[Index].Active then + Exit; + P := Gates[Index].Pos; + X := P.X; + Y := P.Y; + if Index = 0 then + Lit := Input1 + else + if Index = 1 then + Lit := Output1 + else + if Index = 2 then + Lit := Output2 + else + if Index = 3 then + Lit := Output3 + else + Lit := False; + if Lit then + begin + if Gates[Index].Style = jgsDI then + SurfCol := clLime + else + SurfCol := clRed; + LitCol := clWhite; + end + else + begin + if Gates[Index].Style = jgsDI then + begin + SurfCol := clGreen; + LitCol := clLime; + end + else + begin + SurfCol := clMaroon; + LitCol := clRed; + end; + end; + with Canvas do + begin + Brush.Color := clSilver; + FillRect(Rect(X, Y, X + 12, Y + 13)); + Brush.Style := bsClear; + Pen.Color := clGray; + Ellipse(X, Y, X + 12, Y + 13); + Pen.Color := clBlack; + Brush.Color := SurfCol; + Ellipse(X + 1, Y + 1, X + 11, Y + 12); + Pen.Color := clWhite; + Arc(X + 1, Y + 1, X + 11, Y + 12, X + 0, Y + 12, X + 12, Y + 0); + Pen.Color := LitCol; + Arc(X + 3, Y + 3, X + 8, Y + 9, X + 5, Y + 0, X + 0, Y + 8); + end; +end; + +procedure TJvSimReverse.Resize; +begin + Width := 42; + Height := 42; +end; + +procedure TJvSimReverse.SetInput1(const Value: Boolean); +begin + if Value <> FInput1 then + begin + FInput1 := Value; + Invalidate; + OutCalc; + end; +end; + +procedure TJvSimReverse.SetOutput1(const Value: Boolean); +begin + if Value <> FOutput1 then + begin + FOutput1 := Value; + Invalidate; + end; +end; + +procedure TJvSimReverse.SetOutput2(const Value: Boolean); +begin + if Value <> FOutput2 then + begin + FOutput2 := Value; + Invalidate; + end; +end; + +procedure TJvSimReverse.SetOutput3(const Value: Boolean); +begin + if Value <> FOutput3 then + begin + FOutput3 := Value; + Invalidate; + end; +end; + +end. diff --git a/components/jvcllaz/run/JvJans/JvSimPID.pas b/components/jvcllaz/run/JvJans/JvSimPID.pas new file mode 100644 index 000000000..e5de1d9ef --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvSimPID.pas @@ -0,0 +1,352 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvSimPID.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvSimPID; + +{$mode objfpc}{$H+} + +interface + +uses + LCLIntf, + SysUtils, Classes, Graphics, Controls, + JvComponent; + +type + TJvSymFunc = (sfPid, sfAdd, sfCompare, sfRamp, sfMul); + + TJvSimPID = class(TJvGraphicControl) + private + FMV: Extended; + FMVColor: TColor; + FSP: Extended; + FSPColor: TColor; + FCV: Extended; + FCVColor: TColor; + FKD: Extended; + FKP: Extended; + FKI: Extended; + FI: Extended; + FD: Extended; + FDirect: Boolean; + FManual: Boolean; + FSource: TJvSimPID; + FActive: Boolean; + FSymFunc: TJvSymFunc; + procedure SetMV(Value: Extended); + procedure SetMVColor(Value: TColor); + procedure SetSP(const Value: Extended); + procedure SetSPColor(const Value: TColor); + procedure SetCV(const Value: Extended); + procedure SetCVColor(const Value: TColor); + procedure SetKD(const Value: Extended); + procedure SetKI(const Value: Extended); + procedure SetKP(const Value: Extended); + procedure CalcOut; + procedure SetDirect(const Value: Boolean); + procedure SetManual(const Value: Boolean); + procedure SetSource(const Value: TJvSimPID); + procedure SetActive(const Value: Boolean); + procedure SetSymFunc(const Value: TJvSymFunc); + protected + procedure Paint; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + procedure Execute; + published + property SymFunc: TJvSymFunc read FSymFunc write SetSymFunc; + property Source: TJvSimPID read FSource write SetSource; + property MV: Extended read FMV write SetMV; + property MVColor: TColor read FMVColor write SetMVColor default clRed; + property SP: Extended read FSP write SetSP; + property SPColor: TColor read FSPColor write SetSPColor default clLime; + property CV: Extended read FCV write SetCV; + property CVColor: TColor read FCVColor write SetCVColor default clYellow; + property KP: Extended read FKP write SetKP; + property KI: Extended read FKI write SetKI; + property KD: Extended read FKD write SetKD; + property Direct: Boolean read FDirect write SetDirect default False; + property Manual: Boolean read FManual write SetManual default False; + property Active: Boolean read FActive write SetActive default False; + + property Align; + property Anchors; + property Color default clWhite; + property Height default 100; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property Width default 20; + property Visible; + +// property OnCanResize; // wp: removed + property OnClick; + property OnConstrainedResize; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + property OnStartDock; + property OnStartDrag; + end; + + +implementation + +uses + JvJVCLUtils; + +constructor TJvSimPID.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Color := clWhite; + MVColor := clRed; + SPColor := clLime; + CVColor := clYellow; + Direct := False; + Manual := False; + Active := False; + FMV := 50; + FSP := 50; + FCV := 50; + FKP := 0.5; + FKI := 0; + FKD := 0; + Width := 20; + Height := 100; +end; + +procedure TJvSimPID.SetMV(Value: Extended); +var + MVOld: Extended; +begin + MVOld := FMV; + if Value <> FMV then + begin + if Value > 100 then + MV := 100 + else + if Value < 0 then + MV := 0 + else + FMV := Value; + end; + FI := FI + KI * (FMV - FSP); + if FI > 50 then + FI := 50; + if FI < -50 then + FI := -50; + FD := KD * (FMV - MVOld); + if FD > 50 then + FD := 50; + if FD < -50 then + FD := -50; + CalcOut; +end; + +procedure TJvSimPID.SetMVColor(Value: TColor); +begin + if Value <> FMVColor then + begin + FMVColor := Value; + Invalidate; + end; +end; + +procedure TJvSimPID.Paint; + + procedure DrawValue(Left, Right: Integer; Value: Extended; AColor: TColor); + var + DrawRect: TRect; + begin + DrawRect.Left := Left; + DrawRect.Right := Right; + DrawRect.Top := DrawRect.Top + Round((100 - Value) * + (DrawRect.Bottom - DrawRect.Top) / 100); + DrawRect.Bottom := DrawRect.Bottom; + Canvas.Brush.Color := AColor; + Canvas.FillRect(DrawRect); + Canvas.Brush.Color := Color; + DrawRect.Bottom := DrawRect.Top; + DrawRect.Top := DrawRect.Top; + Canvas.FillRect(DrawRect); + end; + +var + bw: Integer; + DrawRect: TRect; +begin + DrawRect := ClientRect; + Canvas.Pen.Color := clGray; + Canvas.Pen.Width := 1; + Canvas.Rectangle(DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom); + InflateRect(DrawRect, -1, -1); + + bw := (DrawRect.Right - DrawRect.Left) div 3; + // first draw the Measured Value + DrawValue(DrawRect.Left + bw, DrawRect.Right - bw, SP, SPColor); + // and now the SetPoint + DrawValue(DrawRect.Left, DrawRect.Left + bw, MV, MVColor); + // draw the Corrective Value (CV) + DrawValue(DrawRect.Right - bw, DrawRect.Right, CV, CVColor); +end; + +procedure TJvSimPID.SetSP(const Value: Extended); +begin + if Value <> FSP then + begin + if Value > 100 then + FSP := 100 + else + if Value < 0 then + FSP := 0 + else + FSP := Value; + CalcOut; + end; +end; + +procedure TJvSimPID.SetSPColor(const Value: TColor); +begin + if Value <> FSPColor then + begin + FSPColor := Value; + Invalidate; + end; +end; + +procedure TJvSimPID.SetCV(const Value: Extended); +begin + if Value <> FCV then + begin + if Value > 100 then + FCV := 100 + else + if Value < 0 then + FCV := 0 + else + FCV := Value; + end; + Invalidate; +end; + +procedure TJvSimPID.SetCVColor(const Value: TColor); +begin + if Value <> FCVColor then + begin + FCVColor := Value; + Invalidate; + end; +end; + +procedure TJvSimPID.SetKD(const Value: Extended); +begin + FKD := Value; +end; + +procedure TJvSimPID.SetKI(const Value: Extended); +begin + FKI := Value; + if FKI = 0 then + FI := 0; +end; + +procedure TJvSimPID.SetKP(const Value: Extended); +begin + FKP := Value; +end; + +procedure TJvSimPID.CalcOut; +var + Output: Extended; +begin + if not Manual then + begin + if Direct then + Output := 50 + KP * (MV - SP) + FI + FD + else + Output := 50 - (KP * (MV - SP) + FI + FD); + SetCV(Output); + end; +end; + +procedure TJvSimPID.SetDirect(const Value: Boolean); +begin + FDirect := Value; +end; + +procedure TJvSimPID.SetManual(const Value: Boolean); +begin + FManual := Value; +end; + +procedure TJvSimPID.SetSource(const Value: TJvSimPID); +begin + ReplaceComponentReference(Self, Value, TComponent(FSource)); +end; + +procedure TJvSimPID.Execute; +var + Value: Extended; +begin + if Active then + if Assigned(FSource) then + begin + Value := Source.CV; + SetMV(Value); + end; +end; + +procedure TJvSimPID.SetActive(const Value: Boolean); +begin + FActive := Value; +end; + +procedure TJvSimPID.SetSymFunc(const Value: TJvSymFunc); +begin + FSymFunc := Value; +end; + +procedure TJvSimPID.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (AComponent = Source) and (Operation = opRemove) then + Source := nil; +end; + + +end. diff --git a/components/jvcllaz/run/JvJans/JvSimPIDLinker.pas b/components/jvcllaz/run/JvJans/JvSimPIDLinker.pas new file mode 100644 index 000000000..a5d797120 --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvSimPIDLinker.pas @@ -0,0 +1,123 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvSimPIDlinker.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvSimPIDLinker; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + JvSimPID; + +type + TPIDS = array of TJvSimPID; + + TJvSimPIDLinker = class(TComponent) + private + FPIDS: TPIDS; + function GetPID(const Index: Integer): TJvSimPID; + procedure SetPID(const Index: Integer; const Value: TJvSimPID); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); + override; + procedure InitPids; + public + procedure Execute; + constructor Create(AOwner: TComponent); override; + published + property In1: TJvSimPID index 0 read GetPID write SetPID; + property Out1: TJvSimPID index 1 read GetPID write SetPID; + property In2: TJvSimPID index 2 read GetPID write SetPID; + property Out2: TJvSimPID index 3 read GetPID write SetPID; + property In3: TJvSimPID index 4 read GetPID write SetPID; + property Out3: TJvSimPID index 5 read GetPID write SetPID; + property In4: TJvSimPID index 6 read GetPID write SetPID; + property Out4: TJvSimPID index 7 read GetPID write SetPID; + property In5: TJvSimPID index 8 read GetPID write SetPID; + property Out5: TJvSimPID index 9 read GetPID write SetPID; + property In6: TJvSimPID index 10 read GetPID write SetPID; + property Out6: TJvSimPID index 11 read GetPID write SetPID; + property In7: TJvSimPID index 12 read GetPID write SetPID; + property Out7: TJvSimPID index 13 read GetPID write SetPID; + property In8: TJvSimPID index 14 read GetPID write SetPID; + property Out8: TJvSimPID index 15 read GetPID write SetPID; + end; + + +implementation + +constructor TJvSimPIDLinker.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + InitPids; +end; + +procedure TJvSimPIDLinker.Execute; +var + I: Integer; +begin + for I := 0 to Length(FPIDS) - 2 do + if (FPIDS[I] <> nil) and (FPIDS[I + 1] <> nil) then + FPIDS[I].MV := FPIDS[I + 1].CV; +end; + +function TJvSimPIDLinker.GetPID(const Index: Integer): TJvSimPID; +begin + Result := FPIDS[Index]; +end; + +procedure TJvSimPIDLinker.InitPids; +const + cCount = 16; +var + I: Integer; +begin + SetLength(FPIDS, cCount); + for I := 0 to cCount - 1 do + FPIDS[I] := nil; +end; + +procedure TJvSimPIDLinker.Notification(AComponent: TComponent; + Operation: TOperation); +var + I: Integer; +begin + inherited Notification(AComponent, Operation); + if Operation = opRemove then + for I := 0 to Length(FPIDS) - 1 do + if FPIDS[I] = AComponent then + FPIDS[I] := nil; +end; + +procedure TJvSimPIDLinker.SetPID(const Index: Integer; + const Value: TJvSimPID); +begin + FPIDS[Index] := Value; +end; + + +end. diff --git a/components/jvcllaz/run/JvJans/JvSimScope.pas b/components/jvcllaz/run/JvJans/JvSimScope.pas new file mode 100644 index 000000000..170cb7bb0 --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvSimScope.pas @@ -0,0 +1,860 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvSimScope.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Description: + TJvSimScope Properties: + Active Starts/Stops scope + Color Backgroundcolor + GridColor Grid mask color + HorizontalGridSize Size of horiontal grid mask in logical units + VerticalGridSize Size of vertical grid mask in logical units + Interval Scroll speed in 1/100's seconds + LineColor Scope dataline color + Position Dataline value + BaseColor Color of BaseLine + BaseLine BaseLine value + + TJvSimScope Methods: + Clear Clears the control and redraws grid + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvSimScope; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls; + +const + JvScopeDefaultCapacity = 128; + JvMinimumScopeWidth = 20; + JvMinimumScopeHeight = 20; + + +type + TJvSimScope = class; + + TJvScopeLineUnit = (jluPercent, jluAbsolute); + + TValues = array of Integer; + + TJvScopeLineValues = class + private + FValues: TValues; + FCount: Integer; + FZeroIndex: Integer; + + procedure SetCapacity(const Value: Integer); + function GetCapacity: Integer; + function GetItem(Index: Integer): Integer; + public + procedure Assign(Source: TJvScopeLineValues); + procedure Add(Value: Integer); + procedure Clear; + + property Capacity: Integer read GetCapacity write SetCapacity; + property Count: Integer read FCount; + property Items[Index: Integer]: Integer read GetItem; default; + end; + + TJvScopeLine = class(TCollectionItem) + private + FPosition: Integer; + FColor: TColor; + FName: string; + FPositionUnit: TJvScopeLineUnit; + FValues: TJvScopeLineValues; + protected + function GetDisplayName: string; override; + public + constructor Create(ACollection: Classes.TCollection); override; + destructor Destroy; override; + + procedure Assign(Source: TPersistent); override; + procedure Clear; + property Values: TJvScopeLineValues read FValues; + published + property Name: string read FName write FName; + property Color: TColor read FColor write FColor default clLime; + property Position: Integer read FPosition write FPosition default 50; + property PositionUnit: TJvScopeLineUnit read FPositionUnit write FPositionUnit default jluPercent; + end; + + TJvScopeLines = class(TOwnedCollection) + private + function GetItem(Index: Integer): TJvScopeLine; + procedure SetItem(Index: Integer; const Value: TJvScopeLine); + protected + function GetOwner: TJvSimScope; reintroduce; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + public + constructor Create(AOwner: TJvSimScope); + procedure Assign(Source: TPersistent); override; + procedure ClearValues; + + function Add: TJvScopeLine; + function IndexOfName(const AName: string): Integer; + property Lines[Index: Integer]: TJvScopeLine read GetItem write SetItem; default; + end; + + TJvSimScopeDisplayUnit = (jduPixels, jduLogical); + + TJvSimScope = class(TGraphicControl) + private + FAllowed: Boolean; + FOnUpdate: TNotifyEvent; + FDrawBuffer: TBitmap; + FDrawTimer: TTimer; + FActive: Boolean; + FBaseColor: TColor; + FGridColor: TColor; + FBaseLine: Integer; + FInterval: Integer; + FLines: TJvScopeLines; + FHorizontalGridSize: Integer; + FVerticalGridSize: Integer; + FDisplayUnits: TJvSimScopeDisplayUnit; + FMaximum: Integer; + FMinimum: Integer; + FBaseLineUnit: TJvScopeLineUnit; + FTotalTimeSteps: Integer; + FUpdateTimeSteps: Integer; + + procedure SetActive(Value: Boolean); + procedure SetGridSize(Value: Integer); + procedure SetBaseLine(Value: Integer); + procedure SetInterval(Value: Integer); + procedure SetLines(const Value: TJvScopeLines); + procedure UpdateDisplay(ClearFirst: Boolean); + procedure SetHorizontalGridSize(const Value: Integer); + procedure SetVerticalGridSize(const Value: Integer); + function GetGridSize: Integer; + procedure SetDisplayUnits(const Value: TJvSimScopeDisplayUnit); + procedure SetMaximum(const Value: Integer); + procedure SetMinimum(const Value: Integer); + procedure UpdateComputedValues; + procedure SetBaseLineUnit(const Value: TJvScopeLineUnit); + procedure SetTotalTimeSteps(const Value: Integer); + procedure SetUpdateTimeSteps(const Value: Integer); + protected + FCalcBase: Integer; + FStepPixelWidth: Double; + FCounter: Double; + procedure DrawTimerTimer(Sender: TObject); + function GetLinePixelPosition(Line: TJvScopeLine; Position: Integer): Integer; + procedure Loaded; override; + public + procedure Paint; override; + constructor Create(AOwner: TComponent); override; + procedure UpdateScope; + destructor Destroy; override; + procedure Clear; + procedure ClearValues; + procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; + published + property Active: Boolean read FActive write SetActive; + property BaseColor: TColor read FBaseColor write FBaseColor default clRed; + property BaseLine: Integer read FBaseLine write SetBaseLine default 50; + property BaseLineUnit: TJvScopeLineUnit read FBaseLineUnit write SetBaseLineUnit default jluPercent; + property Color default clBlack; + property DisplayUnits: TJvSimScopeDisplayUnit read FDisplayUnits write SetDisplayUnits default jduPixels; + property GridColor: TColor read FGridColor write FGridColor default clGreen; + property GridSize: Integer read GetGridSize write SetGridSize stored False default 16; + property HorizontalGridSize: Integer read FHorizontalGridSize write SetHorizontalGridSize default 16; + property Height default 120; + property Interval: Integer read FInterval write SetInterval default 50; + property Lines: TJvScopeLines read FLines write SetLines; + property Minimum: Integer read FMinimum write SetMinimum; + property Maximum: Integer read FMaximum write SetMaximum default 120; + property TotalTimeSteps: Integer read FTotalTimeSteps write SetTotalTimeSteps default 208; + property UpdateTimeSteps: Integer read FUpdateTimeSteps write SetUpdateTimeSteps default 2; + property VerticalGridSize: Integer read FVerticalGridSize write SetVerticalGridSize default 16; + property Width default 208; + + property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; + + property Align; + property Anchors; + property ParentShowHint; + property ShowHint; + property Visible; + +// property OnCanResize; -- wp: removed + property OnClick; + property OnConstrainedResize; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + property OnStartDock; + property OnStartDrag; + end; + + +implementation + +uses + Math; + +//=== { TJvScopeLineValues } ================================================= + +procedure TJvScopeLineValues.Add(Value: Integer); +begin + Assert(Assigned(Self)); + if Length(FValues)=Count then // auto-growby JvScopeDefaultCapacity + SetCapacity( GetCapacity+JvScopeDefaultCapacity); + + if Count < Capacity then + begin + FValues[FCount] := Value; + Inc(FCount); + end + else + begin + FValues[FZeroIndex] := Value; + FZeroIndex := (FZeroIndex + 1) mod FCount; + end; +end; + +procedure TJvScopeLineValues.Assign(Source: TJvScopeLineValues); +var + I: Integer; +begin + if (not Assigned(Source)) then + raise Exception.Create('TJvScopeLineValues.Assign:Source not assigned'); + FCount := Source.FCount; + FZeroIndex := Source.FZeroIndex; + Capacity := Source.Capacity; + for I := 0 to Source.Capacity - 1 do + FValues[I] := Source.FValues[I]; +end; + +procedure TJvScopeLineValues.Clear; +begin + FCount := 0; + FZeroIndex := 0; + + // Always need to have two values in the queue + Add(0); + Add(0); +end; + +function TJvScopeLineValues.GetCapacity: Integer; +begin + if Assigned(FValues) then + Result := Length(FValues) + else + Result := 0; +end; + +function TJvScopeLineValues.GetItem(Index: Integer): Integer; +begin + if FCount = 0 then + Result := FValues[0] + else + Result := FValues[(Index + FZeroIndex) mod FCount]; +end; + +procedure TJvScopeLineValues.SetCapacity(const Value: Integer); +begin + if Value <> Capacity then + begin + SetLength(FValues, Value); + end; +end; + +//=== { TJvScopeLine } ======================================================= + +procedure TJvScopeLine.Clear; +begin + FValues.Clear; +end; + +constructor TJvScopeLine.Create(ACollection: Classes.TCollection); +begin + // MUST be created before, inherited create will call Notify... + FValues := TJvScopeLineValues.Create; + inherited Create(ACollection); + FPosition := 50; + FColor := clLime; +end; + +destructor TJvScopeLine.Destroy; +begin + FValues.Free; + inherited Destroy; +end; + +procedure TJvScopeLine.Assign(Source: TPersistent); +begin + if Source is TJvScopeLine then + begin + Name := TJvScopeLine(Source).Name; + Color := TJvScopeLine(Source).Color; + Position := TJvScopeLine(Source).Position; + FValues.Assign(TJvScopeLine(Source).FValues); + end + else + inherited Assign(Source); +end; + +function TJvScopeLine.GetDisplayName: string; +begin + if Name = '' then + Result := inherited GetDisplayName + else + Result := Name; +end; + +//=== { TJvScopeLines } ====================================================== + +procedure TJvScopeLines.ClearValues; +var + I: Integer; +begin + for I := 0 to Count - 1 do + begin + Lines[I].Clear; + end; +end; + +constructor TJvScopeLines.Create(AOwner: TJvSimScope); +begin + inherited Create(AOwner, TJvScopeLine); +end; + +function TJvScopeLines.Add: TJvScopeLine; +begin + Result := TJvScopeLine(inherited Add); +end; + +procedure TJvScopeLines.Assign(Source: TPersistent); +var + I: Integer; +begin + if Source is TJvScopeLines then + begin + Clear; + for I := 0 to TJvScopeLines(Source).Count - 1 do + Add.Assign(TJvScopeLines(Source)[I]); + end + else + inherited Assign(Source); +end; + +function TJvScopeLines.GetItem(Index: Integer): TJvScopeLine; +begin + Result := TJvScopeLine(inherited Items[Index]); +end; + +function TJvScopeLines.GetOwner: TJvSimScope; +begin + Result := inherited GetOwner as TJvSimScope; +end; + +function TJvScopeLines.IndexOfName(const AName: string): Integer; +var + I: Integer; +begin + Result := -1; + for I := 0 to Count - 1 do + if AnsiSameStr(Lines[Result].Name, AName) then + begin + Result := I; + Break; + end; +end; + +procedure TJvScopeLines.Notify(Item: TCollectionItem; + Action: TCollectionNotification); +begin + inherited Notify(Item, Action); + + if Action = cnAdded then + begin + TJvScopeLine(Item).FValues.Capacity := GetOwner.TotalTimeSteps; + end; +end; + +procedure TJvScopeLines.SetItem(Index: Integer; const Value: TJvScopeLine); +begin + inherited Items[Index] := Value; +end; + +//=== { TJvSimScope } ======================================================== + +procedure TJvSimScope.ClearValues; +begin + FLines.ClearValues; +end; + +constructor TJvSimScope.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FAllowed := False; + FDrawBuffer := TBitmap.Create; + FDrawBuffer.Canvas.Brush.Style := bsSolid; + FDrawBuffer.Canvas.Pen.Width := 1; + FDrawBuffer.Canvas.Pen.Style := psSolid; + + FDrawTimer := TTimer.Create(Self); + FDrawTimer.Enabled := False; + FDrawTimer.OnTimer := @DrawTimerTimer; + FDrawTimer.Interval := 500; + + FDisplayUnits := jduPixels; + FUpdateTimeSteps := 2; + + Height := 120; { property default } + Width := 208; { property default } + + Color := clBlack; + FGridColor := clGreen; + FBaseColor := clRed; + + BaseLine := 50; + GridSize := 16; + + FLines := TJvScopeLines.Create(Self); + Interval := 50; + FCounter := 1; + + ControlStyle := [csFramed, csOpaque]; + FAllowed := True; +end; + +destructor TJvSimScope.Destroy; +begin + FDrawTimer.Free; + FDrawBuffer.Free; + FLines.Free; + inherited Destroy; +end; + +procedure TJvSimScope.DrawTimerTimer(Sender: TObject); +begin + UpdateScope; +end; + +function TJvSimScope.GetGridSize: Integer; +begin + Result := -1; + if HorizontalGridSize = VerticalGridSize then + Result := HorizontalGridSize; +end; + +function TJvSimScope.GetLinePixelPosition(Line: TJvScopeLine; + Position: Integer): Integer; +begin + Result := 0; + case Line.PositionUnit of + jluPercent: + Result := Height - Round(Height * Position / 100); + jluAbsolute: + Result := Height - Round(Height * (Position - Minimum) / (Maximum - Minimum)); + end; +end; + +procedure TJvSimScope.Loaded; +begin + inherited Loaded; + + // To force having enough values in the scope. + ClearValues; + + FAllowed := True; +end; + +procedure TJvSimScope.Clear; +var + A: Double; + I: Integer; + J: Integer; + Position: Double; +begin + if not FAllowed then + Exit; + UpdateComputedValues; + with FDrawBuffer.Canvas do + begin + Brush.Color := Color; + Pen.Style := psClear; + Rectangle(0, 0, Width + 1, Height + 1); + Pen.Style := psSolid; + Pen.Color := GridColor; + Pen.Width := 1; + { Vertical lines } + A := Width; + while A > 0 do + begin + MoveTo(Round(A - 1), 0); + LineTo(Round(A - 1), Height); + A := A - VerticalGridSize * FStepPixelWidth; + end; + { Horizontal lines - below BaseLine } + A := FCalcBase; + while A < Height do + begin + A := A + HorizontalGridSize * Height / (Maximum - Minimum); + MoveTo(0, Round(A)); + LineTo(Width, Round(A)); + end; + { Horizontal lines - above BaseLine } + A := FCalcBase; + while A > 0 do + begin + A := A - HorizontalGridSize * Height / (Maximum - Minimum); + MoveTo(0, Round(A)); + LineTo(Width, Round(A)); + end; + { BaseLine } + Pen.Color := BaseColor; + MoveTo(0, FCalcBase); + LineTo(Width, FCalcBase); + + // Redraw old values to keep history of values + for I := 0 to FLines.Count - 1 do + begin + Pen.Color := FLines[I].Color; + + if FLines[I].FValues.Count > 0 then + begin + Position := (TotalTimeSteps - FLines[I].FValues.Count) * FStepPixelWidth; + + MoveTo(Round(Position), GetLinePixelPosition(FLines[I], FLines[I].FValues[0])); + J := UpdateTimeSteps - 1; + while J < FLines[I].FValues.Count - 1 do + begin + Position := Position + UpdateTimeSteps * FStepPixelWidth; + LineTo(Round(Position), GetLinePixelPosition(FLines[I], FLines[I].FValues[J])); + Inc(J, UpdateTimeSteps); + end; + + end + else + begin + FLines[I].FValues.Clear; + end; + end; + + FCounter := 1; + end; +end; + +procedure TJvSimScope.SetBaseLine(Value: Integer); +begin + FBaseLine := Value; + UpdateComputedValues; + UpdateDisplay(True); +end; + +procedure TJvSimScope.SetBaseLineUnit(const Value: TJvScopeLineUnit); +begin + if FBaseLineUnit <> Value then + begin + FBaseLineUnit := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetInterval(Value: Integer); +begin + if FInterval <> Value then + begin + FDrawTimer.Enabled := False; + UpdateComputedValues; + FDrawTimer.Interval := Value * 10; + FInterval := Value; + FDrawTimer.Enabled := FActive; + end; +end; + +procedure TJvSimScope.SetGridSize(Value: Integer); +begin + if ((Value <> FHorizontalGridSize) or (Value <> FVerticalGridSize)) and (Value > 0) then + begin + FHorizontalGridSize := Value; + FVerticalGridSize := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetHorizontalGridSize(const Value: Integer); +begin + if (FHorizontalGridSize <> Value) and (Value > 0) then + begin + FHorizontalGridSize := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetActive(Value: Boolean); +begin + if FActive <> Value then + begin + UpdateComputedValues; + FDrawTimer.Interval := Interval * 10; + FDrawTimer.Enabled := Value; + FActive := Value; + end; +end; + +{ All drawings is performed on in the FDrawBuffer to speed up + proceedings and eliminate flicker. The Paint procedure merely + copies the contents of the FDrawBuffer. } + +procedure TJvSimScope.UpdateScope; +var + A: Double; + I: Integer; + Dest, Src: TRect; + UpdateWidth: Integer; + J: Integer; + PosMinusOne: Double; + PosMinusTwo: Double; +begin + with FDrawBuffer.Canvas do + begin + Pen.Color := FGridColor; + + UpdateWidth := Round(UpdateTimeSteps * FStepPixelWidth); + + Dest.Top := 0; + Dest.Left := 0; + Dest.Right := Round(Width - UpdateWidth); + Dest.Bottom := Height; + + Src.Top := 0; + Src.Left := Round(UpdateTimeSteps * FStepPixelWidth); + Src.Right := Width; + Src.Bottom := Height; + { Copy bitmap leftwards } + CopyRect(Dest, FDrawBuffer.Canvas, Src); + + { Draw new area } + Pen.Color := Color; + Brush.Color := Color; + BRush.Style := bsSolid; + Dest.Top := 0; + Dest.Left := Width - UpdateWidth; + Dest.Right := Width; + Dest.Bottom := Height; + FilLRect(Dest); +(* Pen.Width := UpdateWidth; + MoveTo(Width - Round(UpdateWidth / 2), 0); + LineTo(Width - Round(UpdateWidth / 2), Height); *) + + + Pen.Color := GridColor; + Pen.Width := 1; + { Draw vertical line if needed } + if FCounter >= Round(VerticalGridSize * FStepPixelWidth / UpdateWidth) then + begin + MoveTo(Width - 1, 0); + LineTo(Width - 1, Height); + FCounter := 0; + end; + FCounter := FCounter + 1; + { Horizontal lines - below BaseLine } + A := FCalcBase; + while A < Height do + begin + A := A + HorizontalGridSize * Height / (Maximum - Minimum); + MoveTo(Width - UpdateWidth, Round(A)); + LineTo(Width, Round(A)); + end; + { Horizontal lines - above BaseLine } + A := FCalcBase; + while A > 0 do + begin + A := A - HorizontalGridSize * Height / (Maximum - Minimum); + MoveTo(Width - UpdateWidth, Round(A)); + LineTo(Width, Round(A)); + end; + { BaseLine } + Pen.Color := BaseColor; + MoveTo(Width - UpdateWidth, FCalcBase); + LineTo(Width, FCalcBase); + { Draw position for lines} + for I := 0 to FLines.Count - 1 do + begin + Pen.Color := FLines[I].Color; + + A := GetLinePixelPosition(FLines[I], FLines[I].Position); + PosMinusOne := GetLinePixelPosition(FLines[I], FLines[I].FValues[FLines[I].FValues.Count - 1 * UpdateTimeSteps]); + PosMinusTwo := GetLinePixelPosition(FLines[I], FLines[I].FValues[FLines[I].FValues.Count - 2 * UpdateTimeSteps]); + + MoveTo(Width - UpdateWidth * 2, Round(PosMinusTwo)); + LineTo(Width - UpdateWidth, Round(PosMinusOne)); + LineTo(Width - 0, Round(A)); + for J := 0 to UpdateTimeSteps - 1 do + FLines[I].FValues.Add(FLines[I].Position); + end; + end; + Repaint; + if Assigned(FOnUpdate) then + FOnUpdate(Self); +end; + +{ Called by timer to show updates } + +procedure TJvSimScope.Paint; +var + Rect: TRect; +begin + // inherited Paint; + FDrawBuffer.Height := Height; + FDrawBuffer.Width := Width; + Rect.Top := 0; + Rect.Left := 0; + Rect.Right := Width; + Rect.Bottom := Height; + Canvas.CopyRect(Rect, FDrawBuffer.Canvas, Rect); + FAllowed := True; +end; + +{ Recalulate control after move and/or resize } + +procedure TJvSimScope.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); +begin + { BUGFIX/Workaround:JAN 2009 - ACCESS VIOLATIONS AND ODD BEHAVIOUR - SIZE/WIDTH BEING ZAPPED TO ZERO.} + if AWidth < JvMinimumScopeWidth then + AWidth := JvMinimumScopeWidth; + if AHeight < JvMinimumScopeHeight then + AHeight := JvMinimumScopeHeight; + + + inherited SetBounds(ALeft, ATop, AWidth, AHeight); + FDrawBuffer.Height := Height; + FDrawBuffer.Width := Width; + if DisplayUnits = jduPixels then + begin + FMinimum := 0; + FMaximum := AHeight; + FTotalTimeSteps := AWidth; + end; + Clear; +end; + +procedure TJvSimScope.UpdateComputedValues; +begin + case FBaseLineUnit of + jluPercent: + FCalcBase := Height - Round(Height * FBaseLine / 100); + jluAbsolute: + FCalcBase := Height - Round(Height * (FBaseLine - Minimum) / (Maximum - Minimum)); + end; + FStepPixelWidth := Width / TotalTimeSteps; + if FUpdateTimeSteps * FStepPixelWidth < 2 then + UpdateTimeSteps := 2; +end; + +procedure TJvSimScope.SetDisplayUnits(const Value: TJvSimScopeDisplayUnit); +begin + if FDisplayUnits <> Value then + begin + FDisplayUnits := Value; + if FDisplayUnits = jduPixels then + begin + FMinimum := 0; + FMaximum := Height; + end; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetLines(const Value: TJvScopeLines); +begin + FLines.Assign(Value); + Clear; +end; + +procedure TJvSimScope.SetMaximum(const Value: Integer); +begin + if (FDisplayUnits <> jduPixels) and (FMaximum <> Value) then + begin + FMaximum := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetMinimum(const Value: Integer); +begin + if (FDisplayUnits <> jduPixels) and (FMinimum <> Value) then + begin + FMinimum := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetTotalTimeSteps(const Value: Integer); +begin + if (FDisplayUnits <> jduPixels) and (FTotalTimeSteps <> Value) then + begin + FTotalTimeSteps := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.SetUpdateTimeSteps(const Value: Integer); +begin + if (FUpdateTimeSteps <> Value) and (Value > 0) then + begin + FUpdateTimeSteps := Value; + end; +end; + +procedure TJvSimScope.SetVerticalGridSize(const Value: Integer); +begin + if (FVerticalGridSize <> Value) and (Value > 0) then + begin + FVerticalGridSize := Value; + UpdateDisplay(True); + end; +end; + +procedure TJvSimScope.UpdateDisplay(ClearFirst: Boolean); +begin + if Parent <> nil then + begin + if ClearFirst then + Clear; + Repaint; + end; +end; + + +end.